1;;; bindat.el --- binary data structure packing and unpacking.
2
3;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
4
5;; Author: Kim F. Storm <storm@cua.dk>
6;; Assignment name: struct.el
7;; Keywords: comm data processes
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 2, or (at your option)
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING.  If not, write to the
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
25
26;;; Commentary:
27
28;;  Packing and unpacking of (binary) data structures.
29;;
30;;  The data formats used in binary files and network protocols are
31;;  often structed data which can be described by a C-style structure
32;;  such as the one shown below.  Using the bindat package, decoding
33;;  and encoding binary data formats like these is made simple using a
34;;  structure specification which closely resembles the C style
35;;  structure declarations.
36;;
37;;  Encoded (binary) data is stored in a unibyte string or vector,
38;;  while the decoded data is stored in an alist with (FIELD . VALUE)
39;;  pairs.
40
41;; Example:
42
43;;  Consider the following C structures:
44;;
45;;  struct header {
46;;	unsigned long	dest_ip;
47;;	unsigned long	src_ip;
48;;	unsigned short	dest_port;
49;;	unsigned short	src_port;
50;;  };
51;;
52;;  struct data {
53;;	unsigned char	type;
54;;	unsigned char	opcode;
55;;	unsigned long	length;  /* In little endian order */
56;;	unsigned char	id[8];   /* nul-terminated string  */
57;;	unsigned char	data[/* (length + 3) & ~3 */];
58;;  };
59;;
60;;  struct packet {
61;;	struct header	header;
62;;	unsigned char	items;
63;;	unsigned char   filler[3];
64;;	struct data	item[/* items */];
65;;  };
66;;
67;;  The corresponding Lisp bindat specification looks like this:
68;;
69;;  (setq header-bindat-spec
70;;    '((dest-ip   ip)
71;;	(src-ip    ip)
72;;	(dest-port u16)
73;;	(src-port  u16)))
74;;
75;;  (setq data-bindat-spec
76;;    '((type      u8)
77;;	(opcode	   u8)
78;;	(length	   u16r)  ;; little endian order
79;;	(id	   strz 8)
80;;	(data	   vec (length))
81;;	(align     4)))
82;;
83;;  (setq packet-bindat-spec
84;;    '((header    struct header-bindat-spec)
85;;	(items     u8)
86;;	(fill      3)
87;;	(item	   repeat (items)
88;;		   (struct data-bindat-spec))))
89;;
90;;
91;;  A binary data representation may look like
92;;   [ 192 168 1 100 192 168 1 101 01 28 21 32 2 0 0 0
93;;     2 3 5 0 ?A ?B ?C ?D ?E ?F 0 0 1 2 3 4 5 0 0 0
94;;     1 4 7 0 ?B ?C ?D ?E ?F ?G 0 0 6 7 8 9 10 11 12 0 ]
95;;
96;;  The corresponding decoded structure looks like
97;;
98;;      ((header
99;;        (dest-ip   . [192 168 1 100])
100;;        (src-ip    . [192 168 1 101])
101;;        (dest-port . 284)
102;;        (src-port  . 5408))
103;;       (items . 2)
104;;       (item ((data . [1 2 3 4 5])
105;;      	(id . "ABCDEF")
106;;      	(length . 5)
107;;      	(opcode . 3)
108;;      	(type . 2))
109;;             ((data . [6 7 8 9 10 11 12])
110;;      	(id . "BCDEFG")
111;;      	(length . 7)
112;;      	(opcode . 4)
113;;      	(type . 1))))
114;;
115;;  To access a specific value in this structure, use the function
116;;  bindat-get-field with the structure as first arg followed by a list
117;;  of field names and array indexes, e.g. using the data above,
118;;    (bindat-get-field decoded-structure 'item 1 'id)
119;;  returns "BCDEFG".
120
121;; Binary Data Structure Specification Format
122;; ------------------------------------------
123
124;; We recommend using names that end in `-bindat-spec'; such names
125;; are recognized automatically as "risky" variables.
126
127;; The data specification is formatted as follows:
128
129;; SPEC    ::= ( ITEM... )
130
131;; ITEM    ::= ( [FIELD] TYPE )
132;;          |  ( [FIELD] eval FORM )    -- eval FORM for side-effect only
133;;          |  ( [FIELD] fill LEN )     -- skip LEN bytes
134;;          |  ( [FIELD] align LEN )    -- skip to next multiple of LEN bytes
135;;          |  ( [FIELD] struct SPEC_NAME )
136;;          |  ( [FIELD] union TAG_VAL (TAG SPEC)... [(t SPEC)] )
137;;          |  ( [FIELD] repeat COUNT ITEM... )
138
139;;          -- In (eval EXPR), the value of the last field is available in
140;;             the dynamically bound variable `last'.
141
142;; TYPE    ::= ( eval EXPR )		-- interpret result as TYPE
143;;	    |  u8   | byte		-- length 1
144;;          |  u16  | word | short      -- length 2, network byte order
145;;          |  u24                      -- 3-byte value
146;;          |  u32  | dword | long      -- length 4, network byte order
147;;          |  u16r | u24r | u32r       -- little endian byte order.
148;;	    |  str LEN                  -- LEN byte string
149;;          |  strz LEN                 -- LEN byte (zero-terminated) string
150;;          |  vec LEN [TYPE]           -- vector of LEN items of TYPE (default: u8)
151;;          |  ip                       -- 4 byte vector
152;;          |  bits LEN                 -- List with bits set in LEN bytes.
153;;
154;;          -- Note: 32 bit values may be limited by emacs' INTEGER
155;;             implementation limits.
156;;
157;;          -- Example: `bits 2' will unpack 0x28 0x1c to (2 3 4 11 13)
158;;                                       and 0x1c 0x28 to (3 5 10 11 12).
159
160;; FIELD   ::= ( eval EXPR )		-- use result as NAME
161;;          |  NAME
162
163;; LEN     ::= ARG
164;;          |  <omitted> | nil		-- LEN = 1
165
166
167;; TAG_VAL ::= ARG
168
169;; TAG     ::= LISP_CONSTANT
170;;          |  ( eval EXPR )		-- return non-nil if tag match;
171;;					   current TAG_VAL in `tag'.
172
173;; ARG     ::= ( eval EXPR )		-- interpret result as ARG
174;;          |  INTEGER_CONSTANT
175;;          |  DEREF
176
177;; DEREF   ::= ( [NAME | INTEGER]... )	-- Field NAME or Array index relative
178;;                                         to current structure spec.
179;;                                      -- see bindat-get-field
180
181;; A `union' specification
182;;    ([FIELD] union TAG_VAL (TAG SPEC) ... [(t SPEC)])
183;; is interpreted by evalling TAG_VAL and then comparing that to
184;; each TAG using equal; if a match is found, the corresponding SPEC
185;; is used.
186;; If TAG is a form (eval EXPR), EXPR is evalled with `tag' bound to the
187;; value of TAG_VAL; the corresponding SPEC is used if the result is non-nil.
188;; Finally, if TAG is t, the corresponding SPEC is used unconditionally.
189;;
190;; An `eval' specification
191;;  ([FIELD] eval FORM)
192;; is interpreted by evalling FORM for its side effects only.
193;; If FIELD is specified, the value is bound to that field.
194;; The FORM may access and update `bindat-raw' and `bindat-idx' (see `bindat-unpack').
195
196;;; Code:
197
198;; Helper functions for structure unpacking.
199;; Relies on dynamic binding of BINDAT-RAW and BINDAT-IDX
200
201(defvar bindat-raw)
202(defvar bindat-idx)
203
204(defun bindat--unpack-u8 ()
205  (prog1
206    (aref bindat-raw bindat-idx)
207    (setq bindat-idx (1+ bindat-idx))))
208
209(defun bindat--unpack-u16 ()
210  (logior (lsh (bindat--unpack-u8) 8) (bindat--unpack-u8)))
211
212(defun bindat--unpack-u24 ()
213  (logior (lsh (bindat--unpack-u16) 8) (bindat--unpack-u8)))
214
215(defun bindat--unpack-u32 ()
216  (logior (lsh (bindat--unpack-u16) 16) (bindat--unpack-u16)))
217
218(defun bindat--unpack-u16r ()
219  (logior (bindat--unpack-u8) (lsh (bindat--unpack-u8) 8)))
220
221(defun bindat--unpack-u24r ()
222  (logior (bindat--unpack-u16r) (lsh (bindat--unpack-u8) 16)))
223
224(defun bindat--unpack-u32r ()
225  (logior (bindat--unpack-u16r) (lsh (bindat--unpack-u16r) 16)))
226
227(defun bindat--unpack-item (type len &optional vectype)
228  (if (eq type 'ip)
229      (setq type 'vec len 4))
230  (cond
231   ((memq type '(u8 byte))
232    (bindat--unpack-u8))
233   ((memq type '(u16 word short))
234    (bindat--unpack-u16))
235   ((eq type 'u24)
236    (bindat--unpack-u24))
237   ((memq type '(u32 dword long))
238    (bindat--unpack-u32))
239   ((eq type 'u16r)
240    (bindat--unpack-u16r))
241   ((eq type 'u24r)
242    (bindat--unpack-u24r))
243   ((eq type 'u32r)
244    (bindat--unpack-u32r))
245   ((eq type 'bits)
246    (let ((bits nil) (bnum (1- (* 8 len))) j m)
247      (while (>= bnum 0)
248	(if (= (setq m (bindat--unpack-u8)) 0)
249	    (setq bnum (- bnum 8))
250	  (setq j 128)
251	  (while (> j 0)
252	    (if (/= 0 (logand m j))
253		(setq bits (cons bnum bits)))
254	    (setq bnum (1- bnum)
255		  j (lsh j -1)))))
256      bits))
257   ((eq type 'str)
258    (let ((s (substring bindat-raw bindat-idx (+ bindat-idx len))))
259      (setq bindat-idx (+ bindat-idx len))
260      (if (stringp s) s
261	(string-make-unibyte (concat s)))))
262   ((eq type 'strz)
263    (let ((i 0) s)
264      (while (and (< i len) (/= (aref bindat-raw (+ bindat-idx i)) 0))
265	(setq i (1+ i)))
266      (setq s (substring bindat-raw bindat-idx (+ bindat-idx i)))
267      (setq bindat-idx (+ bindat-idx len))
268      (if (stringp s) s
269	(string-make-unibyte (concat s)))))
270   ((eq type 'vec)
271    (let ((v (make-vector len 0)) (i 0) (vlen 1))
272      (if (consp vectype)
273	  (setq vlen (nth 1 vectype)
274		vectype (nth 2 vectype))
275	(setq type (or vectype 'u8)
276	      vectype nil))
277      (while (< i len)
278	(aset v i (bindat--unpack-item type vlen vectype))
279	(setq i (1+ i)))
280      v))
281   (t nil)))
282
283(defun bindat--unpack-group (spec)
284  (let (struct last)
285    (while spec
286      (let* ((item (car spec))
287	     (field (car item))
288	     (type (nth 1 item))
289	     (len (nth 2 item))
290	     (vectype (and (eq type 'vec) (nth 3 item)))
291	     (tail 3)
292	     data)
293	(setq spec (cdr spec))
294	(if (and (consp field) (eq (car field) 'eval))
295	    (setq field (eval (car (cdr field)))))
296	(if (and type (consp type) (eq (car type) 'eval))
297	    (setq type (eval (car (cdr type)))))
298	(if (and len (consp len) (eq (car len) 'eval))
299	    (setq len (eval (car (cdr len)))))
300	(if (memq field '(eval fill align struct union))
301	    (setq tail 2
302		  len type
303		  type field
304		  field nil))
305	(if (and (consp len) (not (eq type 'eval)))
306	    (setq len (apply 'bindat-get-field struct len)))
307	(if (not len)
308	    (setq len 1))
309	(cond
310	 ((eq type 'eval)
311	  (if field
312	      (setq data (eval len))
313	    (eval len)))
314	 ((eq type 'fill)
315	  (setq bindat-idx (+ bindat-idx len)))
316	 ((eq type 'align)
317	  (while (/= (% bindat-idx len) 0)
318	    (setq bindat-idx (1+ bindat-idx))))
319	 ((eq type 'struct)
320	  (setq data (bindat--unpack-group (eval len))))
321	 ((eq type 'repeat)
322	  (let ((index 0) (count len))
323	    (while (< index count)
324	      (setq data (cons (bindat--unpack-group (nthcdr tail item)) data))
325	      (setq index (1+ index)))
326	    (setq data (nreverse data))))
327	 ((eq type 'union)
328	  (let ((tag len) (cases (nthcdr tail item)) case cc)
329	    (while cases
330	      (setq case (car cases)
331		    cases (cdr cases)
332		    cc (car case))
333	      (if (or (equal cc tag) (equal cc t)
334		      (and (consp cc) (eval cc)))
335		  (setq data (bindat--unpack-group (cdr case))
336			cases nil)))))
337	 (t
338	  (setq data (bindat--unpack-item type len vectype)
339		last data)))
340	(if data
341	    (if field
342		(setq struct (cons (cons field data) struct))
343	      (setq struct (append data struct))))))
344    struct))
345
346(defun bindat-unpack (spec bindat-raw &optional bindat-idx)
347  "Return structured data according to SPEC for binary data in BINDAT-RAW.
348BINDAT-RAW is a unibyte string or vector.
349Optional third arg BINDAT-IDX specifies the starting offset in BINDAT-RAW."
350  (when (multibyte-string-p bindat-raw)
351    (error "String is multibyte"))
352  (unless bindat-idx (setq bindat-idx 0))
353  (bindat--unpack-group spec))
354
355(defun bindat-get-field (struct &rest field)
356  "In structured data STRUCT, return value of field named FIELD.
357If multiple field names are specified, use the field names to
358lookup nested sub-structures in STRUCT, corresponding to the
359C-language syntax STRUCT.FIELD1.FIELD2.FIELD3...
360An integer value in the field list is taken as an array index,
361e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
362  (while (and struct field)
363    (setq struct (if (integerp (car field))
364		     (nth (car field) struct)
365		   (let ((val (assq (car field) struct)))
366		     (if (consp val) (cdr val)))))
367    (setq field (cdr field)))
368  struct)
369
370
371;; Calculate bindat-raw length of structured data
372
373(defvar bindat--fixed-length-alist
374  '((u8 . 1) (byte . 1)
375    (u16 . 2) (u16r . 2) (word . 2) (short . 2)
376    (u24 . 3) (u24r . 3)
377    (u32 . 4) (u32r . 4) (dword . 4) (long . 4)
378    (ip . 4)))
379
380(defun bindat--length-group (struct spec)
381  (let (last)
382    (while spec
383      (let* ((item (car spec))
384	     (field (car item))
385	     (type (nth 1 item))
386	     (len (nth 2 item))
387	     (vectype (and (eq type 'vec) (nth 3 item)))
388	     (tail 3))
389	(setq spec (cdr spec))
390	(if (and (consp field) (eq (car field) 'eval))
391	    (setq field (eval (car (cdr field)))))
392	(if (and type (consp type) (eq (car type) 'eval))
393	    (setq type (eval (car (cdr type)))))
394	(if (and len (consp len) (eq (car len) 'eval))
395	    (setq len (eval (car (cdr len)))))
396	(if (memq field '(eval fill align struct union))
397	    (setq tail 2
398		  len type
399		  type field
400		  field nil))
401	(if (and (consp len) (not (eq type 'eval)))
402	    (setq len (apply 'bindat-get-field struct len)))
403	(if (not len)
404	    (setq len 1))
405	(while (eq type 'vec)
406	  (let ((vlen 1))
407	    (if (consp vectype)
408		(setq len (* len (nth 1 vectype))
409		      type (nth 2 vectype))
410	      (setq type (or vectype 'u8)
411		    vectype nil))))
412	(cond
413	 ((eq type 'eval)
414	  (if field
415	      (setq struct (cons (cons field (eval len)) struct))
416	    (eval len)))
417	 ((eq type 'fill)
418	  (setq bindat-idx (+ bindat-idx len)))
419	 ((eq type 'align)
420	  (while (/= (% bindat-idx len) 0)
421	    (setq bindat-idx (1+ bindat-idx))))
422	 ((eq type 'struct)
423	  (bindat--length-group
424	   (if field (bindat-get-field struct field) struct) (eval len)))
425	 ((eq type 'repeat)
426	  (let ((index 0) (count len))
427	    (while (< index count)
428	      (bindat--length-group
429               (nth index (bindat-get-field struct field))
430               (nthcdr tail item))
431	      (setq index (1+ index)))))
432	 ((eq type 'union)
433	  (let ((tag len) (cases (nthcdr tail item)) case cc)
434	    (while cases
435	      (setq case (car cases)
436		    cases (cdr cases)
437		    cc (car case))
438	      (if (or (equal cc tag) (equal cc t)
439		      (and (consp cc) (eval cc)))
440		  (progn
441		    (bindat--length-group struct (cdr case))
442		    (setq cases nil))))))
443	 (t
444	  (if (setq type (assq type bindat--fixed-length-alist))
445	      (setq len (* len (cdr type))))
446	  (if field
447	      (setq last (bindat-get-field struct field)))
448	  (setq bindat-idx (+ bindat-idx len))))))))
449
450(defun bindat-length (spec struct)
451  "Calculate bindat-raw length for STRUCT according to bindat SPEC."
452  (let ((bindat-idx 0))
453    (bindat--length-group struct spec)
454    bindat-idx))
455
456
457;; Pack structured data into bindat-raw
458
459(defun bindat--pack-u8 (v)
460  (aset bindat-raw bindat-idx (logand v 255))
461  (setq bindat-idx (1+ bindat-idx)))
462
463(defun bindat--pack-u16 (v)
464  (aset bindat-raw bindat-idx (logand (lsh v -8) 255))
465  (aset bindat-raw (1+ bindat-idx) (logand v 255))
466  (setq bindat-idx (+ bindat-idx 2)))
467
468(defun bindat--pack-u24 (v)
469  (bindat--pack-u8 (lsh v -16))
470  (bindat--pack-u16 v))
471
472(defun bindat--pack-u32 (v)
473  (bindat--pack-u16 (lsh v -16))
474  (bindat--pack-u16 v))
475
476(defun bindat--pack-u16r (v)
477  (aset bindat-raw (1+ bindat-idx) (logand (lsh v -8) 255))
478  (aset bindat-raw bindat-idx (logand v 255))
479  (setq bindat-idx (+ bindat-idx 2)))
480
481(defun bindat--pack-u24r (v)
482  (bindat--pack-u16r v)
483  (bindat--pack-u8 (lsh v -16)))
484
485(defun bindat--pack-u32r (v)
486  (bindat--pack-u16r v)
487  (bindat--pack-u16r (lsh v -16)))
488
489(defun bindat--pack-item (v type len &optional vectype)
490  (if (eq type 'ip)
491      (setq type 'vec len 4))
492  (cond
493   ((null v)
494    (setq bindat-idx (+ bindat-idx len)))
495   ((memq type '(u8 byte))
496    (bindat--pack-u8 v))
497   ((memq type '(u16 word short))
498    (bindat--pack-u16 v))
499   ((eq type 'u24)
500    (bindat--pack-u24 v))
501   ((memq type '(u32 dword long))
502    (bindat--pack-u32 v))
503   ((eq type 'u16r)
504    (bindat--pack-u16r v))
505   ((eq type 'u24r)
506    (bindat--pack-u24r v))
507   ((eq type 'u32r)
508    (bindat--pack-u32r v))
509   ((eq type 'bits)
510    (let ((bnum (1- (* 8 len))) j m)
511      (while (>= bnum 0)
512	(setq m 0)
513	(if (null v)
514	    (setq bnum (- bnum 8))
515	  (setq j 128)
516	  (while (> j 0)
517	    (if (memq bnum v)
518		(setq m (logior m j)))
519	    (setq bnum (1- bnum)
520		  j (lsh j -1))))
521	(bindat--pack-u8 m))))
522   ((memq type '(str strz))
523    (let ((l (length v)) (i 0))
524      (if (> l len) (setq l len))
525      (while (< i l)
526	(aset bindat-raw (+ bindat-idx i) (aref v i))
527	(setq i (1+ i)))
528      (setq bindat-idx (+ bindat-idx len))))
529   ((eq type 'vec)
530    (let ((l (length v)) (i 0) (vlen 1))
531      (if (consp vectype)
532	  (setq vlen (nth 1 vectype)
533		vectype (nth 2 vectype))
534	(setq type (or vectype 'u8)
535	      vectype nil))
536      (if (> l len) (setq l len))
537      (while (< i l)
538	(bindat--pack-item (aref v i) type vlen vectype)
539	(setq i (1+ i)))))
540   (t
541    (setq bindat-idx (+ bindat-idx len)))))
542
543(defun bindat--pack-group (struct spec)
544  (let (last)
545    (while spec
546      (let* ((item (car spec))
547	     (field (car item))
548	     (type (nth 1 item))
549	     (len (nth 2 item))
550	     (vectype (and (eq type 'vec) (nth 3 item)))
551	     (tail 3))
552	(setq spec (cdr spec))
553	(if (and (consp field) (eq (car field) 'eval))
554	    (setq field (eval (car (cdr field)))))
555	(if (and type (consp type) (eq (car type) 'eval))
556	    (setq type (eval (car (cdr type)))))
557	(if (and len (consp len) (eq (car len) 'eval))
558	    (setq len (eval (car (cdr len)))))
559	(if (memq field '(eval fill align struct union))
560	    (setq tail 2
561		  len type
562		  type field
563		  field nil))
564	(if (and (consp len) (not (eq type 'eval)))
565	    (setq len (apply 'bindat-get-field struct len)))
566	(if (not len)
567	    (setq len 1))
568	(cond
569	 ((eq type 'eval)
570	  (if field
571	      (setq struct (cons (cons field (eval len)) struct))
572	    (eval len)))
573	 ((eq type 'fill)
574	  (setq bindat-idx (+ bindat-idx len)))
575	 ((eq type 'align)
576	  (while (/= (% bindat-idx len) 0)
577	    (setq bindat-idx (1+ bindat-idx))))
578	 ((eq type 'struct)
579	  (bindat--pack-group
580	   (if field (bindat-get-field struct field) struct) (eval len)))
581	 ((eq type 'repeat)
582	  (let ((index 0) (count len))
583	    (while (< index count)
584	      (bindat--pack-group
585               (nth index (bindat-get-field struct field))
586               (nthcdr tail item))
587	      (setq index (1+ index)))))
588	 ((eq type 'union)
589	  (let ((tag len) (cases (nthcdr tail item)) case cc)
590	    (while cases
591	      (setq case (car cases)
592		    cases (cdr cases)
593		    cc (car case))
594	      (if (or (equal cc tag) (equal cc t)
595		      (and (consp cc) (eval cc)))
596		  (progn
597		    (bindat--pack-group struct (cdr case))
598		    (setq cases nil))))))
599	 (t
600	  (setq last (bindat-get-field struct field))
601	  (bindat--pack-item last type len vectype)
602	  ))))))
603
604(defun bindat-pack (spec struct &optional bindat-raw bindat-idx)
605  "Return binary data packed according to SPEC for structured data STRUCT.
606Optional third arg BINDAT-RAW is a pre-allocated unibyte string or vector to
607pack into.
608Optional fourth arg BINDAT-IDX is the starting offset into BINDAT-RAW."
609  (when (multibyte-string-p bindat-raw)
610    (error "Pre-allocated string is multibyte"))
611  (let ((no-return bindat-raw))
612    (unless bindat-idx (setq bindat-idx 0))
613    (unless bindat-raw
614      (setq bindat-raw (make-vector (+ bindat-idx (bindat-length spec struct)) 0)))
615    (bindat--pack-group struct spec)
616    (if no-return nil (concat bindat-raw))))
617
618
619;; Misc. format conversions
620
621(defun bindat-format-vector (vect fmt sep &optional len)
622  "Format vector VECT using element format FMT and separator SEP.
623Result is a string with each element of VECT formatted using FMT and
624separated by the string SEP.  If optional fourth arg LEN is given, use
625only that many elements from VECT."
626  (unless len
627    (setq len (length vect)))
628  (let ((i len) (fmt2 (concat sep fmt)) (s nil))
629    (while (> i 0)
630      (setq i (1- i)
631	    s (cons (format (if (= i 0) fmt fmt2) (aref vect i)) s)))
632    (apply 'concat s)))
633
634(defun bindat-vector-to-dec (vect &optional sep)
635  "Format vector VECT in decimal format separated by dots.
636If optional second arg SEP is a string, use that as separator."
637  (bindat-format-vector vect "%d" (if (stringp sep) sep ".")))
638
639(defun bindat-vector-to-hex (vect &optional sep)
640  "Format vector VECT in hex format separated by dots.
641If optional second arg SEP is a string, use that as separator."
642  (bindat-format-vector vect "%02x" (if (stringp sep) sep ":")))
643
644(defun bindat-ip-to-string (ip)
645  "Format vector IP as an ip address in dotted notation.
646The port (if any) is omitted.  IP can be a string, as well."
647  (if (vectorp ip)
648      (format-network-address ip t)
649    (format "%d.%d.%d.%d"
650            (aref ip 0) (aref ip 1) (aref ip 2) (aref ip 3))))
651
652(provide 'bindat)
653
654;;; arch-tag: 5e6708c3-03e2-4ad7-9885-5041b779c3fb
655;;; bindat.el ends here
656