+(* Parse and display an IPv4 header from a file.
+ * $Id: ipv4_header.ml,v 1.1 2008-03-31 22:52:17 rjones Exp $
+ *)
+
+open Printf
+
+let header = Bitmatch.bitstring_of_file "ipv4_header.dat"
+
+let () =
+ bitmatch header 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;
+ 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 ->
+ eprintf "cannot parse IP version %d\n" version
+
+ | _ as header ->
+ eprintf "data is smaller than one nibble:\n";
+ Bitmatch.hexdump_bitstring stderr header
+
+
+(* converted into:
+
+ let (data, off, len) = header in
+ let result = ref None in
+ try
+ if len >= 4 then (
+ let version, off, len = Bitmatch.extract_unsigned_be data off len 4 in
+ if len >= 4 then (
+ let hdrlen, off, len = Bitmatch.extract_unsigned_be data off len 4 in
+ (* ... *)
+ if (hdrlen-5)*32 >= 0 && len >= (hdrlen-5)*32 then (
+ let options, off, len =
+ Bitmatch.extract_bitstring data off len ((hdrlen-5)*32) in
+ let payload, off, len =
+ Bitmatch.extract_remainder data off len in
+
+ if version = 4 then (
+ ...
+ raise Exit
+ )
+ )
+ )
+ )
+ if len >= 4 then (
+ let version, off, len = Bitmatch.extract_unsigned_be data off len 4 in
+ ...;
+ raise Exit
+ )
+ ...
+ with Exit -> ();
+ match !result with
+ | Some x -> x
+ | None -> raise Match_failure _loc
+
+*)