;;; bindat.el --- binary data structure packing and unpacking.
-;; Copyright (C) 2002 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Assignment name: struct.el
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; The corresponding Lisp bindat specification looks like this:
;;
-;; (setq header-spec
+;; (setq header-bindat-spec
;; '((dest-ip ip)
;; (src-ip ip)
;; (dest-port u16)
;; (src-port u16)))
;;
-;; (setq data-spec
+;; (setq data-bindat-spec
;; '((type u8)
;; (opcode u8)
;; (length u16r) ;; little endian order
;; (data vec (length))
;; (align 4)))
;;
-;; (setq packet-spec
-;; '((header struct header-spec)
+;; (setq packet-bindat-spec
+;; '((header struct header-bindat-spec)
;; (items u8)
;; (fill 3)
;; (item repeat (items)
-;; (struct data-spec))))
+;; (struct data-bindat-spec))))
;;
;;
;; A binary data representation may look like
;; Binary Data Structure Specification Format
;; ------------------------------------------
+;; We recommend using names that end in `-bindat-spec'; such names
+;; are recognized automatically as "risky" variables.
+
;; The data specification is formatted as follows:
;; SPEC ::= ( ITEM... )
;; | u16r | u24r | u32r -- little endian byte order.
;; | str LEN -- LEN byte string
;; | strz LEN -- LEN byte (zero-terminated) string
-;; | vec LEN -- LEN byte vector
+;; | vec LEN [TYPE] -- vector of LEN items of TYPE (default: u8)
;; | ip -- 4 byte vector
;; | bits LEN -- List with bits set in LEN bytes.
;;
;; | INTEGER_CONSTANT
;; | DEREF
-;; DEREF ::= ( [NAME | INTEGER]... ) -- Field NAME or Array index relative to
-;; current structure spec.
+;; DEREF ::= ( [NAME | INTEGER]... ) -- Field NAME or Array index relative
+;; to current structure spec.
;; -- see bindat-get-field
;; A `union' specification
;; ([FIELD] eval FORM)
;; is interpreted by evalling FORM for its side effects only.
;; If FIELD is specified, the value is bound to that field.
-;; The FORM may access and update `raw-data' and `pos' (see `bindat-unpack'),
-;; as well as the lisp data structure in `struct'.
+;; The FORM may access and update `bindat-raw' and `bindat-idx' (see `bindat-unpack').
;;; Code:
;; Helper functions for structure unpacking.
-;; Relies on dynamic binding of RAW-DATA and POS
+;; Relies on dynamic binding of BINDAT-RAW and BINDAT-IDX
-(defvar raw-data)
-(defvar pos)
+(defvar bindat-raw)
+(defvar bindat-idx)
(defun bindat--unpack-u8 ()
(prog1
- (if (stringp raw-data)
- (string-to-char (substring raw-data pos (1+ pos)))
- (aref raw-data pos))
- (setq pos (1+ pos))))
+ (aref bindat-raw bindat-idx)
+ (setq bindat-idx (1+ bindat-idx))))
(defun bindat--unpack-u16 ()
- (let* ((a (bindat--unpack-u8)) (b (bindat--unpack-u8)))
- (logior (lsh a 8) b)))
+ (logior (lsh (bindat--unpack-u8) 8) (bindat--unpack-u8)))
(defun bindat--unpack-u24 ()
- (let* ((a (bindat--unpack-u16)) (b (bindat--unpack-u8)))
- (logior (lsh a 8) b)))
+ (logior (lsh (bindat--unpack-u16) 8) (bindat--unpack-u8)))
(defun bindat--unpack-u32 ()
- (let* ((a (bindat--unpack-u16)) (b (bindat--unpack-u16)))
- (logior (lsh a 16) b)))
+ (logior (lsh (bindat--unpack-u16) 16) (bindat--unpack-u16)))
(defun bindat--unpack-u16r ()
- (let* ((a (bindat--unpack-u8)) (b (bindat--unpack-u8)))
- (logior a (lsh b 8))))
+ (logior (bindat--unpack-u8) (lsh (bindat--unpack-u8) 8)))
(defun bindat--unpack-u24r ()
- (let* ((a (bindat--unpack-u16r)) (b (bindat--unpack-u8)))
- (logior a (lsh b 16))))
+ (logior (bindat--unpack-u16r) (lsh (bindat--unpack-u8) 16)))
(defun bindat--unpack-u32r ()
- (let* ((a (bindat--unpack-u16r)) (b (bindat--unpack-u16r)))
- (logior a (lsh b 16))))
+ (logior (bindat--unpack-u16r) (lsh (bindat--unpack-u16r) 16)))
-(defun bindat--unpack-item (type len)
+(defun bindat--unpack-item (type len &optional vectype)
(if (eq type 'ip)
(setq type 'vec len 4))
(cond
j (lsh j -1)))))
bits))
((eq type 'str)
- (let ((s (substring raw-data pos (+ pos len))))
- (setq pos (+ pos len))
+ (let ((s (substring bindat-raw bindat-idx (+ bindat-idx len))))
+ (setq bindat-idx (+ bindat-idx len))
(if (stringp s) s
(string-make-unibyte (concat s)))))
((eq type 'strz)
(let ((i 0) s)
- (while (and (< i len) (/= (aref raw-data (+ pos i)) 0))
+ (while (and (< i len) (/= (aref bindat-raw (+ bindat-idx i)) 0))
(setq i (1+ i)))
- (setq s (substring raw-data pos (+ pos i)))
- (setq pos (+ pos len))
+ (setq s (substring bindat-raw bindat-idx (+ bindat-idx i)))
+ (setq bindat-idx (+ bindat-idx len))
(if (stringp s) s
(string-make-unibyte (concat s)))))
((eq type 'vec)
- (let ((v (make-vector len 0)) (i 0))
+ (let ((v (make-vector len 0)) (i 0) (vlen 1))
+ (if (consp vectype)
+ (setq vlen (nth 1 vectype)
+ vectype (nth 2 vectype))
+ (setq type (or vectype 'u8)
+ vectype nil))
(while (< i len)
- (aset v i (bindat--unpack-u8))
+ (aset v i (bindat--unpack-item type vlen vectype))
(setq i (1+ i)))
v))
(t nil)))
(field (car item))
(type (nth 1 item))
(len (nth 2 item))
+ (vectype (and (eq type 'vec) (nth 3 item)))
(tail 3)
data)
(setq spec (cdr spec))
(setq data (eval len))
(eval len)))
((eq type 'fill)
- (setq pos (+ pos len)))
+ (setq bindat-idx (+ bindat-idx len)))
((eq type 'align)
- (while (/= (% pos len) 0)
- (setq pos (1+ pos))))
+ (while (/= (% bindat-idx len) 0)
+ (setq bindat-idx (1+ bindat-idx))))
((eq type 'struct)
(setq data (bindat--unpack-group (eval len))))
((eq type 'repeat)
- (let ((index 0))
- (while (< index len)
+ (let ((index 0) (count len))
+ (while (< index count)
(setq data (cons (bindat--unpack-group (nthcdr tail item)) data))
(setq index (1+ index)))
(setq data (nreverse data))))
(setq data (bindat--unpack-group (cdr case))
cases nil)))))
(t
- (setq data (bindat--unpack-item type len)
+ (setq data (bindat--unpack-item type len vectype)
last data)))
(if data
(if field
(setq struct (append data struct))))))
struct))
-(defun bindat-unpack (spec raw-data &optional pos)
- "Return structured data according to SPEC for binary data in RAW-DATA.
-RAW-DATA is a string or vector. Optional third arg POS specifies the
-starting offset in RAW-DATA."
- (unless pos (setq pos 0))
+(defun bindat-unpack (spec bindat-raw &optional bindat-idx)
+ "Return structured data according to SPEC for binary data in BINDAT-RAW.
+BINDAT-RAW is a unibyte string or vector.
+Optional third arg BINDAT-IDX specifies the starting offset in BINDAT-RAW."
+ (when (multibyte-string-p bindat-raw)
+ (error "String is multibyte"))
+ (unless bindat-idx (setq bindat-idx 0))
(bindat--unpack-group spec))
(defun bindat-get-field (struct &rest field)
struct)
-;; Calculate raw-data length of structured data
+;; Calculate bindat-raw length of structured data
(defvar bindat--fixed-length-alist
'((u8 . 1) (byte . 1)
(field (car item))
(type (nth 1 item))
(len (nth 2 item))
+ (vectype (and (eq type 'vec) (nth 3 item)))
(tail 3))
(setq spec (cdr spec))
(if (and (consp field) (eq (car field) 'eval))
(setq len (apply 'bindat-get-field struct len)))
(if (not len)
(setq len 1))
+ (while (eq type 'vec)
+ (let ((vlen 1))
+ (if (consp vectype)
+ (setq len (* len (nth 1 vectype))
+ type (nth 2 vectype))
+ (setq type (or vectype 'u8)
+ vectype nil))))
(cond
((eq type 'eval)
(if field
(setq struct (cons (cons field (eval len)) struct))
(eval len)))
((eq type 'fill)
- (setq pos (+ pos len)))
+ (setq bindat-idx (+ bindat-idx len)))
((eq type 'align)
- (while (/= (% pos len) 0)
- (setq pos (1+ pos))))
+ (while (/= (% bindat-idx len) 0)
+ (setq bindat-idx (1+ bindat-idx))))
((eq type 'struct)
(bindat--length-group
(if field (bindat-get-field struct field) struct) (eval len)))
((eq type 'repeat)
- (let ((index 0))
- (while (< index len)
- (bindat--length-group (nth index (bindat-get-field struct field)) (nthcdr tail item))
+ (let ((index 0) (count len))
+ (while (< index count)
+ (bindat--length-group
+ (nth index (bindat-get-field struct field))
+ (nthcdr tail item))
(setq index (1+ index)))))
((eq type 'union)
(let ((tag len) (cases (nthcdr tail item)) case cc)
(setq cases nil))))))
(t
(if (setq type (assq type bindat--fixed-length-alist))
- (setq len (cdr type)))
+ (setq len (* len (cdr type))))
(if field
(setq last (bindat-get-field struct field)))
- (setq pos (+ pos len))))))))
+ (setq bindat-idx (+ bindat-idx len))))))))
(defun bindat-length (spec struct)
- "Calculate raw-data length for STRUCT according to bindat specification SPEC."
- (let ((pos 0))
+ "Calculate bindat-raw length for STRUCT according to bindat SPEC."
+ (let ((bindat-idx 0))
(bindat--length-group struct spec)
- pos))
+ bindat-idx))
-;; Pack structured data into raw-data
+;; Pack structured data into bindat-raw
(defun bindat--pack-u8 (v)
- (aset raw-data pos (logand v 255))
- (setq pos (1+ pos)))
+ (aset bindat-raw bindat-idx (logand v 255))
+ (setq bindat-idx (1+ bindat-idx)))
(defun bindat--pack-u16 (v)
- (aset raw-data pos (logand (lsh v -8) 255))
- (aset raw-data (1+ pos) (logand v 255))
- (setq pos (+ pos 2)))
+ (aset bindat-raw bindat-idx (logand (lsh v -8) 255))
+ (aset bindat-raw (1+ bindat-idx) (logand v 255))
+ (setq bindat-idx (+ bindat-idx 2)))
(defun bindat--pack-u24 (v)
(bindat--pack-u8 (lsh v -16))
(bindat--pack-u16 v))
(defun bindat--pack-u16r (v)
- (aset raw-data (1+ pos) (logand (lsh v -8) 255))
- (aset raw-data pos (logand v 255))
- (setq pos (+ pos 2)))
+ (aset bindat-raw (1+ bindat-idx) (logand (lsh v -8) 255))
+ (aset bindat-raw bindat-idx (logand v 255))
+ (setq bindat-idx (+ bindat-idx 2)))
(defun bindat--pack-u24r (v)
(bindat--pack-u16r v)
(bindat--pack-u16r v)
(bindat--pack-u16r (lsh v -16)))
-(defun bindat--pack-item (v type len)
+(defun bindat--pack-item (v type len &optional vectype)
(if (eq type 'ip)
(setq type 'vec len 4))
(cond
((null v)
- (setq pos (+ pos len)))
+ (setq bindat-idx (+ bindat-idx len)))
((memq type '(u8 byte))
(bindat--pack-u8 v))
((memq type '(u16 word short))
(setq bnum (1- bnum)
j (lsh j -1))))
(bindat--pack-u8 m))))
- ((memq type '(str strz vec))
+ ((memq type '(str strz))
(let ((l (length v)) (i 0))
(if (> l len) (setq l len))
(while (< i l)
- (aset raw-data (+ pos i) (aref v i))
+ (aset bindat-raw (+ bindat-idx i) (aref v i))
(setq i (1+ i)))
- (setq pos (+ pos len))))
+ (setq bindat-idx (+ bindat-idx len))))
+ ((eq type 'vec)
+ (let ((l (length v)) (i 0) (vlen 1))
+ (if (consp vectype)
+ (setq vlen (nth 1 vectype)
+ vectype (nth 2 vectype))
+ (setq type (or vectype 'u8)
+ vectype nil))
+ (if (> l len) (setq l len))
+ (while (< i l)
+ (bindat--pack-item (aref v i) type vlen vectype)
+ (setq i (1+ i)))))
(t
- (setq pos (+ pos len)))))
+ (setq bindat-idx (+ bindat-idx len)))))
(defun bindat--pack-group (struct spec)
(let (last)
(field (car item))
(type (nth 1 item))
(len (nth 2 item))
+ (vectype (and (eq type 'vec) (nth 3 item)))
(tail 3))
(setq spec (cdr spec))
(if (and (consp field) (eq (car field) 'eval))
(setq struct (cons (cons field (eval len)) struct))
(eval len)))
((eq type 'fill)
- (setq pos (+ pos len)))
+ (setq bindat-idx (+ bindat-idx len)))
((eq type 'align)
- (while (/= (% pos len) 0)
- (setq pos (1+ pos))))
+ (while (/= (% bindat-idx len) 0)
+ (setq bindat-idx (1+ bindat-idx))))
((eq type 'struct)
(bindat--pack-group
(if field (bindat-get-field struct field) struct) (eval len)))
((eq type 'repeat)
- (let ((index 0))
- (while (< index len)
- (bindat--pack-group (nth index (bindat-get-field struct field)) (nthcdr tail item))
+ (let ((index 0) (count len))
+ (while (< index count)
+ (bindat--pack-group
+ (nth index (bindat-get-field struct field))
+ (nthcdr tail item))
(setq index (1+ index)))))
((eq type 'union)
(let ((tag len) (cases (nthcdr tail item)) case cc)
(setq cases nil))))))
(t
(setq last (bindat-get-field struct field))
- (bindat--pack-item last type len)
+ (bindat--pack-item last type len vectype)
))))))
-(defun bindat-pack (spec struct &optional raw-data pos)
+(defun bindat-pack (spec struct &optional bindat-raw bindat-idx)
"Return binary data packed according to SPEC for structured data STRUCT.
-Optional third arg RAW-DATA is a pre-allocated string or vector to unpack into.
-Optional fourth arg POS is the starting offset into RAW-DATA.
-Note: The result is a multibyte string; use `string-make-unibyte' on it
-to make it unibyte if necessary."
- (let ((no-return raw-data))
- (unless pos (setq pos 0))
- (unless raw-data (setq raw-data (make-vector (+ pos (bindat-length spec struct)) 0)))
+Optional third arg BINDAT-RAW is a pre-allocated unibyte string or vector to
+pack into.
+Optional fourth arg BINDAT-IDX is the starting offset into BINDAT-RAW."
+ (when (multibyte-string-p bindat-raw)
+ (error "Pre-allocated string is multibyte"))
+ (let ((no-return bindat-raw))
+ (unless bindat-idx (setq bindat-idx 0))
+ (unless bindat-raw
+ (setq bindat-raw (make-vector (+ bindat-idx (bindat-length spec struct)) 0)))
(bindat--pack-group struct spec)
- (if no-return nil (concat raw-data))))
+ (if no-return nil (concat bindat-raw))))
;; Misc. format conversions
(bindat-format-vector vect "%02x" (if (stringp sep) sep ":")))
(defun bindat-ip-to-string (ip)
- "Format vector IP as an ip address in dotted notation."
- (format "%d.%d.%d.%d"
- (aref ip 0) (aref ip 1) (aref ip 2) (aref ip 3)))
+ "Format vector IP as an ip address in dotted notation.
+The port (if any) is omitted. IP can be a string, as well."
+ (if (vectorp ip)
+ (format-network-address ip t)
+ (format "%d.%d.%d.%d"
+ (aref ip 0) (aref ip 1) (aref ip 2) (aref ip 3))))
(provide 'bindat)