From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: no-spam@cua.dk (Kim F. Storm) Newsgroups: gmane.emacs.devel Subject: struct.el -- a package to encode/decode binary data Date: 19 Mar 2002 00:12:11 +0100 Sender: emacs-devel-admin@gnu.org Message-ID: <5x1yehpj1w.fsf@kfs2.cua.dk> NNTP-Posting-Host: localhost.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: main.gmane.org 1016506098 11081 127.0.0.1 (19 Mar 2002 02:48:18 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Tue, 19 Mar 2002 02:48:18 +0000 (UTC) Original-Received: from quimby.gnus.org ([80.91.224.244]) by main.gmane.org with esmtp (Exim 3.33 #1 (Debian)) id 16n9fe-0002sd-00 for ; Tue, 19 Mar 2002 03:48:18 +0100 Original-Received: from fencepost.gnu.org ([199.232.76.164]) by quimby.gnus.org with esmtp (Exim 3.12 #1 (Debian)) id 16n9kj-0000wd-00 for ; Tue, 19 Mar 2002 03:53:34 +0100 Original-Received: from localhost ([127.0.0.1] helo=fencepost.gnu.org) by fencepost.gnu.org with esmtp (Exim 3.34 #1 (Debian)) id 16n6IZ-00020d-00; Mon, 18 Mar 2002 18:12:15 -0500 Original-Received: from mail.filanet.dk ([195.215.206.179]) by fencepost.gnu.org with smtp (Exim 3.34 #1 (Debian)) id 16n6Hc-0001y0-00 for ; Mon, 18 Mar 2002 18:11:16 -0500 Original-Received: from kfs2.cua.dk.cua.dk (unknown [10.1.82.3]) by mail.filanet.dk (Postfix) with SMTP id 9793B7C035 for ; Mon, 18 Mar 2002 23:11:13 +0000 (GMT) Original-To: emacs-devel@gnu.org Original-Lines: 393 User-Agent: Gnus/5.09 (Gnus v5.9.0) Emacs/21.2.50 Errors-To: emacs-devel-admin@gnu.org X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.0.5 Precedence: bulk List-Help: List-Post: List-Subscribe: , List-Id: Emacs development discussions. List-Unsubscribe: , List-Archive: Xref: main.gmane.org gmane.emacs.devel:2023 X-Report-Spam: http://spam.gmane.org/gmane.emacs.devel:2023 While writing a package that sends and receives datagrams using the new make-network-process functionality, I quickly found that I needed to be able to encode and decode binary data structures, so I came up with the following package (struct.el). I'd like to hear if something like this already exists, or if others find it should be added to emacs (with more complete documentation of course). [Also, the struct-pack function doesn't work with nested data, but I'll fix that if there is an interest in this package]. ++kfs ------------------------- struct.el -------------------- ;;; struct.el --- basic data structure packing and unpacking. ;; Copyright (C) 2002 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. ;; 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. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; 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., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Commentary: ;; Packing and unpacking of (binary) data structures. ;; ;; The data formats used in binary files and network protocols are ;; often structed data which can be described by a C-style structure ;; such as the one shown below. Using the struct package, decoding ;; and encoding binary data formats like these is made simple using a ;; structure specification which closely resembles the C style ;; structure declarations. ;; ;; Encoded (binary) data is stored in a unibyte string or vector, ;; while the decoded data is stored in an alist with (FIELD . VALUE) ;; pairs. ;; ;;; Example: ;; Consider the following C structures: ;; ;; struct header { ;; unsigned long dest_ip; ;; unsigned long src_ip; ;; unsigned short dest_port; ;; unsigned short src_port; ;; }; ;; ;; struct data { ;; unsigned char type; ;; unsigned char opcode; ;; unsigned long length; /* In little endian order */ ;; unsigned char id[8]; /* nul-terminated string */ ;; unsigned char data[/* (length + 3) & ~3 */]; ;; }; ;; ;; struct packet { ;; struct header header; ;; unsigned char items; ;; unsigned char filler[3]; ;; struct data item[/* items */]; ;; }; ;; ;; The corresponding Lisp struct specification looks like this: ;; ;; (setq header-spec ;; '((dest-ip ip) ;; (src-ip ip) ;; (dest-port u16) ;; (src-port u16))) ;; ;; (setq data-spec ;; '((type u8) ;; (opcode u8) ;; (length u16r) ;; little endian order ;; (id strz 8) ;; (data vec (length)) ;; (align 4))) ;; ;; (setq packet-spec ;; '((header struct header-spec) ;; (items u8) ;; (fill 3) ;; (item repeat (items) ;; ((struct data-spec))))) ;; ;; ;; A binary representation may look like ;; [ 192 168 1 100 192 168 1 101 01 28 21 32 2 0 0 0 ;; 2 3 5 0 ?A ?B ?C ?D ?E ?F 0 0 1 2 3 4 5 0 0 0 ;; 1 4 7 0 ?B ?C ?D ?E ?F ?G 0 0 6 7 8 9 10 11 12 0 ] ;; ;; The corresponding decoded structure looks like ;; ;; ((header ;; (dest-ip . [192 168 1 100]) ;; (src-ip . [192 168 1 101]) ;; (dest-port . 284) ;; (src-port . 5408)) ;; (items . 2) ;; (item ((data . [1 2 3 4 5]) ;; (id . "ABCDEF") ;; (length . 5) ;; (opcode . 3) ;; (type . 2)) ;; ((data . [6 7 8 9 10 11 12]) ;; (id . "BCDEFG") ;; (length . 7) ;; (opcode . 4) ;; (type . 1)))) ;;; Code: ;; Helper functions for structure unpacking. ;; Relies on dynamic binding of RAW-DATA and POS (eval-when-compile (defvar raw-data) (defvar pos)) (defun struct--unpack-u8 () (prog1 (if (stringp raw-data) (string-to-char (substring raw-data pos (1+ pos))) (aref raw-data pos)) (setq pos (1+ pos)))) (defun struct--unpack-u16 () (let* ((a (struct--unpack-u8)) (b (struct--unpack-u8))) (+ (* a 256) b))) (defun struct--unpack-u24 () (let* ((a (struct--unpack-u16)) (b (struct--unpack-u8))) (+ (* a 256) b))) (defun struct--unpack-u32 () (let* ((a (struct--unpack-u16)) (b (struct--unpack-u16))) (+ (* a 65536) b))) (defun struct--unpack-u16r () (let* ((a (struct--unpack-u8)) (b (struct--unpack-u8))) (+ (* b 256) a))) (defun struct--unpack-u24r () (let* ((a (struct--unpack-u16r)) (b (struct--unpack-u8))) (+ (* b 65536) a))) (defun struct--unpack-u32r () (let* ((a (struct--unpack-u16r)) (b (struct--unpack-u16r))) (+ (* b 65536) a))) (defun struct--unpack-item (type len) (if (eq type 'ip) (setq type 'vec len 4)) (cond ((memq type '(u8 byte)) (struct--unpack-u8)) ((memq type '(u16 word short)) (struct--unpack-u16)) ((eq type 'u24) (struct--unpack-u24)) ((memq type '(u32 dword long)) (struct--unpack-u32)) ((eq type 'u16r) (struct--unpack-u16r)) ((eq type 'u24r) (struct--unpack-u24r)) ((eq type 'u32r) (struct--unpack-u32r)) ((eq type 'str) (let ((s (substring raw-data pos (+ pos len)))) (setq pos (+ pos 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)) (setq i (1+ i))) (setq s (substring raw-data pos (+ pos i))) (setq pos (+ pos len)) (if (stringp s) s (string-make-unibyte (concat s))))) ((eq type 'vec) (let ((v (make-vector len 0)) (i 0)) (while (< i len) (aset v i (struct--unpack-u8)) (setq i (1+ i))) v)) (t nil))) (defun struct--unpack-group (spec) (let (result) (while spec (let* ((item (car spec)) (field (car item)) (type (nth 1 item)) (len (nth 2 item)) data) (cond ((eq field 'fill) (setq pos (+ pos type))) ((eq field 'align) (while (/= (% pos type) 0) (setq pos (1+ pos)))) ((eq field 'struct) (setq result (append (struct--unpack-group (eval type)) result))) ((eq type 'struct) (setq data (struct--unpack-group (eval len))) (setq result (cons (cons field data) result))) (t (if (consp len) (setq len (apply 'struct-field result len))) (if (not len) (setq len 1)) (if (eq type 'repeat) (let ((i 0)) (while (< i len) (setq data (cons (struct--unpack-group (nth 3 item)) data)) (setq i (1+ i))) (setq data (reverse data))) (setq data (struct--unpack-item type len))) (setq result (cons (cons field data) result)))) (setq spec (cdr spec)))) (reverse result))) (defun struct-unpack (raw-data spec) "Unpack RAW-DATA according to struct specification SPEC." (let ((pos 0)) (struct--unpack-group spec))) (defun struct-field (struct &rest field) (while (and struct field) (setq struct (if (integerp (car field)) (nth (car field) struct) (let ((val (assq (car field) struct))) (if (consp val) (cdr val))))) (setq field (cdr field))) struct) (defun struct-ip-to-string (ip) (format "%d.%d.%d.%d" (aref ip 0) (aref ip 1) (aref ip 2) (aref ip 3))) (defun struct-vector-to-hex (v) (let ((i 0) (len (length v)) s) (while (< i len) (setq s (cons (format ":%02x" (aref v i)) s) i (1+ i))) (setq s (reverse s)) (substring (apply 'concat s) 1))) ;; Pack structured data into raw-data (defun struct--pack-u8 (v) (if v (char-to-string v) [0])) (defun struct--pack-u16 (v) (if v (vector (% (/ v 256) 256) (% v 256)) [0 0])) (defun struct--pack-u24 (v) (if v (vector (% (/ v 65536) 256) (% (/ v 256) 256) (% v 256)) [0 0 0])) (defun struct--pack-u32 (v) (if v (vector (% (/ v 16777216) 256) (% (/ v 65536) 256) (% (/ v 256) 256) (% v 256)) [0 0 0 0])) (defun struct--pack-u16r (v) (if v (vector (% v 256) (% (/ v 256) 256)) [0 0])) (defun struct--pack-u24r (v) (if v (vector (% v 256) (% (/ v 256) 256) (% (/ v 65536) 256)) [0 0 0])) (defun struct--pack-u32r (v) (if v (vector (% v 256) (% (/ v 256) 256) (% (/ v 65536) 256) (% (/ v 16777216) 256)) [0 0 0 0])) (defun struct--pack-item (v type len) (if (eq type 'ip) (setq type 'vec len 4)) (cond ((memq type '(u8 byte)) (struct--pack-u8 v)) ((memq type '(u16 word short)) (struct--pack-u16 v)) ((eq type 'u24) (struct--pack-u24 v)) ((memq type '(u32 dword long)) (struct--pack-u32 v)) ((eq type 'u16r) (struct--pack-u16r v)) ((eq type 'u24r) (struct--pack-u24r v)) ((eq type 'u32r) (struct--pack-u32r v)) ((memq type '(str strz vec)) (let ((l (length v))) (if (>= l len) (substring v 0 len) (concat v (make-vector (- len l) 0))))) (t (make-vector len 0)))) (defun struct--pack-group (struct spec offset) (let (result) (while spec (let* ((item (car spec)) (field (car item)) (type (nth 1 item)) (len (nth 2 item)) data) (cond ((eq field 'fill) (setq data (make-vector type 0))) ((eq field 'align) (let ((extra (- type (% (+ (length result) offset) type)))) (setq data (if (> extra 0) (make-vector extra 0))))) ((eq field 'struct) (setq result (append result (struct--pack-group struct (eval type) (length result))))) ((eq type 'struct) (setq result (append result (struct--pack-group (struct-field struct field) (eval len) (length result))))) (t (if (consp len) (setq len (apply 'struct-field result len))) (if (not len) (setq len 1)) (if (eq type 'repeat) (let ((i 0)) (while (< i len) (setq result (append result (struct--pack-group struct (nth 3 item) (length result)))) (setq i (1+ i)))) (setq data (struct--pack-item (struct-field struct field) type len))))) (if data (setq result (append result (list data))))) (setq spec (cdr spec))) result)) (defun struct-pack (struct spec) "Pack STRUCT according to struct specification SPEC." (string-make-unibyte (apply 'concat (struct--pack-group struct spec 0)))) (provide 'struct) _______________________________________________ Emacs-devel mailing list Emacs-devel@gnu.org http://mail.gnu.org/mailman/listinfo/emacs-devel