You are looking at historical revision 27692 of this page. It may differ significantly from its current revision.

bitstring

Description

Easy binary data manipulation. Support binary encoding-decoding with matching and condition guards. Implements the subset of Erlang bit syntax.

Authors

rivo

Requirements

No requiremtents.

API

Basic syntax description:

 
(bitmatch binary-data
 ((pattern ...) expression)
 ...
 (else expression))

Patterns description:
(NAME)
Read byte from stream and bind to varaible NAME or compare with immidiate value if name not a symbol name. Supported immidiate values types: integer char string
(NAME BITS)
(NAME BITS big)
Read n-BITS big endian integer, bind-or-compare with NAME.
(NAME BITS little)
Read n-BITS little endian integer, bind-or-compare with NAME.
(NAME 16 float)
Read ieee-754 floating point half-precision, bind-or-compare with NAME.
(NAME 32 float)
Read ieee-754 floating point single precision, bind-or-compare with NAME.
(NAME BITS bitstring)
Read raw BITS from stream, bind-or-compare with NAME.
(NAME bitstring)
Greedy read, consume all available bits.
()
Empty bitstring
(PACKET-NAME bitpacket)
Read packet defined with (bitpacket PACKET-NAME ...) declaration. Bind each packet field to current lexical scope. !!! bitpacket is experimental feature !!!
(check EXPRESSION)
user guard EXPRESSION continue matching only when evaluate to #t
[syntax] (bitmatch binary-data patterns-list else-guard)
[syntax] (bitpacket PACKET-NAME fields ...)

Define well-known set of fields. Fields syntax the same as bitmatch pattern syntax.

[procedure] (bitstring-compare bitstring1 bitstring2)

Compare bitstrings.

[procedure] (bitstring->list bitstring)

Convert bitstring to list.

[procedure] (bitstring? bitstring)

Test variable type.

[procedure] (bitstring-length bitstring)

Return length in bits.

Examples

 
; Example 1. Tagged data structure.
;
; struct Tagged {
;  enum { IntegerType = 1, FloatType = 2 };
;  unsigned char Tag; // integer type = 1, float type = 2
;  union {
;   unsigned int IValue;
;   float FValue;
;  };
; };
;

(use bitstring)

