From: Ralph Ronnquist <ralph.ronnquist@gmail.com>
Date: Sat, 22 Apr 2023 09:19:31 +0000 (+1000)
Subject: Ignore too small data snippets.
X-Git-Url: https://git.rrq.au/?a=commitdiff_plain;h=de600b7667b5df4b1fb48c0c496f8e2fc86c08c7;p=rrq%2Flsp-utils.git

Ignore too small data snippets.
---

diff --git a/lsp-dbus/lsp-dbus-marshal.lsp b/lsp-dbus/lsp-dbus-marshal.lsp
index 90db86e..26da795 100644
--- a/lsp-dbus/lsp-dbus-marshal.lsp
+++ b/lsp-dbus/lsp-dbus-marshal.lsp
@@ -124,6 +124,7 @@
 ;; position in DATA. Then advance AT further past that unpacking but
 ;; return the unpacked value.
 (define (unpack-align I FMT)
+  ##(println (list 'unpack-align I FMT AT (length DATA)))
   (align-AT I)
   (prog1 ((unpack FMT (AT DATA)) 0) (inc AT I)))
 
@@ -150,6 +151,7 @@
 ;; Unpack the ES type item from (AT DATA), optionally with
 ;; pre-alignment, and increment AT past the padding and item.
 (define (unpack-data-item ES)
+  ##(println (list 'unpack-data-item ES AT (length DATA)))
   (if (list? ES) (unpack-data-struct ES)
     (= ES "s") (unpack-data-string ES)
     (= ES "o") (unpack-data-string ES)
@@ -164,11 +166,13 @@
   (let ((A AT) (N (+ (unpack-align 4 "u") AT)) (OUT '()))
     (when (and (list? ES) (!= "a" (ES 0))) (align-AT 8))
     (while (< AT N)
+      ##(println "---next " (list AT N))
       (push (unpack-data-item ES) OUT -1))
     OUT))
 
 ;; Unpack a structure or array with ES fields.
 (define (unpack-data-struct ES)
+  ##(println (list 'unpack-data-struct ES AT))
   (if (= "a" (ES 0)) (unpack-data-array (ES 1))
     (begin (align-AT 8) (map unpack-data-item ES))))
 
@@ -176,6 +180,7 @@
 ;; a pair (unpacked pos) of unpacked data and how much data is
 ;; consumed.
 (define (unpack-data SIGN DATA (AT 0))
+  ##(println (format "*** unpack-data %s %d %d" SIGN (length DATA) AT))
   (list (unpack-data-item (expand-signature SIGN)) AT))
 
 ;; Unpack all dbus messages in the given DATA block. Each message
@@ -188,19 +193,26 @@
 ;; extended with the pair ("" body).
 (define (unpack-messages DATA)
   (let ((AT 0) (OUT '()) (M nil) (D nil) (S nil))
-    (while (and (< AT (length DATA))
+    (while (and (< (+ AT 7) (length DATA))
                 (setf M (unpack-data "yyyyuua(yv)" DATA AT)))
       (setf AT (M 1))
+      ##(println "message head " (M 0))
+      ##(println (list 'remains AT (length DATA)))
       (setf M (M 0 -1)) ; Drop all but the headers then map to symbol keys
-      (dotimes (i (length M 0))
+      (dotimes (i (length M))
         (setf (M i 0) (MESSAGE-HEADERS (M i 0) 0)))
+      ##(println "mapped headers " M)
       ;; Add the body, if any, keyed by "".
       (setf S (if (lookup 'SIGNATURE M) $it ""))
+      ##(println (list 'sign S))
       (when (and (!= S "") (setf D (unpack-data S DATA AT)))
         (setf AT (D 1))
         (extend M (list (list "" (D 0)))))
       ;; Collate message and move to the next portion in DATA
       (push M OUT -1)
+      ##(println (list 'ending AT (length DATA)))
+      ;;(align-AT 4)
+      ##(println (list 'aligned AT (length DATA)))
       (setf DATA (AT DATA))
       (setf AT 0) 
       )