Merge pull request #12 from avsm/master

Add hexdumping pretty printing functions

Author: avsm

CHANGES

@@ -1,9 +1,12 @@
 0.7.2 (trunk):
 * Improved ocamldoc for BE/LE modules.
 * Add Travis-CI test scripts and fix `test.sh` script compilation.
+* Support int32/int64 constant values in cenum like `VAL = 0xffffffffl`, useful for 32-bit hosts.
 * Check and raise error in case of negative offsets for blits (#4).
 * Correctly preserve the sequence after a constant constructor is set during a `cenum` definition.
 * Do not repeat the `sizeof_<field>` binding for every get/set field (should be no externally observable change).
+* Add `Cstruct.hexdump_to_buffer` to make spooling hexdump output easier.
+* Generate `hexdump_foo` and `hexdump_foo_to_buffer` prettyprinting functions for a `cstruct foo`.
 
 0.7.1 (06-Mar-2013):
 * Add `Async_cstruct.Pipe` to map pipes of `Cstruct` buffers to strings or `Bigsubstring`.

README.md

@@ -82,6 +82,8 @@ val get_pcap_packet_incl_len : Cstruct.t -> Cstruct.uint32
 val set_pcap_packet_incl_len : Cstruct.t -> Cstruct.uint32 -> unit
 val get_pcap_packet_orig_len : Cstruct.t -> Cstruct.uint32
 val set_pcap_packet_orig_len : Cstruct.t -> Cstruct.uint32 -> unit
+val hexdump_pcap_packet_to_buffer : Buffer.t -> pcap_packet -> unit
+val hexdump_pcap_packet : Cstruct.t -> unit
 
 val sizeof_ethernet : int
 val get_ethernet_dst : Cstruct.t -> Cstruct.t
@@ -94,7 +96,13 @@ val set_ethernet_src : string -> int -> Cstruct.t -> unit
 val blit_ethernet_src : Cstruct.t -> int -> Cstruct.t -> unit
 val get_ethernet_ethertype : Cstruct.t -> Cstruct.uint16
 val set_ethernet_ethertype : Cstruct.t -> Cstruct.uint16 -> unit
+val hexdump_ethernet_to_buffer : Buffer.t -> Cstruct.t -> unit
+val hexdump_ethernet : Cstruct.t -> unit
 ```
+
+The `hexdump` functions above are convenient pretty-printing functions
+to help you debug, and aren't intended to be high performance.
+
 You can also declare C-like enums:
 
 ```

lib/cstruct.ml

@@ -234,6 +234,15 @@ let hexdump t =
   done;
   print_endline ""
 
+let hexdump_to_buffer buf t =
+  let c = ref 0 in
+  for i = 0 to len t - 1 do
+    if !c mod 16 = 0 then Buffer.add_char buf '\n';
+    bprintf buf "%.2x " (Char.code (Bigarray.Array1.get t.buffer (t.off+i)));
+    incr c;
+  done;
+  Buffer.add_char buf '\n'
+
 let split ?(start=0) t off =
   let header = sub t start off in
   let body = sub t (start+off) (len t - off - start) in

lib/cstruct.mli

@@ -133,6 +133,7 @@ val split: ?start:int -> t -> int -> t * t
 val to_string: t -> string
 
 val hexdump: t -> unit
+val hexdump_to_buffer: Buffer.t -> t -> unit
 val debug: t -> string
 
 module BE : sig

lib_test/basic.ml

@@ -85,5 +85,6 @@ let _ =
   assert(Cstruct.BE.get_uint32 be2 0 = 0xbeef_l);
   assert(Cstruct.BE.get_uint32 be 3 = 0xbeef_l);
   assert(get_foo_b be = 44);
-  assert(get_foo_a be = 7)
+  assert(get_foo_a be = 7);
+  hexdump_foo be
 

syntax/pa_cstruct.ml

@@ -193,6 +193,36 @@ let output_sizeof_sig _loc s =
     value $lid:"sizeof_"^s.name$ : int
   >>
 
+let output_hexdump _loc s =
+  let hexdump =
+    List.fold_left (fun a f ->
+      <:expr<
+        $a$; Buffer.add_string _buf $str:"  "^f.field^" = "$;
+        $match f.ty with
+         |UInt8 |UInt16 -> <:expr< Printf.bprintf _buf "0x%x\n" ($lid:getter_name s f$ v) >>
+         |UInt32 -> <:expr< Printf.bprintf _buf "0x%lx\n" ($lid:getter_name s f$ v) >>
+         |UInt64 -> <:expr< Printf.bprintf _buf "0x%Lx\n" ($lid:getter_name s f$ v) >>
+         |Buffer len -> <:expr< Printf.bprintf _buf "<buffer length %d>" $int:string_of_int len$; Cstruct.hexdump_to_buffer _buf ($lid:getter_name s f$ v) >>
+        $ >>
+    ) <:expr< >> s.fields
+  in
+  <:str_item<
+    value $lid:"hexdump_"^s.name^"_to_buffer"$ _buf v = do { $hexdump$ };
+    value $lid:"hexdump_"^s.name$ v =
+      let _buf = Buffer.create 128 in
+      do {
+        Buffer.add_string _buf $str:s.name ^ " = {\n"$;
+        $lid:"hexdump_"^s.name^"_to_buffer"$ _buf v;
+        print_endline (Buffer.contents _buf);
+        print_endline "}"
+      } >>
+
+let output_hexdump_sig _loc s =
+  <:sig_item<
+    value $lid:"hexdump_"^s.name^"_to_buffer"$ : Buffer.t -> Cstruct.t -> unit;
+    value $lid:"hexdump_"^s.name$ : Cstruct.t -> unit;
+  >>
+
 let output_struct _loc s =
   (* Generate functions of the form {get/set}_<struct>_<field> *)
   let expr = List.fold_left (fun a f ->
@@ -202,7 +232,7 @@ let output_struct _loc s =
       $output_set _loc s f$
     >>
   ) <:str_item< $output_sizeof _loc s$ >> s.fields
-  in expr
+  in <:str_item< $expr$; $output_hexdump _loc s$ >>
 
 let output_struct_sig _loc s =
   (* Generate signaturs of the form {get/set}_<struct>_<field> *)
@@ -213,7 +243,7 @@ let output_struct_sig _loc s =
       $output_set_sig _loc s f$ ;
     >>
   ) <:sig_item< $output_sizeof_sig _loc s$ >> s.fields
-  in expr
+  in <:sig_item< $expr$; $output_hexdump_sig _loc s$ >>
 
 let output_enum _loc name fields width =
   let intfn,pattfn = match ty_of_string width with