Skip to content

Commit

Permalink
[fix] stdlib: Fixed some rpoblems with ints. Added overflow checking.
Browse files Browse the repository at this point in the history
  • Loading branch information
@nrs135
nrs135 committed Dec 15, 2011
1 parent 7e70a4f commit c7ab5eb
Show file tree
Hide file tree
Showing 6 changed files with 94 additions and 50 deletions.
63 changes: 31 additions & 32 deletions libbase/bson.ml
View file
Expand Up @@ -152,7 +152,7 @@ struct
s

let generated_time oid =
Time.seconds (St.bdi32 oid 0)
Time.seconds_float (Int32.to_float (St.bdi32l oid 0))

end (* module Oid *)

Expand Down Expand Up @@ -185,7 +185,7 @@ struct

let int b name i =
estart b el_int name;
Stuff.add_le_int32 b.buf i
Stuff.add_le_int32l b.buf i

let long b name l =
estart b el_long name;
Expand Down Expand Up @@ -307,8 +307,8 @@ struct

let timestamp b name (i,t) =
estart b el_timestamp name;
Stuff.add_le_int32 b.buf i;
Stuff.add_le_int32 b.buf t
Stuff.add_le_int32l b.buf i;
Stuff.add_le_int32l b.buf t

let date b name millis =
estart b el_date name;
Expand Down Expand Up @@ -357,7 +357,7 @@ sig
val iterator_type : iter -> char
val key : iter -> string
val value : iter -> int
val int_raw : iter -> int
val int_raw : iter -> int32
val long_raw : iter -> int64
val double_raw : iter -> float
val bool_raw : iter -> bool
Expand All @@ -366,10 +366,10 @@ sig
val symbol : ?offset:int -> iter -> string
val cstring : ?offset:int -> iter -> string
val string_len : iter -> int
val int : iter -> int
val int : iter -> int32
val long : iter -> int64
val double : iter -> float
val timestamp : iter -> int * int
val timestamp : iter -> int32 * int32
val bool : iter -> bool
val code : iter -> string
val code_scope : iter -> buf
Expand Down Expand Up @@ -423,7 +423,7 @@ struct
with Not_found -> S.length i.ibuf

let int_raw i =
St.ldi32 i.ibuf (value i)
St.ldi32l i.ibuf (value i)

let long_raw i =
St.ldi64L i.ibuf (value i)
Expand Down Expand Up @@ -455,37 +455,37 @@ struct
S.to_string (S.sub i.ibuf (v+offset) ((bslen i.ibuf (v+offset))-1))

let string_len i =
int_raw i - 1
Int32.to_int(int_raw i) - 1

let int i =
match S.get i.ibuf (i.pos) with
| c when c = el_int -> int_raw i
| c when c = el_long -> Int64.to_int (long_raw i)
| c when c = el_double -> int_of_float (double_raw i)
| _ -> 0
| c when c = el_long -> Int64.to_int32 (long_raw i)
| c when c = el_double -> Int32.of_float (double_raw i)
| _ -> 0l

let long i =
match S.get i.ibuf (i.pos) with
| c when c = el_int -> Int64.of_int(int_raw i)
| c when c = el_int -> Int64.of_int32(int_raw i)
| c when c = el_long -> long_raw i
| c when c = el_double -> Int64.of_float (double_raw i)
| _ -> 0L

let double i =
match S.get i.ibuf (i.pos) with
| c when c = el_int -> float_of_int (int_raw i)
| c when c = el_int -> Int32.to_float (int_raw i)
| c when c = el_long -> Int64.to_float (long_raw i)
| c when c = el_double -> double_raw i
| _ -> 0.0

let timestamp i =
let v = value i in
(St.ldi32 i.ibuf v, St.ldi32 i.ibuf (v+4))
(St.ldi32l i.ibuf v, St.ldi32l i.ibuf (v+4))

let bool i =
match S.get i.ibuf (i.pos) with
| c when c = el_bool -> bool_raw i
| c when c = el_int -> int_raw i <> 0
| c when c = el_int -> int_raw i <> 0l
| c when c = el_long -> long_raw i <> 0L
| c when c = el_double -> double_raw i <> 0.0
| c when c = el_eoo || c = el_null -> false
Expand Down Expand Up @@ -524,8 +524,8 @@ struct

let bin_len i =
if bin_type i = st_bin_binary_old
then int_raw i - 4
else int_raw i
then Int32.to_int(int_raw i) - 4
else Int32.to_int(int_raw i)

