(* Parse and display an IPv4 header from a file.
- * $Id: ipv4_header.ml,v 1.1 2008-03-31 22:52:17 rjones Exp $
+ * $Id: ipv4_header.ml,v 1.2 2008-04-01 17:31:12 rjones Exp $
*)
open Printf
| _ 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
-
-*)
(* Create an IPv4 header.
- * $Id: make_ipv4_header.ml,v 1.1 2008-03-31 22:52:17 rjones Exp $
+ * $Id: make_ipv4_header.ml,v 1.2 2008-04-01 17:31:12 rjones Exp $
*)
open Printf
let payload = Bitmatch.create_bitstring payload_length
let header =
- <| 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 : -1, bitstring;
- payload : payload_length, bitstring |>
-
-(*
- generates:
-
- let header = Bitmatch.join_bitstrings [
- Bitmatch.create_unsigned_be version 4;
- Bitmatch.create_unsigned_be hdrlen 4; (* etc. *)
- options;
- Bitmatch.check_bitstring_length payload payload_length
- ]
-
- which can throw an exception if values are out of range.
-*)
+ BITSTRING
+ 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 : -1, bitstring;
+ payload : payload_length, bitstring
let () = Bitmatch.file_of_bitstring header "ipv4_header_out.dat"