Added extract_int_be_unsigned and extract_int32_be_unsigned.

diff --git a/bitmatch.ml b/bitmatch.ml
index 975e42e..6985c41 100644 (file)
--- a/bitmatch.ml
+++ b/bitmatch.ml
@@ -1,5 +1,5 @@
 (* Bitmatch library.
- * $Id: bitmatch.ml,v 1.3 2008-04-01 10:06:12 rjones Exp $
+ * $Id: bitmatch.ml,v 1.4 2008-04-01 10:58:53 rjones Exp $
  *)
 
 open Printf
@@ -56,29 +56,121 @@ let extract_bit data off len _ =   (* final param is always 1 *)
   let b = Char.code data.[byteoff] land bitmask <> 0 in
   b, off+1, len-1
 
+(* Returns 8 bit unsigned aligned bytes from the string.
+ * If the string ends then this returns 0's.
+ *)
+let _get_byte data byteoff strlen =
+  if strlen > byteoff then Char.code data.[byteoff] else 0
+let _get_byte32 data byteoff strlen =
+  if strlen > byteoff then Int32.of_int (Char.code data.[byteoff]) else 0l
+let _get_byte64 data byteoff strlen =
+  if strlen > byteoff then Int64.of_int (Char.code data.[byteoff]) else 0L
+
 (* Extract [2..8] bits.  Because the result fits into a single
  * byte we don't have to worry about endianness, only signedness.
  *)
 let extract_char_unsigned data off len flen =
   let byteoff = off lsr 3 in
 
-  (* Extract the 16 bits at byteoff and byteoff+1 (note that the
-   * second byte might not exist in the original string).
-   *)
+  (* Optimize the common (byte-aligned) case. *)
+  if off land 7 = 0 then (
+    let byte = Char.code data.[byteoff] in
+    byte lsr (8 - flen), off+flen, len-flen
+  ) else (
+    (* Extract the 16 bits at byteoff and byteoff+1 (note that the
+     * second byte might not exist in the original string).
+     *)
+    let strlen = String.length data in
+
+    let word =
+      (_get_byte data byteoff strlen lsl 8) +
+       _get_byte data (byteoff+1) strlen in
+
+    (* Mask off the top bits. *)
+    let bitmask = (1 lsl (16 - (off land 7))) - 1 in
+    let word = word land bitmask in
+    (* Shift right to get rid of the bottom bits. *)
+    let shift = 16 - ((off land 7) + flen) in
+    let word = word lsr shift in
+
+    word, off+flen, len-flen
+  )
+
+(* Extract [9..31] bits.  We have to consider endianness and signedness. *)
+let extract_int_be_unsigned data off len flen =
+  let byteoff = off lsr 3 in
+
+  let strlen = String.length data in
+
   let word =
-    (Char.code data.[byteoff] lsl 8) +
-      (if String.length data > byteoff+1 then Char.code data.[byteoff+1]
-       else 0) in
+    (* Optimize the common (byte-aligned) case. *)
+    if off land 7 = 0 then (
+      let word =
+       (_get_byte data byteoff strlen lsl 23) +
+         (_get_byte data (byteoff+1) strlen lsl 15) +
+         (_get_byte data (byteoff+2) strlen lsl 7) +
+         (_get_byte data (byteoff+3) strlen lsr 1) in
+      word lsr (31 - flen)
+    ) else if flen <= 24 then (
+      (* Extract the 31 bits at byteoff .. byteoff+3. *)
+      let word =
+       (_get_byte data byteoff strlen lsl 23) +
+         (_get_byte data (byteoff+1) strlen lsl 15) +
+         (_get_byte data (byteoff+2) strlen lsl 7) +
+         (_get_byte data (byteoff+3) strlen lsr 1) in
+      (* Mask off the top bits. *)
+      let bitmask = (1 lsl (31 - (off land 7))) - 1 in
+      let word = word land bitmask in
+      (* Shift right to get rid of the bottom bits. *)
+      let shift = 31 - ((off land 7) + flen) in
+      word lsr shift
+    ) else (
+      (* Extract the next 31 bits, slow method. *)
+      let word =
+       let c0, off, len = extract_char_unsigned data off len 8 in
+       let c1, off, len = extract_char_unsigned data off len 8 in
+       let c2, off, len = extract_char_unsigned data off len 8 in
+       let c3, off, len = extract_char_unsigned data off len 7 in
+       (c0 lsl 23) + (c1 lsl 15) + (c2 lsl 7) + c3 in
+      word lsr (31 - flen)
+    ) in
+  word, off+flen, len-flen
+
+(* Extract exactly 32 bits.  We have to consider endianness and signedness. *)
+let extract_int32_be_unsigned data off len flen =
+  let byteoff = off lsr 3 in
 
-  (* Mask off the top bits. *)
-  let bitmask = (1 lsl (16 - (off land 7))) - 1 in
-  let word = word land bitmask in
-  (* Shift right to get rid of the bottom bits. *)
-  let shift = 16 - ((off land 7) + flen) in
-  let word = word lsr shift in
+  let strlen = String.length data in
 
