changelog shortlog graph tags branches files raw help

Mercurial > core / changeset: tlv

changeset 257: 099ee89ff63f
parent 256: c5f24d22497a
child 258: 11ef863e0ac0
author: Richard Westhaver <ellis@rwest.io>
date: Mon, 01 Apr 2024 22:14:14 -0400
files: lisp/lib/dat/pkg.lisp lisp/lib/dat/proto.lisp lisp/lib/net/codec/tlv.lisp
description: tlv
     1.1--- a/lisp/lib/dat/pkg.lisp	Mon Apr 01 20:19:11 2024 -0400
     1.2+++ b/lisp/lib/dat/pkg.lisp	Mon Apr 01 22:14:14 2024 -0400
     1.3@@ -2,7 +2,7 @@
     1.4   (:use :cl :std)
     1.5   (:export :serialize :deserialize
     1.6            :serializer-error :deserializer-error
     1.7-           :dat-error))
     1.8+           :serde :serde-error :dat-error))
     1.9 
    1.10 (defpackage :dat/sxp
    1.11   (:nicknames :sxp)
     2.1--- a/lisp/lib/dat/proto.lisp	Mon Apr 01 20:19:11 2024 -0400
     2.2+++ b/lisp/lib/dat/proto.lisp	Mon Apr 01 22:14:14 2024 -0400
     2.3@@ -10,7 +10,7 @@
     2.4 
     2.5 (define-condition serializer-error (dat-error) ())
     2.6 (define-condition deserializer-error (dat-error) ())
     2.7-
     2.8+(define-condition serde-error (dat-error) ())
     2.9 ;;; Serialize
    2.10 (defvar *serializable*
    2.11   '(string simple-string octet-vector octet
    2.12@@ -54,7 +54,7 @@
    2.13 DESERIALIZABLE-TYPE-DESIGNATOR."))
    2.14 
    2.15 ;;; Serde
    2.16-(defgeneric serde (from to &key)
    2.17+(defgeneric serde (from to)
    2.18   (:documentation "Point-to-point serialization.
    2.19 
    2.20 FROM and TO should both specialize on object instances.
     3.1--- a/lisp/lib/net/codec/tlv.lisp	Mon Apr 01 20:19:11 2024 -0400
     3.2+++ b/lisp/lib/net/codec/tlv.lisp	Mon Apr 01 22:14:14 2024 -0400
     3.3@@ -18,11 +18,12 @@
     3.4 (defmethod serialize ((obj tlv) (format (eql :bytes)) &key stream)
     3.5   (declare (ignore format))
     3.6   (with-slots (type length value) obj
     3.7-    (let ((buf (make-array (+ 3 length) :element-type 'octet)))
     3.8+    (let* ((end (+ 3 length))
     3.9+           (buf (make-array end :element-type 'octet)))
    3.10       (setf (aref buf 0) type)
    3.11       (setf (subseq buf 1 2) (integer-to-octets length 16))
    3.12       (unless (= 0 length)
    3.13-        (setf (subseq buf 4) value))
    3.14+        (setf (subseq buf 3 (+ 3 length)) value))
    3.15       (if stream
    3.16           (write buf :stream stream)
    3.17           buf))))
    3.18@@ -47,7 +48,7 @@
    3.19   (let ((type (read-byte from))
    3.20         (l (make-array 2 :element-type 'octet :adjustable t)))
    3.21     (read-sequence l from)
    3.22-    (let ((length (octets-to-integer (coerce l 'octet-vector) 2)))
    3.23+    (let ((length (octets-to-integer (coerce l 'octet-vector))))
    3.24       (if (= 0 length)
    3.25           (make-tlv type length nil)
    3.26           (let ((value (make-array length :element-type 'octet)))
    3.27@@ -62,6 +63,15 @@
    3.28       (replace to value :start1 3 :end1 (+ 3 length)))
    3.29     to))
    3.30 
    3.31+(defmethod serde ((from simple-array) (to tlv))
    3.32+  (if (> 3 (length from))
    3.33+      (error 'serde-error :message "array length is < 3")
    3.34+      (let ((type (aref from 0))
    3.35+            (length (octets-to-integer (subseq from 1 2))))
    3.36+        (setf (tlv-type to) type
    3.37+              (tlv-length to) length
    3.38+              (tlv-value to) (subseq from 3 (+ 3 length)))
    3.39+        to)))
    3.40 #+nil
    3.41 (describe
    3.42  (deserialize