1 ;; This newlisp "module" implements dbus marshalling
3 ; The newlisp representation is a simplified form using lists for
7 ; Expland a signature string into a nested list to correspond to the
8 ; newlisp list representation. Basic dbus types are basic newlisp
9 ; types, including strings. Arrays and structs are sublists. The
10 ; signature marks array sublists with an initial "a", otherwise it's a
13 ; Ex: "yi" = ("y" "i")
14 ; Ex: "y(ai)" = ("y" (("a" "i")))
15 ; Ex: "a(yi)" = (("a" ("y" "i")))
16 ; Ex: "yyyyuua(yv)" = ("y" "y" "y" "y" "u" "u" ("a" ("y" "v")))
17 (define (expand-signature S)
18 (println (list 'expand-signature S))
19 (let ((STACK '()) (CUR '()) (A 0))
20 (dolist (X (explode S))
21 ;;(println "CUR=" CUR " X=" X)
23 (")" (setf X CUR) (setf CUR (pop STACK)))
24 ("(" (push CUR STACK) (setf CUR '()))
26 (when (and (!= X "a") (!= X "("))
27 (while (and CUR (= "a" (last CUR)))
28 (setf X (list (last CUR) X))
29 (setf CUR (chop CUR))))
32 (if (null? CUR) '() (1 CUR) CUR (CUR 0)) ))
34 ;; Join arguments with a given byte-alignment
36 ;;(println (list 'pad-join AT N (args)))
39 (let ((PAD (dup "\000" (% (- N (% (length OUT) N)) N))))
43 ;; Pack data from DATA according to signature. The DATA is a nested
44 ;; list where container types are sub lists. Variant types also appear
45 ;; as pairs of signature and value.
46 (define (pack-data SIGN DATA)
47 (let ((AT 0)) (pack-data-struct (expand-signature SIGN) DATA)))
49 ;; Align AT to an I multiple by adding nul bytes, then extend it with
50 ;; DATA, and increment AT
51 (define (pack-align DATA (I (length DATA)))
52 (let ((PAD (dup "\000" (% (- I (% AT I)) I))))
53 ;;(println (list 'align AT I (length PAD)))
54 (setf DATA (extend PAD DATA))
55 (inc AT (length DATA))
58 ;; Advance AT to align by I
59 (define (align-unpack I FMT N)
60 ((list (inc AT (% (- I (% AT I)) I)) ; align to I
61 (unpack FMT (AT DATA))
63 1 0)) ; return second term's first item
66 ;; Pack a newlisp data element according to marshalling type The
67 ;; newlisp data is integer, double, string or list (for container and
70 'FMTMAP ; mapping dbus type code to byte size and newlisp code
71 '( ("y" 1 "b") ; BYTE (unsigned 8-bit integer)
72 ("b" 1 "b") ; BOOLEAN (0 is FALSE, 1 is TRUE, else invalid)
73 ("n" 2 "d") ; INT16 (signed 16-bit integer)
74 ("q" 2 "u") ; UINT16 (unsigned 16-bit integer)
75 ("i" 4 "ld") ; INT32 (signed 32-bit integer)
76 ("u" 4 "lu") ; UINT32 (unsigned 32-bit integer)
77 ("x" 8 "Ld") ; INT64 (signed 64-bit integer)
78 ("t" 8 "Lu") ; UINT64 (unsigned 64-bit integer)
79 ("d" 8 "lf") ; DOUBLE (64-bit float)
80 ("h" 4 "lu") ; UINT32 (unix file descriptor)
81 ("a" ? ?) ; ARRAY = UINT32 byte-length, items
82 ("s" ? ?) ; STRING = length + data + NUL
83 ("o" ? ?) ; OBJECT_PATH = BYTE length + data + NUL
84 ("g" ? ?) ; SIGNATURE = BYTE length + data + NUL
85 ("(" ? ?) ; STRUCT begin in signature = (8-align) + data
86 (")" 0 ?) ; STRUCT end in signature
87 ("v" ? ?) ; VARIANT = signature + data
88 ("{" ? ?) ; DICT_ENTRY begin
89 ("}" ? ?) ; DICT_ENTRY end
90 ("r" ? ?) ; reserved STRUCT in bindings?
91 ("e" ? ?) ; reserved DICT_ENTRY in bindings ?
92 ("m" ? ?) ; reserved 'maybe'
93 ("*" ? ?) ; reserved 'single complete type'
94 ("?" ? ?) ; reserved 'basic type'
101 (define (pack-data-item ES DATA)
102 ;;(println (list 'pack-data-item AT ES DATA))
103 (if (list? ES) (pack-data-struct ES DATA)
104 (find ES "osg") (pack-data-string ES DATA)
105 (= ES "v") (apply pack-data-variant DATA)
106 (if (lookup ES FMTMAP) (pack-align (pack $it DATA)))))
108 (define (pack-data-variant ES DATA)
109 ;;(println (list 'pack-data-variant AT ES DATA))
110 (extend (pack-align (pack "bbb" 1 (char ES) 0) 1)
111 (pack-data-item ES DATA)))
113 (define (pack-data-string ES DATA)
114 (pack-align (pack (format "lus%db" (length DATA)) (length DATA) DATA 0) 1))
116 ;; Pack an array. DATA elements marshalled by repeating ES, preceded
117 ;; by the array length in bytes as aligned UINT32.
118 (define (pack-data-array ES DATA)
119 ;;(println (list 'pack-data-array AT ES DATA))
120 (let ((PAD (pack-align "" 4))
121 (X (inc AT 4)) ; start index of array bytes
122 (DATA (apply extend (map (curry pack-data-item ES) DATA))))
123 (extend PAD (pack "lu" (- AT X)) DATA)))
125 ;; Pack a struct. ES and DATA elements marshalled pairwise in order
126 ;; following an initial8-byte alignment.
127 (define (pack-data-struct ES DATA)
128 ;;(println (list 'pack-data-struct AT ES DATA))
130 (pack-data-array (ES 1) DATA)
131 (apply extend (cons (pack-align "" 8)
132 (map pack-data-item ES DATA)))))
134 ;;########## unpacking
137 (inc AT (% (- I (% AT I)) I)))
139 (define (unpack-align I FMT)
141 (prog1 ((unpack FMT (AT DATA)) 0) (inc AT I)))
143 (define (unpack-data-string ES)
144 ;;(println (list 'unpack-data-string ES AT (unpack "bbbb" (AT DATA))))
145 (let ((N (if (= "g" ES) (unpack-align 1 "b") (unpack-align 4 "lu"))))
146 (prog1 (unpack (string "s" N) (AT DATA)) (inc AT (+ 1 N)))))
148 (define (unpack-data-variant)
149 ;;(println (unpack "bbbb" (AT DATA)))
150 (let ((ES (char ((unpack "bbb" (AT DATA)) 1))))
152 (unpack-data-item ES)))
154 ;; Unpack the ES item from (AT DATA) and increment AT
155 (define (unpack-data-item ES)
156 ;;(println (list 'unpack-data-item ES AT (unpack "b" (AT DATA))))
157 ;;(when (= ES "\000") (println (history true)))
158 (if (list? ES) (unpack-data-struct ES)
159 (find ES "+gosg") (unpack-data-string ES)
160 (= ES "v") (unpack-data-variant)
161 (if (assoc ES FMTMAP) (unpack-align ($it -2) ($it -1)))))
163 ;; Unpack array with ES elements. The array begins with an UINT32
164 ;; field telling how many bytes to unpack
165 (define (unpack-data-array ES)
166 ;;(println (list 'unpack-data-array ES))
167 (let ((A AT) (N (+ (unpack-align 4 "u") AT)) (OUT '()))
169 ;;(println (list 'item AT N))
170 (push (unpack-data-item ES) OUT -1))
173 ;; Unpack a structure or array with ES fields.
174 (define (unpack-data-struct ES)
175 (if (= "a" (ES 0)) (unpack-data-array (ES 1))
176 (begin (align-AT 8) (map unpack-data-item ES))))
178 ;; Unpack from a DATA string according to signature SIGN This returns
179 ;; a pair (unpacked pos) of unpacked data and how much data is
181 (define (unpack-data SIGN DATA (AT 0))
182 ;;(println (list 'unpack-data SIGN "DATA length " (length DATA)))
183 ;;(map println (explode (unpack (dup "b" (length (AT DATA))) (AT DATA)) 20))
184 (list (unpack-data-item (expand-signature SIGN)) AT))