Permalink
Browse files

[fix] stdlib: Sanitized low-level MongoDB code for 32-bit.

  • Loading branch information...
1 parent 30883d0 commit efc8fadc80a33d52fc214379ffa5561f0ad296e8 @nrs135 nrs135 committed Dec 5, 2011
Showing with 46 additions and 35 deletions.
  1. +21 −16 libbase/bson.ml
  2. +5 −5 libbase/bson.mli
  3. +6 −0 libbase/stuff.ml
  4. +10 −10 libbase/stuff.mli
  5. +4 −4 opabsl/mlbsl/bslMongo.ml
View
@@ -189,7 +189,7 @@ struct
let long b name l =
estart b el_long name;
- Stuff.add_le_int64 b.buf l
+ Stuff.add_le_int64L b.buf l
let double b name d =
estart b el_double name;
@@ -312,10 +312,10 @@ struct
let date b name millis =
estart b el_date name;
- Stuff.add_le_int64 b.buf millis
+ Stuff.add_le_int64L b.buf millis
let time_t b name t =
- date b name (Time.in_milliseconds t)
+ date b name (Int64.of_int (Time.in_milliseconds t))
let start_object b name =
estart b el_object name;
@@ -358,7 +358,7 @@ sig
val key : iter -> string
val value : iter -> int
val int_raw : iter -> int
- val long_raw : iter -> int
+ val long_raw : iter -> int64
val double_raw : iter -> float
val bool_raw : iter -> bool
val oid : iter -> string
@@ -367,13 +367,13 @@ sig
val cstring : ?offset:int -> iter -> string
val string_len : iter -> int
val int : iter -> int
- val long : iter -> int
+ val long : iter -> int64
val double : iter -> float
val timestamp : iter -> int * int
val bool : iter -> bool
val code : iter -> string
val code_scope : iter -> buf
- val date : iter -> int
+ val date : iter -> int64
val time_t : iter -> Time.t
val bin_type : iter -> char
val bin_len : iter -> int
@@ -426,7 +426,7 @@ struct
St.ldi32 i.ibuf (value i)
let long_raw i =
- St.ldi64 i.ibuf (value i)
+ St.ldi64L i.ibuf (value i)
let double_raw i =
St.ldd i.ibuf (value i)
@@ -460,16 +460,21 @@ struct
let int i =
match S.get i.ibuf (i.pos) with
| c when c = el_int -> int_raw i
- | c when c = el_long -> long_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
- let long = int
+ 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_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_long -> float_of_int (long_raw i)
+ | c when c = el_long -> Int64.to_float (long_raw i)
| c when c = el_double -> double_raw i
| _ -> 0.0
@@ -481,7 +486,7 @@ struct
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_long -> long_raw i <> 0
+ | 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
| _ -> true
@@ -512,7 +517,7 @@ struct
long_raw i
let time_t i =
- Time.milliseconds (date i)
+ Time.milliseconds (Int64.to_int (date i))
let bin_type i =
S.get i.ibuf (value i + 4)
@@ -645,7 +650,7 @@ struct
| c when c = el_symbol -> Printf.printf "SYMBOL: %s" (Iterator.string i)
| c when c = el_oid -> Printf.printf "%s" (Oid.to_string (Iterator.oid i))
| c when c = el_bool -> Printf.printf "%b" (Iterator.bool i)
- | c when c = el_date -> Printf.printf "%d" (Iterator.date i)
+ | c when c = el_date -> Printf.printf "%Ld" (Iterator.date i)
| c when c = el_bindata -> Printf.printf "el_bindata"
| c when c = el_undefined -> Printf.printf "el_undefined"
| c when c = el_null -> Printf.printf "el_null"
@@ -659,7 +664,7 @@ struct
Printf.printf "\n\t SCOPE: ";
print scope
| c when c = el_int -> Printf.printf "%d" (Iterator.int i)
- | c when c = el_long -> Printf.printf "%d" (Iterator.long 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
@@ -691,7 +696,7 @@ struct
| c when c = el_symbol -> Printf.sprintf "SYMBOL(%s)" (Iterator.string i)
| c when c = el_oid -> Printf.sprintf "ObjectId(\"%s\")" (Oid.to_string (Iterator.oid i))
| c when c = el_bool -> Printf.sprintf "%b" (Iterator.bool i)
- | c when c = el_date -> Printf.sprintf "DATE(%d)" (Iterator.date i)
+ | c when c = el_date -> Printf.sprintf "DATE(%Ld)" (Iterator.date i)
| c when c = el_bindata -> Printf.sprintf "BINARY"
| c when c = el_undefined -> Printf.sprintf "UNDEFINED"
| c when c = el_null -> Printf.sprintf "null"
@@ -702,7 +707,7 @@ struct
| 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_long -> Printf.sprintf "%d" (Iterator.long 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
View
@@ -145,7 +145,7 @@ module Append :
val size : buf -> int
val estart : buf -> char -> S.t -> unit
val int : buf -> S.t -> int -> unit
- val long : buf -> S.t -> int -> unit
+ val long : buf -> S.t -> int64 -> unit
val double : buf -> S.t -> float -> unit
val bool : buf -> S.t -> bool -> unit
val null : buf -> S.t -> unit
@@ -169,7 +169,7 @@ module Append :
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 date : buf -> S.t -> int -> unit
+ val date : buf -> S.t -> int64 -> unit
val time_t : buf -> S.t -> Time.t -> unit
val start_object : buf -> S.t -> unit
val start_array : buf -> S.t -> unit
@@ -189,7 +189,7 @@ module type Iterator_sig =
val key : iter -> string
val value : iter -> int
val int_raw : iter -> int
- val long_raw : iter -> int
+ val long_raw : iter -> int64
val double_raw : iter -> float
val bool_raw : iter -> bool
val oid : iter -> string
@@ -198,13 +198,13 @@ module type Iterator_sig =
val cstring : ?offset:int -> iter -> string
val string_len : iter -> int
val int : iter -> int
- val long : iter -> int
+ val long : iter -> int64
val double : iter -> float
val timestamp : iter -> int * int
val bool : iter -> bool
val code : iter -> string
val code_scope : iter -> buf
- val date : iter -> int
+ val date : iter -> int64
val time_t : iter -> Time.t
val bin_type : iter -> char
val bin_len : iter -> int
View
@@ -49,6 +49,7 @@ struct
S.set s (pos+2) (Char.chr ((i lsr 8 ) land 0xff));
S.set s (pos+3) (Char.chr ( i land 0xff))
+(*
let lei64 s pos i =
S.set s (pos+7) (Char.chr ((i lsr 56) land 0xff));
S.set s (pos+6) (Char.chr ((i lsr 48) land 0xff));
@@ -68,6 +69,7 @@ struct
S.set s (pos+5) (Char.chr ((i lsr 16) land 0xff));
S.set s (pos+6) (Char.chr ((i lsr 8 ) land 0xff));
S.set s (pos+7) (Char.chr ( i land 0xff))
+*)
let led s pos f =
let b = Int64.bits_of_float f in
@@ -135,6 +137,7 @@ struct
(((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 =
(((Char.code (S.get (s) (i+7))) lsl 56) land 0x7f00000000000000) lor
(((Char.code (S.get (s) (i+6))) lsl 48) land 0x00ff000000000000) lor
@@ -155,6 +158,7 @@ struct
(((Char.code (S.get (s) (i+5))) lsl 16) land 0x0000000000ff0000) lor
(((Char.code (S.get (s) (i+6))) lsl 8) land 0x000000000000ff00) lor
(((Char.code (S.get (s) (i+7))) ) land 0x00000000000000ff)
+*)
let ldi64L s i =
(Int64.logor (Int64.logand (Int64.shift_left (Int64.of_int (Char.code (S.get (s) (i+7)))) 56) 0xff00000000000000L)
@@ -193,6 +197,7 @@ let add_be_int32 b i =
StuffString.bei32 b.Buf.str b.Buf.i i;
b.Buf.i <- b.Buf.i + 4
+(*
let add_le_int64 b i =
if Buf.spare b <= 8 then raise (Failure "add_le_int64");
StuffString.lei64 b.Buf.str b.Buf.i i;
@@ -202,6 +207,7 @@ let add_be_int64 b i =
if Buf.spare b <= 8 then raise (Failure "add_be_int64");
StuffString.bei64 b.Buf.str b.Buf.i i;
b.Buf.i <- b.Buf.i + 8
+*)
let add_le_d b i =
if Buf.spare b <= 8 then raise (Failure "add_le_d");
View
@@ -28,8 +28,8 @@ module StuffF :
sig
val lei32 : S.t -> int -> int -> unit
val bei32 : S.t -> int -> int -> unit
- val lei64 : S.t -> int -> int -> unit
- val bei64 : S.t -> int -> int -> unit
+ (*val lei64 : S.t -> int -> int -> unit
+ val bei64 : S.t -> int -> int -> unit*)
val led : S.t -> int -> float -> unit
val bed : S.t -> int -> float -> unit
val lei32l : S.t -> int -> int32 -> unit
@@ -38,8 +38,8 @@ module StuffF :
val bei64L : S.t -> int -> int64 -> unit
val ldi32 : S.t -> int -> int
val bdi32 : S.t -> int -> int
- val ldi64 : S.t -> int -> int
- val bdi64 : S.t -> int -> int
+ (*val ldi64 : S.t -> int -> int
+ val bdi64 : S.t -> int -> int*)
val ldi64L : S.t -> int -> int64
val bdi64L : S.t -> int -> int64
val ldd : S.t -> int -> float
@@ -50,8 +50,8 @@ module StuffString :
sig
val lei32 : string -> int -> int -> unit
val bei32 : string -> int -> int -> unit
- val lei64 : string -> int -> int -> unit
- val bei64 : string -> int -> int -> unit
+ (*val lei64 : string -> int -> int -> unit
+ val bei64 : string -> int -> int -> unit*)
val led : string -> int -> float -> unit
val bed : string -> int -> float -> unit
val lei32l : string -> int -> int32 -> unit
@@ -60,8 +60,8 @@ module StuffString :
val bei64L : string -> int -> int64 -> unit
val ldi32 : string -> int -> int
val bdi32 : string -> int -> int
- val ldi64 : string -> int -> int
- val bdi64 : string -> int -> int
+ (*val ldi64 : string -> int -> int
+ val bdi64 : string -> int -> int*)
val ldi64L : string -> int -> int64
val bdi64L : string -> int -> int64
val ldd : string -> int -> float
@@ -70,8 +70,8 @@ module StuffString :
val add_le_int32 : Buf.buf -> int -> unit
val add_be_int32 : Buf.buf -> int -> unit
-val add_le_int64 : Buf.buf -> int -> unit
-val add_be_int64 : Buf.buf -> int -> unit
+(*val add_le_int64 : Buf.buf -> int -> unit
+val add_be_int64 : Buf.buf -> int -> unit*)
val add_le_d : Buf.buf -> float -> unit
val add_be_d : Buf.buf -> float -> unit
val add_le_int32l : Buf.buf -> int32 -> unit
@@ -98,7 +98,7 @@ let serialize bsons b =
Bson.Append.binary b name Bson.st_bin_binary bin (String.length bin)
| Some "ObjectID" -> Bson.Append.oid b name (ServerLib.unwrap_string value)
| Some "Boolean" -> Bson.Append.bool b name (ServerLib.unwrap_bool value)
- | Some "Date" ->Bson.Append.date b name (ServerLib.unwrap_int value)
+ | Some "Date" -> Bson.Append.date b name (Int64.of_int (ServerLib.unwrap_int value))
| Some "Null" -> Bson.Append.null b name
| Some "Min" -> Bson.Append.minkey b name
| Some "Max" -> Bson.Append.maxkey b name
@@ -119,7 +119,7 @@ let serialize bsons b =
(match BslNativeLib.ocaml_tuple_2 value with
| (i, t) ->
Bson.Append.timestamp b name ((ServerLib.unwrap_int i), (ServerLib.unwrap_int t)))
- | Some "Int64" -> Bson.Append.long b name (ServerLib.unwrap_int value)
+ | Some "Int64" -> Bson.Append.long b name (Int64.of_int (ServerLib.unwrap_int value))
| Some str ->
Printf.eprintf "Unknown code: %s\n%!" str;
assert false
@@ -195,7 +195,7 @@ let deserialize s =
(function
| c when c = Bson.el_eoo -> shared_nil
| c when c = Bson.el_int -> let e = make_int32 (Bson.IteratorSS.key i) (Bson.IteratorSS.int i) in auxn e i
- | c when c = Bson.el_long -> let e = make_int64 (Bson.IteratorSS.key i) (Bson.IteratorSS.long i) in auxn e i
+ | c when c = Bson.el_long -> let e = make_int64 (Bson.IteratorSS.key i) (Int64.to_int (Bson.IteratorSS.long i)) in auxn e i
| c when c = Bson.el_double -> let e = make_double (Bson.IteratorSS.key i) (Bson.IteratorSS.double i) in auxn e i
| c when c = Bson.el_bool -> let e = make_bool (Bson.IteratorSS.key i) (Bson.IteratorSS.bool i) in auxn e i
| c when c = Bson.el_string -> let e = make_string (Bson.IteratorSS.key i) (Bson.IteratorSS.string i) in auxn e i
@@ -211,7 +211,7 @@ let deserialize s =
let e = make_array key bsons in auxn e i
| c when c = Bson.el_bindata -> let e = make_binary (Bson.IteratorSS.key i) (Bson.IteratorSS.bin_data i) in auxn e i
| c when c = Bson.el_oid -> let e = make_objectid (Bson.IteratorSS.key i) (Bson.IteratorSS.oid i) in auxn e i
- | c when c = Bson.el_date -> let e = make_date (Bson.IteratorSS.key i) (Bson.IteratorSS.date i) in auxn e i
+ | c when c = Bson.el_date -> let e = make_date (Bson.IteratorSS.key i) (Int64.to_int (Bson.IteratorSS.date i)) in auxn e i
| c when c = Bson.el_null -> let e = make_null (Bson.IteratorSS.key i) ServerLib.void in auxn e i
| c when c = Bson.el_minkey -> let e = make_minkey (Bson.IteratorSS.key i) ServerLib.void in auxn e i
| c when c = Bson.el_maxkey -> let e = make_maxkey (Bson.IteratorSS.key i) ServerLib.void in auxn e i

0 comments on commit efc8fad

Please sign in to comment.