+  let word =
+    (* Optimize the common (byte-aligned) case. *)
+    if off land 7 = 0 then (
+      let word =
+       Int32.add
+         (Int32.add
+            (Int32.add
+               (Int32.shift_left (_get_byte32 data byteoff strlen) 24)
+               (Int32.shift_left (_get_byte32 data (byteoff+1) strlen) 16))
+            (Int32.shift_left (_get_byte32 data (byteoff+2) strlen) 8))
+         (_get_byte32 data (byteoff+3) strlen) in
+      Int32.shift_right word (32 - flen)
+    ) else (
+      (* Extract the next 32 bits, slow method. *)
+      let word =
+       let c0, off, len = extract_char_unsigned data off len 8 in
+       let c1, off, len = extract_char_unsigned data off len 8 in
+       let c2, off, len = extract_char_unsigned data off len 8 in
+       let c3, off, len = extract_char_unsigned data off len 8 in
+       let c0 = Int32.shift_left (Int32.of_int c0) 24 in
+       let c1 = Int32.shift_left (Int32.of_int c1) 16 in
+       let c2 = Int32.shift_left (Int32.of_int c2) 8 in
+       let c3 = Int32.of_int c3 in
+       Int32.add c0 (Int32.add c1 (Int32.add c2 c3)) in
+      Int32.shift_right word (32 - flen)
+    ) in
   word, off+flen, len-flen
 
+
 (*----------------------------------------------------------------------*)
 (* Display functions. *)
 

diff --git a/bitmatch.mli b/bitmatch.mli
index 7c45aa2..4f58039 100644 (file)
--- a/bitmatch.mli
+++ b/bitmatch.mli
@@ -1,5 +1,5 @@
 (* Bitmatch library.
- * $Id: bitmatch.mli,v 1.3 2008-04-01 10:06:12 rjones Exp $
+ * $Id: bitmatch.mli,v 1.4 2008-04-01 10:58:53 rjones Exp $
  *)
 
 type bitstring = string * int * int
@@ -25,3 +25,7 @@ val extract_remainder : string -> int -> int -> bitstring * int * int
 val extract_bit : string -> int -> int -> int -> bool * int * int
 
 val extract_char_unsigned : string -> int -> int -> int -> int * int * int
+
+val extract_int_be_unsigned : string -> int -> int -> int -> int * int * int
+
+val extract_int32_be_unsigned : string -> int -> int -> int -> int32 * int * int

diff --git a/tests/60_ping.ml b/tests/60_ping.ml
new file mode 100644 (file)
index 0000000..c3a380e
--- /dev/null
+++ b/tests/60_ping.ml
@@ -0,0 +1,67 @@
+(* Read in IPv4 and IPv6 ping packets and display them.
+ * $Id: 60_ping.ml,v 1.1 2008-04-01 10:58:53 rjones Exp $
+ *)
+
+open Printf
+
+let display pkt =
+  bitmatch pkt with
+  | version : 4; hdrlen : 4; tos : 8; length : 16;
+    identification : 16; flags : 3; fragoffset : 13;
+    ttl : 8; protocol : 8; checksum : 16;
+    source : 32;
+    dest : 32;
+    options : (hdrlen-5)*32 : bitstring;
+    payload : -1 : bitstring
+      when version = 4 ->
+
+    printf "IPv%d:\n" version;         (* IPv4 packet *)
+    printf "  header length: %d * 32 bit words\n" hdrlen;
+    printf "  type of service: %d\n" tos;
+    printf "  packet length: %d bytes\n" length;
+    printf "  identification: %d\n" identification;
+    printf "  flags: %d\n" flags;
+    printf "  fragment offset: %d\n" fragoffset;
+    printf "  ttl: %d\n" ttl;
+    printf "  protocol: %d\n" protocol;
+    printf "  checksum: %d\n" checksum;
+    printf "  source: %lx  dest: %lx\n" source dest;
+    printf "  header options + padding:\n";
+    Bitmatch.hexdump_bitstring stdout options;
+    printf "  packet payload:\n";
+    Bitmatch.hexdump_bitstring stdout payload
+
+  | version : 4; tclass : 8; flow : 20;
+    length : 16; nexthdr : 8; ttl : 8;
+    source : 128 : bitstring;
+    dest : 128 : bitstring;
+    payload : -1 : bitstring
+      when version = 6 ->
+
+    printf "IPv%d:\n" version;         (* IPv6 packet *)
+    printf "  traffic class: %d\n" tclass;
+    printf "  flow label: %d\n" flow;
+    printf "  packet (payload) length: %d bytes\n" length;
+    printf "  next header: %d\n" nexthdr;
+    printf "  ttl: %d\n" ttl;
+    printf "  source address:\n";
+    Bitmatch.hexdump_bitstring stdout source;
+    printf "  destination address:\n";
+    Bitmatch.hexdump_bitstring stdout dest;
+    printf "packet payload:\n";
+    Bitmatch.hexdump_bitstring stdout payload
+
+  | version : 4 ->
+    eprintf "unknown IP version %d\n" version;
+    exit 1
+
+  | _ as pkt ->
+    eprintf "data is smaller than one nibble:\n";
+    Bitmatch.hexdump_bitstring stderr pkt;
+    exit 1
+
+let () =
+  let pkt = Bitmatch.bitstring_of_file "tests/ipv4.ping" in
+  display pkt;
+  let pkt = Bitmatch.bitstring_of_file "tests/ipv6.ping" in
+  display pkt