Fix parsing partial int64 with little endian encoding (#39)

Author: xguerin

bitstring.opam

@@ -1,6 +1,6 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
-version: "5.0.0"
+version: "5.0.1"
 synopsis: "Bitstrings and bitstring matching for OCaml"
 description: """
 The ocaml-bitstring project adds Erlang-style bitstrings and matching over bitstrings as a syntax extension and library for OCaml. 

dune-project

@@ -2,7 +2,7 @@
 
 (name bitstring)
 
-(version 5.0.0)
+(version 5.0.1)
 
 (generate_opam_files true)
 

ppx_bitstring.opam

@@ -1,6 +1,6 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
-version: "5.0.0"
+version: "5.0.1"
 synopsis: "Bitstrings and bitstring matching for OCaml - PPX extension"
 description: """
 The ocaml-bitstring project adds Erlang-style bitstrings and matching over bitstrings as a syntax extension and library for OCaml. 

src/bitstring.ml

@@ -354,7 +354,65 @@ module I64 = struct
       invalid_arg "Bitstring.I64.mask"
 
   (* Byte swap an int of a given size. *)
-  (* let byteswap v bits = *)
+  let byteswap v bits =
+    if bits <= 8 then v
+    else if bits <= 16 then (
+      let shift = bits-8 in
+      let v1 = v >>> shift in
+      let v2 = (v land (mask shift)) <<< 8 in
+      v2 lor v1
+    ) else if bits <= 24 then (
+      let shift = bits - 16 in
+      let v1 = v >>> (8+shift) in
+      let v2 = ((v >>> shift) land ff) <<< 8 in
+      let v3 = (v land (mask shift)) <<< 16 in
+      v3 lor v2 lor v1
+    ) else if bits <= 32 then (
+      let shift = bits - 24 in
+      let v1 = v >>> (16+shift) in
+      let v2 = ((v >>> (8+shift)) land ff) <<< 8 in
+      let v3 = ((v >>> shift) land ff) <<< 16 in
+      let v4 = (v land (mask shift)) <<< 24 in
+      v4 lor v3 lor v2 lor v1
+    ) else if bits <= 40 then (
+      let shift = bits - 32 in
+      let v1 = v >>> (24+shift) in
+      let v2 = ((v >>> (16+shift)) land ff) <<< 8 in
+      let v3 = ((v >>> (8+shift)) land ff) <<< 16 in
+      let v4 = ((v >>> shift) land ff) <<< 24 in
+      let v5 = (v land (mask shift)) <<< 32 in
+      v5 lor v4 lor v3 lor v2 lor v1
+    ) else if bits <= 48 then (
+      let shift = bits - 40 in
+      let v1 = v >>> (32+shift) in
+      let v2 = ((v >>> (24+shift)) land ff) <<< 8 in
+      let v3 = ((v >>> (16+shift)) land ff) <<< 16 in
+      let v4 = ((v >>> (8+shift)) land ff) <<< 24 in
+      let v5 = ((v >>> shift) land ff) <<< 32 in
+      let v6 = (v land (mask shift)) <<< 40 in
+      v6 lor v5 lor v4 lor v3 lor v2 lor v1
+    ) else if bits <= 56 then (
+      let shift = bits - 48 in
+      let v1 = v >>> (40+shift) in
+      let v2 = ((v >>> (32+shift)) land ff) <<< 8 in
+      let v3 = ((v >>> (24+shift)) land ff) <<< 16 in
+      let v4 = ((v >>> (16+shift)) land ff) <<< 24 in
+      let v5 = ((v >>> (8+shift)) land ff) <<< 32 in
+      let v6 = ((v >>> shift) land ff) <<< 40 in
+      let v7 = (v land (mask shift)) <<< 48 in
+      v7 lor v6 lor v5 lor v4 lor v3 lor v2 lor v1
+    ) else  (
+      let shift = bits - 56 in
+      let v1 = v >>> (48+shift) in
+      let v2 = ((v >>> (40+shift)) land ff) <<< 8 in
+      let v3 = ((v >>> (32+shift)) land ff) <<< 16 in
+      let v4 = ((v >>> (24+shift)) land ff) <<< 24 in
+      let v5 = ((v >>> (16+shift)) land ff) <<< 32 in
+      let v6 = ((v >>> (8+shift)) land ff) <<< 40 in
+      let v7 = ((v >>> shift) land ff) <<< 48 in
+      let v8 = (v land (mask shift)) <<< 56 in
+      v8 lor v7 lor v6 lor v5 lor v4 lor v3 lor v2 lor v1
+    )
 
   (* Check a value is in range 0 .. 2^bits-1. *)
   let range_unsigned v bits =
@@ -671,54 +729,9 @@ let extract_int64_be_unsigned data off len flen =
   word (*, off+flen, len-flen*)
 
 let extract_int64_le_unsigned data off len flen =
-  let byteoff = off lsr 3 in
-
-  let strlen = Bytes.length data in
-
-  let word =
-    (* Optimize the common (byte-aligned) case. *)
-    if off land 7 = 0 then (
-      let word =
-	let c0 = _get_byte64 data byteoff strlen in
-	let c1 = _get_byte64 data (byteoff+1) strlen in
-	let c2 = _get_byte64 data (byteoff+2) strlen in
-	let c3 = _get_byte64 data (byteoff+3) strlen in
-	let c4 = _get_byte64 data (byteoff+4) strlen in
-	let c5 = _get_byte64 data (byteoff+5) strlen in
-	let c6 = _get_byte64 data (byteoff+6) strlen in
-	let c7 = _get_byte64 data (byteoff+7) strlen in
-	_make_int64_le c0 c1 c2 c3 c4 c5 c6 c7 in
-      Int64.logand word (I64.mask flen)
-    ) else (
-      (* Extract the next 64 bits, slow method. *)
-      let word =
-	let c0 = extract_char_unsigned data off len 8
-	and off = off + 8 and len = len - 8 in
-	let c1 = extract_char_unsigned data off len 8
-	and off = off + 8 and len = len - 8 in
-	let c2 = extract_char_unsigned data off len 8
-	and off = off + 8 and len = len - 8 in
-	let c3 = extract_char_unsigned data off len 8
-	and off = off + 8 and len = len - 8 in
-	let c4 = extract_char_unsigned data off len 8
-	and off = off + 8 and len = len - 8 in
-	let c5 = extract_char_unsigned data off len 8
-	and off = off + 8 and len = len - 8 in
-	let c6 = extract_char_unsigned data off len 8
-	and off = off + 8 and len = len - 8 in
-	let c7 = extract_char_unsigned data off len 8 in
-	let c0 = Int64.of_int c0 in
-	let c1 = Int64.of_int c1 in
-	let c2 = Int64.of_int c2 in
-	let c3 = Int64.of_int c3 in
-	let c4 = Int64.of_int c4 in
-	let c5 = Int64.of_int c5 in
-	let c6 = Int64.of_int c6 in
-	let c7 = Int64.of_int c7 in
-	_make_int64_le c0 c1 c2 c3 c4 c5 c6 c7 in
-      Int64.logand word (I64.mask flen)
-    ) in
-  word (*, off+flen, len-flen*)
+  let v = extract_int64_be_unsigned data off len flen in
+  let v = I64.byteswap v flen in
+  v
 
 let extract_int64_ne_unsigned =
   if nativeendian = BigEndian

tests/BitstringParserTest.ml

@@ -224,17 +224,43 @@ let wrong_fp_extraction_dynamic context =
   | {| _ : on ; matched_value : 24 : bigendian |} -> assert_equal matched_value 145
   | {| _ |} -> assert_bool "Invalid bitstring" false
 
+(*
+ * Wrong LE extraction on partial int64.
+ *)
+
+ let wrong_le_partial_int64_extraction context =
+  (*
+   * Forward.
+   *)
+  let mb = ((Bytes.of_string "\xA0\x00\x00\x00\x00\x00\x00\x00"), 0, 64) in
+  match%bitstring mb with
+  | {| a:4; b:60:littleendian |} ->
+    assert_equal a 10;
+    assert_equal b 0L
+  | {| _ |} -> assert_bool "Invalid bitstring" false;
+  (*
+   * Backward.
+   *)
+  let mb = ((Bytes.of_string "\x00\x00\x00\x00\x00\x00\x00\x0A"), 0, 64) in
+  match%bitstring mb with
+  | {| b:60:littleendian; a:4 |} ->
+    assert_equal a 10;
+    assert_equal b 0L
+  | {| _ |} -> assert_bool "Invalid bitstring" false
+;;
+
 (*
  * Test suite definition
  *)
 
 let suite = "BitstringParserTest" >::: [
-    "ext3"                        >:: ext3_test;
-    "gif"                         >:: gif_test;
-    "pcap"                        >:: pcap_test;
-    "function"                    >:: function_parser_test;
-    "function_inline"             >:: function_parser_inline_test;
-    "parser_with_guard"           >:: parser_with_guard_test;
-    "wrong_fp_extraction"         >:: wrong_fp_extraction;
-    "wrong_fp_extraction_dynamic" >:: wrong_fp_extraction_dynamic;
+    "ext3"                              >:: ext3_test;
+    "gif"                               >:: gif_test;
+    "pcap"                              >:: pcap_test;
+    "function"                          >:: function_parser_test;
+    "function_inline"                   >:: function_parser_inline_test;
+    "parser_with_guard"                 >:: parser_with_guard_test;
+    "wrong_fp_extraction"               >:: wrong_fp_extraction;
+    "wrong_fp_extraction_dynamic"       >:: wrong_fp_extraction_dynamic;
+    "wrong_le_partial_int64_extraction" >:: wrong_le_partial_int64_extraction;
   ]