Permissive subbitstring allows a segmentation fault (issue #16).

[ocaml-bitstring.git] / bitstring.ml

diff --git a/bitstring.ml b/bitstring.ml
index 48351bc..8a9ef3e 100644 (file)
--- a/bitstring.ml
+++ b/bitstring.ml
@@ -130,7 +130,7 @@ let bitstring_length (_, _, len) = len
 
 let subbitstring (data, off, len) off' len' =
   let off = off + off' in
-  if len < off' + len' then invalid_arg "subbitstring";
+  if off' < 0 || len' < 0 || off' > len - len' then invalid_arg "subbitstring";
   (data, off, len')
 
 let dropbits n (data, off, len) =
@@ -853,7 +853,8 @@ module Buffer = struct
           *)
          let slenbytes = slen lsr 3 in
          if slenbytes > 0 then Buffer.add_substring buf str 0 slenbytes;
-         let last = Char.code str.[slenbytes] in (* last char *)
+         let lastidx = min slenbytes (String.length str - 1) in
+         let last = Char.code str.[lastidx] in (* last char *)
          let mask = 0xff lsl (8 - (slen land 7)) in
          t.last <- last land mask
        );
@@ -992,7 +993,7 @@ let construct_bitstring buf (data, off, len) =
     if blen = 0 then (off, len)
     else (
       let b = extract_bit data off len 1
-      and off = off + 1 and len = len + 1 in
+      and off = off + 1 and len = len - 1 in
       Buffer.add_bit buf b;
       loop off len (blen-1)
     )
@@ -1106,7 +1107,7 @@ let equals ((_, _, len1) as bs1) ((_, _, len2) as bs2) =
 let index_out_of_bounds () = invalid_arg "index out of bounds"
 
 let put (data, off, len) n v =
-  if n < 0 || off+n >= len then index_out_of_bounds ()
+  if n < 0 || n >= len then index_out_of_bounds ()
   else (
     let i = off+n in
     let si = i lsr 3 and mask = 0x80 lsr (i land 7) in
@@ -1120,7 +1121,7 @@ let set bits n = put bits n 1
 let clear bits n = put bits n 0
 
 let get (data, off, len) n =
-  if n < 0 || off+n >= len then index_out_of_bounds ()
+  if n < 0 || n >= len then index_out_of_bounds ()
   else (
     let i = off+n in
     let si = i lsr 3 and mask = 0x80 lsr (i land 7) in