changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > core / lisp/lib/net/codec/tlv.lisp

changeset 256: c5f24d22497a
parent: e41c5c04d7f6
child: 099ee89ff63f
author: Richard Westhaver <ellis@rwest.io>
date: Mon, 01 Apr 2024 20:19:11 -0400
permissions: -rw-r--r--
description: serde/tlv 
     1 ;;; lisp/net/codec/tlv.lisp --- TypeLengthValue wire codec
     2 
     3 ;;
     4 
     5 ;;; Code:
     6 (in-package :net/codec/tlv)
     7 
     8 (defclass tlv ()
     9   ((type :initform 0 :initarg :type :type octet :accessor tlv-type)
    10    (length :initform 0 :initarg :length :type (unsigned-byte 16) :accessor tlv-length)
    11    (value :initform (make-array 0 :element-type 'octet) :initarg :value :type octet-vector :accessor tlv-value))
    12   (:documentation "TypeLengthValue object.
    13 
    14 TLVs are a common packet format in communication protocols. Objects of
    15 this type are assumed to have a 1 byte TYPE, a 2 byte LENGTH, and a
    16 VALUE which is an OCTET-VECTOR of length LENGTH."))
    17 
    18 (defmethod serialize ((obj tlv) (format (eql :bytes)) &key stream)
    19   (declare (ignore format))
    20   (with-slots (type length value) obj
    21     (let ((buf (make-array (+ 3 length) :element-type 'octet)))
    22       (setf (aref buf 0) type)
    23       (setf (subseq buf 1 2) (integer-to-octets length 16))
    24       (unless (= 0 length)
    25         (setf (subseq buf 4) value))
    26       (if stream
    27           (write buf :stream stream)
    28           buf))))
    29 
    30 (defun make-tlv (type length &optional (value #.(make-array 0 :element-type 'octet)))
    31   (make-instance 'tlv :type type :length length :value value))
    32 
    33 (defmethod serialize ((obj tlv) (format (eql :string)) &key stream (external-format :default))
    34   (declare (ignore format stream))
    35   (sb-ext:octets-to-string (serialize obj :bytes) :external-format external-format))
    36 
    37 (defmethod deserialize ((from simple-array) (format (eql :tlv)) &key)
    38   (declare (ignore format))
    39   (let ((type (aref from 0))
    40         (length (octets-to-integer (subseq from 1 3))))
    41     (if (= 0 length)
    42         (make-tlv type length)
    43         (let ((value (subseq from 3 (+ 3 length))))
    44           (funcall #'make-tlv type length value)))))
    45 
    46 (defmethod deserialize ((from stream) (format (eql :tlv)) &key)
    47   (let ((type (read-byte from))
    48         (l (make-array 2 :element-type 'octet :adjustable t)))
    49     (read-sequence l from)
    50     (let ((length (octets-to-integer (coerce l 'octet-vector) 2)))
    51       (if (= 0 length)
    52           (make-tlv type length nil)
    53           (let ((value (make-array length :element-type 'octet)))
    54             (read-sequence value from)
    55             (make-tlv type length value))))))
    56 
    57 (defmethod serde ((from tlv) (to simple-array))
    58   (with-slots (type length value) from
    59     (setf (aref to 0) type)
    60     (replace to (integer-to-octets length 16) :start1 1 :start2 2)
    61     (unless (= 0 length)
    62       (replace to value :start1 3 :end1 (+ 3 length)))
    63     to))
    64 
    65 #+nil
    66 (describe
    67  (deserialize
    68   (serialize (make-instance 'tlv) :bytes)
    69   :tlv))