lib/ocaml/src/TBinaryProtocol.ml

open Thrift

module P = Protocol

let get_byte i b = 255 land (i lsr (8*b))
let get_byte64 i b = 255 land (Int64.to_int (Int64.shift_right i (8*b)))


let tv = P.t_type_to_i
let vt = P.t_type_of_i


let comp_int b n = 
  let s = ref 0l in
  let sb = 32 - 8*n in
    for i=0 to (n-1) do
      s:= Int32.logor !s (Int32.shift_left (Int32.of_int (int_of_char b.[i])) (8*(n-1-i)))
    done;
    Int32.to_int (Int32.shift_right (Int32.shift_left !s sb) sb)

let comp_int64 b n =
  let s = ref 0L in
    for i=0 to (n-1) do
      s:=Int64.logor !s (Int64.shift_left (Int64.of_int (int_of_char b.[i])) (8*(n-1-i)))
    done;
    !s

let version_mask = 0xffff0000
let version_1 = 0x80010000

class t trans =
object (self)
  inherit P.t trans
  val ibyte = String.create 8
  method writeBool b = 
    ibyte.[0] <- char_of_int (if b then 1 else 0);
    trans#write ibyte 0 1
  method writeByte i =
    ibyte.[0] <- char_of_int (get_byte i 0);
    trans#write ibyte 0 1
  method writeI16 i =
    let gb = get_byte i in
      ibyte.[1] <- char_of_int (gb 0);
      ibyte.[0] <- char_of_int (gb 1);
      trans#write ibyte 0 2
  method writeI32 i =
    let gb = get_byte i in
      for i=0 to 3 do
        ibyte.[3-i] <- char_of_int (gb i)
      done;
      trans#write ibyte 0 4
  method writeI64 i=
    let gb = get_byte64 i in
      for i=0 to 7 do
        ibyte.[7-i] <- char_of_int (gb i)
      done;
      trans#write ibyte 0 8
  method writeDouble d =
    self#writeI64 (Int64.bits_of_float d)
  method writeString s=
    let n = String.length s in
      self#writeI32(n);
      trans#write s 0 n
  method writeBinary a = self#writeString a
  method writeMessageBegin (n,t,s) =
    self#writeI32 (version_1 lor (P.message_type_to_i t));
    self#writeString n;
    self#writeI32 s
  method writeMessageEnd = ()
  method writeStructBegin s = ()
  method writeStructEnd = ()
  method writeFieldBegin (n,t,i) =
    self#writeByte (tv t);
    self#writeI16 i
  method writeFieldEnd = ()
  method writeFieldStop =
    self#writeByte (tv (Protocol.T_STOP))
  method writeMapBegin (k,v,s) =
    self#writeByte (tv k);
    self#writeByte (tv v);
    self#writeI32 s
  method writeMapEnd = ()
  method writeListBegin (t,s) =
    self#writeByte (tv t);
    self#writeI32 s
  method writeListEnd = ()
  method writeSetBegin (t,s) =
    self#writeByte (tv t);
    self#writeI32 s
  method writeSetEnd = ()
  method readByte = 
    ignore (trans#readAll ibyte 0 1);
    (comp_int ibyte 1)
  method readI16 =
    ignore (trans#readAll ibyte 0 2);
    comp_int ibyte 2
  method readI32 =
    ignore (trans#readAll ibyte 0 4);
    comp_int ibyte 4
  method readI64 =
    ignore (trans#readAll ibyte 0 8);
    comp_int64 ibyte 8
  method readDouble =
    Int64.float_of_bits (self#readI64)
  method readBool =
    self#readByte = 1
  method readString =
    let sz = self#readI32 in
    let buf = String.create sz in
      ignore (trans#readAll buf 0 sz);
      buf
  method readBinary = self#readString
  method readMessageBegin =
    let ver = self#readI32 in
      if (ver land version_mask != version_1) then
        (print_int ver;
        raise (P.E (P.BAD_VERSION, "Missing version identifier")))
      else
        let s = self#readString in
        let mt = P.message_type_of_i (ver land 0xFF) in
          (s,mt, self#readI32)
  method readMessageEnd = ()
  method readStructBegin =
    ""
  method readStructEnd = ()
  method readFieldBegin =
    let t = (vt (self#readByte)) 
    in
      if t != P.T_STOP then
        ("",t,self#readI16)
      else ("",t,0);
  method readFieldEnd = ()
  method readMapBegin =
    let kt = vt (self#readByte) in
    let vt = vt (self#readByte) in
      (kt,vt, self#readI32)
  method readMapEnd = ()
  method readListBegin =
    let t = vt (self#readByte) in
    (t,self#readI32)
  method readListEnd = ()
  method readSetBegin =
    let t = vt (self#readByte) in
    (t, self#readI32);
  method readSetEnd = ()
end

class factory =
object
  inherit P.factory
  method getProtocol tr = new t tr
end