let bin_data i =
let v = value i in
Expand Down Expand Up @@ -573,13 +573,13 @@ struct
| c when c = el_oid ->
12
| c when c = el_string || c = el_symbol || c = el_code ->
4 + int_raw i
4 + Int32.to_int(int_raw i)
| c when c = el_bindata ->
5 + int_raw i
5 + Int32.to_int(int_raw i)
| c when c = el_object || c = el_array || c = el_codewscope ->
int_raw i
Int32.to_int(int_raw i)
| c when c = el_dbref ->
16 + int_raw i
16 + Int32.to_int(int_raw i)
| c when c = el_regex ->
let s = value i in
let p = (S.index_from i.ibuf s '\x00') + 1 in
Expand Down Expand Up @@ -663,11 +663,11 @@ struct
let scope = Iterator.code_scope i in
Printf.printf "\n\t SCOPE: ";
print scope
| c when c = el_int -> Printf.printf "%d" (Iterator.int i)
| c when c = el_int -> Printf.printf "%ld" (Iterator.int i)
| c when c = el_long -> Printf.printf "%Ld" (Iterator.long i)
| c when c = el_timestamp ->
let (i,t) = Iterator.timestamp i in
Printf.printf "i: %d, t: %d" i t
Printf.printf "i: %ld, t: %ld" i t
| c when c = el_object || c = el_array ->
Printf.printf "\n";
print_raw i.Iterator.ibuf (Iterator.value i) (depth + 1)
Expand Down Expand Up @@ -706,11 +706,11 @@ struct
| c when c = el_code -> Printf.sprintf "CODE(%s)" (Iterator.code i)
| c when c = el_codewscope ->
Printf.sprintf "CODE_W_SCOPE({code=\"%s\", scope=%s})" (Iterator.code i) (to_pretty (Iterator.code_scope i))
| c when c = el_int -> Printf.sprintf "%d" (Iterator.int i)
| c when c = el_int -> Printf.sprintf "%ld" (Iterator.int i)
| c when c = el_long -> Printf.sprintf "%Ld" (Iterator.long i)
| c when c = el_timestamp ->
let (i,t) = Iterator.timestamp i in
Printf.sprintf "{i: %d, t: %d}" i t
Printf.sprintf "{i: %ld, t: %ld}" i t
| c when c = el_object -> to_pretty_raw i.Iterator.ibuf (Iterator.value i)
| c when c = el_array -> "["^(to_pretty_raw i.Iterator.ibuf (Iterator.value i))^"]"
| _ -> Printf.sprintf "<unknown code>:%d" (Char.code t)))
Expand All @@ -722,7 +722,6 @@ end (* module Print *)

