;; 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)))
;; 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)
(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))))
;; 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
;; 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)
)