(bitmatch "\x01\xAA\xBB\xCC\xDD"
  (((#x01) (IValue 32 little))
      (print "integer:" IValue))
  (((#x02) (FValue 32 float))
      (print "float:" FValue)))

; Example 2. Fixed length string. 
;
; struct FixedString {
;  short Length; // length of StringData array
;  char StringData[0];
; };
;

(use bitstring)

(bitmatch "\x05\x00ABCDE"
  (((Length 16 little)
    (StringData (* 8 Length) bitstring))
      (print "StringData:" (bitstring->list StringData)))
  (else
      (print "invalid string")))

; Example 3. IP packet parsing. 
;

(use bitstring srfi-4)

(define IPRaw `#u8( #x45 #x00 #x00 #x6c
		    #x92 #xcc #x00 #x00
		    #x38 #x06 #x00 #x00
		    #x92 #x95 #xba #x14
		    #xa9 #x7c #x15 #x95 ))

(bitmatch IPRaw
  (((Version 4)
    (IHL 4)
    (TOS 8)
    (TL 16)
    (Identification 16)
    (Reserved 1) (DF 1) (MF 1)
    (FramgentOffset 13)
    (TTL 8)
    (Protocol 8) (check (or (= Protocol 1)
    	                    (= Protocol 2)
    	                    (= Protocol 6)
    	                    (= Protocol 17))) 
    (CheckSum 16)
    (SourceAddr 32 bitstring)
    (DestinationAddr 32 bitstring)
    (Optional bitstring))
    	; print packet filds
    	(print "\n Version: " Version
    	       "\n IHL: " IHL
    	       "\n TOS: " TOS
    	       "\n TL:  " TL
    	       "\n Identification: " Identification
    	       "\n DF: " DF
    	       "\n MF: " MF
    	       "\n FramgentOffset: " FramgentOffset
    	       "\n Protocol: " Protocol
    	       "\n CheckSum: " CheckSum
    	       "\n SourceAddr: " 
    	           (bitmatch SourceAddr (((A)(B)(C)(D)) (list A B C D)))
               "\n DestinationAddr: " 
                   (bitmatch DestinationAddr (((A)(B)(C)(D)) (list A B C D)))))
  (else
    (print "bad datagram")))

; Basic TGA image parser.
; Support True-Image type format and Run-Length-Encoding compression.
; SPEC: http://www.dca.fee.unicamp.br/~martino/disciplinas/ea978/tgaffs.pdf
; Full Source: https://bitbucket.org/rivo/bitstring/src/tip/tests?at=default
;
; WARNING!!! bitpacket feature is experimental !!!

(use bitstring posix srfi-4)

(bitpacket TGA-Header
  (ID-length 8)
  (ColorMapType 8)
  (ImageType 8)
  (TGA-ColorMapSpec bitpacket)
  (TGA-ImageSpec bitpacket))

(bitpacket TGA-ColorMapSpec
  (FirstEntryIndex 16 little)
  (ColorMapLength 16 little)
  (ColorMapEntrySize 8))

(bitpacket TGA-ImageSpec
  (X-Origin 16 little)
  (Y-Origin 16 little)
  (ImageWidth 16 little)
  (ImageHeight 16 little)
  (PixelDepth 8)
  (ImageTransferOrder 2)
  (#x00 2) ; reserved
  (AttributesBitsPerPixel 4))

(define (bitstring->blob bs)
  (u8vector->blob (list->u8vector (bitstring->list bs))))

(define (parse-tga file file-out)
  (let* ((fi (file-open file (+ open/rdonly open/binary)))
         (fo (file-open file-out (+ open/write open/creat open/trunc open/binary)))
         (size (file-size fi))
         (res (file-read fi size))
         (data (car res)))
    (bitmatch data
      ; True-Color uncompressed
      (((TGA-Header bitpacket)
      	(check (and (= 0 ColorMapType) (= 2 ImageType)))
      	(ID-data ID-length bitstring)
        (Image-data (* ImageWidth ImageHeight PixelDepth) bitstring)
        (Rest-data bitstring))
        	(begin
        	  (print "True-Color uncompressed")
        	  (print ImageWidth "x" ImageHeight "x" PixelDepth)
        	  (parse-image-uncompressed
        	    (lambda (color)
        	      (file-write fo (bitstring->blob color)))
        	    PixelDepth Image-data)))
      ; True-Color compressed
      (((TGA-Header bitpacket)
      	(check (and (= 0 ColorMapType) (= 10 ImageType)))
      	(ID-data ID-length bitstring)
      	(Image-data bitstring))
      		(begin
      		  (print "True-Color compressed")
      		  (print ImageWidth "x" ImageHeight "x" PixelDepth)
      		  (parse-image-compressed
        	      (lambda (color)
        	      	(file-write fo (bitstring->blob color)))
        	      PixelDepth Image-data))))))

(define (parse-image-uncompressed func depth image)
  (bitmatch image
    ((())
      	'ok)
    (((Color depth bitstring) (Rest bitstring))
      (begin
      	(func Color)
      	(parse-image-uncompressed func depth Rest)))))

(define (parse-image-compressed func depth image)
  (bitmatch image
    ((())
      	'ok)
    (((1 1) (Count 7) (Color depth bitstring) (Rest bitstring))
      	(let loop ((i 0))
	  (func Color)
	  (if (< i Count)
	    (loop (+ i 1))
	    (parse-image-compressed func depth Rest))))
    (((0 1) (Count 7) (RAW-data (* depth (+ Count 1)) bitstring) (Rest bitstring))
      	(begin
      	  (parse-image-uncompressed func depth RAW-data)
      	  (parse-image-compressed func depth Rest)))))

; Convert images to raw pixels 
;(parse-tga "tests/24compressed.tga" "tests/24c.raw")
;(parse-tga "tests/24uncompressed.tga" "tests/24u.raw")

License

BSD

Version History

0.1 first public release