(*
(* Test code *)
let hex s =
let len = S.length s in
let hs = S.create (len * 3) in
Expand Down Expand Up @@ -765,7 +764,7 @@ let dump ?(base=10) s =
let b1 = Append.init ();;
let () = Append.new_oid b1 "_id";;
let () = Append.string b1 "name" "Joe";;
let () = Append.int b1 "age" 33;;
let () = Append.int b1 "age" (-1l);;
let () = Append.finish b1;;
let s1 = hex (Append.get b1);;
let () = print_string (dump (Append.get b1));;
Expand All @@ -778,7 +777,7 @@ let fv2 = Iterator.int fi2;;
let fv2d = Iterator.double fi2;;
let fv2b = Iterator.bool fi2;;
let good1 = (fc1,fv1,fv1l,fc2,fv2,fv2d,fv2b)
= ('\002', "Joe", 3, '\016', 33, 33.0, true);;
= ('\002', "Joe", 3, '\016', (-1l), -1.0, true);;
let i = Iterator.init b1;;
let c1 = Iterator.next i;;
Expand All @@ -793,7 +792,7 @@ let v3 = Iterator.int i;;
let good2 = (c1,k1,c2,k2,v2,c3,k3,v3)
= ('\007', "_id",
'\002', "name", "Joe",
'\016', "age", 33);;
'\016', "age", -1l);;
let b2 = Append.init ();;
let () = Append.string b2 "hello" "world";;
Expand Down Expand Up @@ -831,7 +830,7 @@ let bson = Append.init ();;
let () = Append.string bson "bson" "bson_text";;
let () = Append.finish bson;;
let () = Append.bson b4 "bson" bson;;
let () = Append.timestamp b4 "timestamp" (1234,123456789);;
let () = Append.timestamp b4 "timestamp" (1234l,123456789l);;
let () = Append.date b4 "date" 123456789;;
let () = Append.time_t b4 "time_t" (Time.seconds 1234);;
let () = Append.finish_array b4;;
Expand Down Expand Up @@ -916,7 +915,7 @@ let good3 =
'\015', "code", "test", "<--scope-->", '\002', "scope", "<--scope-->",
'\005', "binary", '\000', 4, "test", '\005', "binary", '\002', 8,
"test_old", '\011', "regex", "regex_pat", "regex_opts", '\003', "bson",
'\002', "bson", "bson_text", '\017', "timestamp", (1234, 123456789), '\t',
'\002', "bson", "bson_text", '\017', "timestamp", (1234l, 123456789l), '\t',
"date", 123456789, '\t', "time_t", 1234.);;
let i4ss = IteratorSS.init b4;;
Expand Down
10 changes: 5 additions & 5 deletions libbase/bson.mli
View file
Expand Up @@ -144,7 +144,7 @@ module Append :
val empty : buf
val size : buf -> int
val estart : buf -> char -> S.t -> unit
val int : buf -> S.t -> int -> unit
val int : buf -> S.t -> int32 -> unit
val long : buf -> S.t -> int64 -> unit
val double : buf -> S.t -> float -> unit
val bool : buf -> S.t -> bool -> unit
Expand All @@ -168,7 +168,7 @@ module Append :
val new_oid : buf -> S.t -> unit
val regex : buf -> S.t -> S.t -> S.t -> unit
val bson : buf -> S.t -> buf -> unit
val timestamp : buf -> S.t -> int * int -> unit
val timestamp : buf -> S.t -> int32 * int32 -> unit
val date : buf -> S.t -> int64 -> unit
val time_t : buf -> S.t -> Time.t -> unit
val start_object : buf -> S.t -> unit
Expand All @@ -188,7 +188,7 @@ module type Iterator_sig =
val iterator_type : iter -> char
val key : iter -> string
val value : iter -> int
val int_raw : iter -> int
val int_raw : iter -> int32
val long_raw : iter -> int64
val double_raw : iter -> float
val bool_raw : iter -> bool
Expand All @@ -197,10 +197,10 @@ module type Iterator_sig =
val symbol : ?offset:int -> iter -> string
val cstring : ?offset:int -> iter -> string
val string_len : iter -> int
val int : iter -> int
val int : iter -> int32
val long : iter -> int64
val double : iter -> float
val timestamp : iter -> int * int
val timestamp : iter -> int32 * int32
val bool : iter -> bool
val code : iter -> string
val code_scope : iter -> buf
Expand Down
11 changes: 6 additions & 5 deletions libbase/mongo.ml
View file
Expand Up @@ -43,7 +43,8 @@ let string_of_opcode = function
| 2007 -> "OP_KILL_CURSORS"
| n -> Printf.sprintf "OP_UNKNOWN(%d)" n

let geti32 b s = Stuff.StuffString.ldi32 (Buf.sub b s 4) 0
let geti32 b s = Int32.to_int(Stuff.StuffString.ldi32l (Buf.sub b s 4) 0)
let geti32l b s = Stuff.StuffString.ldi32l (Buf.sub b s 4) 0
let geti64L b s = Stuff.StuffString.ldi64L (Buf.sub b s 8) 0
let cstring b s =
let pos = ref 0 in
Expand Down Expand Up @@ -226,7 +227,7 @@ let string_of_update b =

let start_update m rid flags ns =
set_header m rid 0 _OP_UPDATE;
Stuff.add_le_int32 m.Bson.buf 0;
Stuff.add_le_int32l m.Bson.buf 0l;
Buf.add_string m.Bson.buf ns;
Buf.add_char m.Bson.buf '\x00';
Stuff.add_le_int32 m.Bson.buf flags
Expand Down Expand Up @@ -285,7 +286,7 @@ let string_of_get_more b =

let start_getmore m rid ns numberToReturn cursorID =
set_header m rid 0 _OP_GET_MORE;
Stuff.add_le_int32 m.Bson.buf 0;
Stuff.add_le_int32l m.Bson.buf 0l;
Buf.add_string m.Bson.buf ns;
Buf.add_char m.Bson.buf '\x00';
Stuff.add_le_int32 m.Bson.buf numberToReturn;
Expand Down Expand Up @@ -315,7 +316,7 @@ let string_of_delete b =

let start_delete m rid flags ns =
set_header m rid 0 _OP_DELETE;
Stuff.add_le_int32 m.Bson.buf 0;
Stuff.add_le_int32l m.Bson.buf 0l;
Buf.add_string m.Bson.buf ns;
Buf.add_char m.Bson.buf '\x00';
Stuff.add_le_int32 m.Bson.buf flags
Expand All @@ -335,7 +336,7 @@ let string_of_kill_cursors b =

