;;; bindat.el --- binary data structure packing and unpacking.
-;; Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
;; Author: Kim F. Storm <storm@cua.dk>
;; Assignment name: struct.el
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; 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.
;;
(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
(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))
((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
(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."
+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))
(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
(bindat--length-group
(if field (bindat-get-field struct field) struct) (eval len)))
((eq type 'repeat)
- (let ((index 0))
- (while (< index len)
+ (let ((index 0) (count len))
+ (while (< index count)
(bindat--length-group
(nth index (bindat-get-field struct field))
(nthcdr tail item))
(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 bindat-idx (+ bindat-idx len))))))))
(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
(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 bindat-raw (+ bindat-idx i) (aref v i))
(setq i (1+ i)))
(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 bindat-idx (+ bindat-idx len)))))
(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))
(bindat--pack-group
(if field (bindat-get-field struct field) struct) (eval len)))
((eq type 'repeat)
- (let ((index 0))
- (while (< index len)
+ (let ((index 0) (count len))
+ (while (< index count)
(bindat--pack-group
(nth index (bindat-get-field struct field))
(nthcdr tail item))
(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 bindat-raw bindat-idx)
(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)))
+ (setq bindat-raw (make-string (+ bindat-idx (bindat-length spec struct)) 0)))
(bindat--pack-group struct spec)
- (if no-return nil (concat bindat-raw))))
+ (if no-return nil bindat-raw)))
;; Misc. format conversions
(provide 'bindat)
-;;; arch-tag: 5e6708c3-03e2-4ad7-9885-5041b779c3fb
+;; arch-tag: 5e6708c3-03e2-4ad7-9885-5041b779c3fb
;;; bindat.el ends here