let start_kill_cursors m rid clist =
set_header m rid 0 _OP_KILL_CURSORS;
Stuff.add_le_int32 m.Bson.buf 0;
Stuff.add_le_int32l m.Bson.buf 0l;
Stuff.add_le_int32 m.Bson.buf (List.length clist);
List.iter (fun cursorID -> Stuff.add_le_int64L m.Bson.buf cursorID) clist

Expand Down
17 changes: 17 additions & 0 deletions libbase/stuff.ml
View file
Expand Up @@ -125,6 +125,7 @@ struct
S.set s (pos+6) (Char.chr (Int64.to_int (Int64.logand (Int64.shift_right_logical i64 8 ) 0xffL)));
S.set s (pos+7) (Char.chr (Int64.to_int (Int64.logand ( i64 ) 0xffL)))

(*
let ldi32 s i =
(((Char.code (S.get (s) (i+3))) lsl 24) land 0xff000000) lor
(((Char.code (S.get (s) (i+2))) lsl 16) land 0x00ff0000) lor
Expand All @@ -136,6 +137,7 @@ struct
(((Char.code (S.get (s) (i+1))) lsl 16) land 0x00ff0000) lor
(((Char.code (S.get (s) (i+2))) lsl 8) land 0x0000ff00) lor
(((Char.code (S.get (s) (i+3))) ) land 0x000000ff)
*)

(*
let ldi64 s i =
Expand All @@ -160,6 +162,21 @@ struct
(((Char.code (S.get (s) (i+7))) ) land 0x00000000000000ff)
*)

let ldi32l s i =
(Int32.logor (Int32.logand (Int32.shift_left (Int32.of_int (Char.code (S.get (s) (i+3)))) 24) 0x00000000ff000000l)
(Int32.logor (Int32.logand (Int32.shift_left (Int32.of_int (Char.code (S.get (s) (i+2)))) 16) 0x0000000000ff0000l)
(Int32.logor (Int32.logand (Int32.shift_left (Int32.of_int (Char.code (S.get (s) (i+1)))) 8) 0x000000000000ff00l)
(Int32.logand ( (Int32.of_int (Char.code (S.get (s) (i+0)))) ) 0x00000000000000ffl))))

let bdi32l s i =
(Int32.logor (Int32.logand (Int32.shift_left (Int32.of_int (Char.code (S.get (s) (i+0)))) 24) 0x00000000ff000000l)
(Int32.logor (Int32.logand (Int32.shift_left (Int32.of_int (Char.code (S.get (s) (i+1)))) 16) 0x0000000000ff0000l)
(Int32.logor (Int32.logand (Int32.shift_left (Int32.of_int (Char.code (S.get (s) (i+2)))) 8) 0x000000000000ff00l)
(Int32.logand ( (Int32.of_int (Char.code (S.get (s) (i+3)))) ) 0x00000000000000ffl))))

let ldi32 s i = Int32.to_int(ldi32l s i)
let bdi32 s i = Int32.to_int(bdi32l s i)

let ldi64L s i =
(Int64.logor (Int64.logand (Int64.shift_left (Int64.of_int (Char.code (S.get (s) (i+7)))) 56) 0xff00000000000000L)
(Int64.logor (Int64.logand (Int64.shift_left (Int64.of_int (Char.code (S.get (s) (i+6)))) 48) 0x00ff000000000000L)
Expand Down
4 changes: 4 additions & 0 deletions libbase/stuff.mli
View file
Expand Up @@ -40,6 +40,8 @@ module StuffF :
val bdi32 : S.t -> int -> int
(*val ldi64 : S.t -> int -> int
val bdi64 : S.t -> int -> int*)
val ldi32l : S.t -> int -> int32
val bdi32l : S.t -> int -> int32
val ldi64L : S.t -> int -> int64
val bdi64L : S.t -> int -> int64
val ldd : S.t -> int -> float
Expand All @@ -62,6 +64,8 @@ module StuffString :
val bdi32 : string -> int -> int
(*val ldi64 : string -> int -> int
val bdi64 : string -> int -> int*)
val ldi32l : string -> int -> int32
val bdi32l : string -> int -> int32
val ldi64L : string -> int -> int64
val bdi64L : string -> int -> int64
val ldd : string -> int -> float
Expand Down

0 comments on commit c7ab5eb

Please sign in to comment.