blob: 6d7500e9c3fd3e880480926c4cda79b40d5eac7f [file] [log] [blame]
David Reissea2cba82009-03-30 21:35:00 +00001(*
2 Licensed to the Apache Software Foundation (ASF) under one
3 or more contributor license agreements. See the NOTICE file
4 distributed with this work for additional information
5 regarding copyright ownership. The ASF licenses this file
6 to you under the Apache License, Version 2.0 (the
7 "License"); you may not use this file except in compliance
8 with the License. You may obtain a copy of the License at
9
10 http://www.apache.org/licenses/LICENSE-2.0
11
12 Unless required by applicable law or agreed to in writing,
13 software distributed under the License is distributed on an
14 "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
15 KIND, either express or implied. See the License for the
16 specific language governing permissions and limitations
17 under the License.
18*)
19
iproctor9a41a0c2007-07-16 21:59:24 +000020open Thrift
21
22module P = Protocol
23
24let get_byte i b = 255 land (i lsr (8*b))
Bryan Duxburyfad8d6b2011-01-12 18:41:52 +000025let get_byte32 i b = 255 land (Int32.to_int (Int32.shift_right i (8*b)))
iproctor9a41a0c2007-07-16 21:59:24 +000026let get_byte64 i b = 255 land (Int64.to_int (Int64.shift_right i (8*b)))
27
28
29let tv = P.t_type_to_i
30let vt = P.t_type_of_i
31
32
David Reiss0c90f6f2008-02-06 22:18:40 +000033let comp_int b n =
iproctord4de1e92007-07-24 19:47:55 +000034 let s = ref 0l in
35 let sb = 32 - 8*n in
iproctor9a41a0c2007-07-16 21:59:24 +000036 for i=0 to (n-1) do
iproctord4de1e92007-07-24 19:47:55 +000037 s:= Int32.logor !s (Int32.shift_left (Int32.of_int (int_of_char b.[i])) (8*(n-1-i)))
iproctor9a41a0c2007-07-16 21:59:24 +000038 done;
Bryan Duxburyfad8d6b2011-01-12 18:41:52 +000039 Int32.shift_right (Int32.shift_left !s sb) sb
iproctor9a41a0c2007-07-16 21:59:24 +000040
41let comp_int64 b n =
42 let s = ref 0L in
43 for i=0 to (n-1) do
44 s:=Int64.logor !s (Int64.shift_left (Int64.of_int (int_of_char b.[i])) (8*(n-1-i)))
45 done;
46 !s
47
Bryan Duxburyfad8d6b2011-01-12 18:41:52 +000048let version_mask = 0xffff0000l
49let version_1 = 0x80010000l
iproctord4de1e92007-07-24 19:47:55 +000050
iproctor9a41a0c2007-07-16 21:59:24 +000051class t trans =
52object (self)
53 inherit P.t trans
54 val ibyte = String.create 8
David Reiss0c90f6f2008-02-06 22:18:40 +000055 method writeBool b =
iproctor9a41a0c2007-07-16 21:59:24 +000056 ibyte.[0] <- char_of_int (if b then 1 else 0);
57 trans#write ibyte 0 1
58 method writeByte i =
59 ibyte.[0] <- char_of_int (get_byte i 0);
60 trans#write ibyte 0 1
61 method writeI16 i =
62 let gb = get_byte i in
63 ibyte.[1] <- char_of_int (gb 0);
64 ibyte.[0] <- char_of_int (gb 1);
65 trans#write ibyte 0 2
66 method writeI32 i =
Bryan Duxburyfad8d6b2011-01-12 18:41:52 +000067 let gb = get_byte32 i in
iproctor9a41a0c2007-07-16 21:59:24 +000068 for i=0 to 3 do
69 ibyte.[3-i] <- char_of_int (gb i)
70 done;
71 trans#write ibyte 0 4
72 method writeI64 i=
73 let gb = get_byte64 i in
74 for i=0 to 7 do
75 ibyte.[7-i] <- char_of_int (gb i)
76 done;
77 trans#write ibyte 0 8
78 method writeDouble d =
79 self#writeI64 (Int64.bits_of_float d)
80 method writeString s=
81 let n = String.length s in
Bryan Duxburyfad8d6b2011-01-12 18:41:52 +000082 self#writeI32 (Int32.of_int n);
iproctor9a41a0c2007-07-16 21:59:24 +000083 trans#write s 0 n
84 method writeBinary a = self#writeString a
85 method writeMessageBegin (n,t,s) =
Bryan Duxburyfad8d6b2011-01-12 18:41:52 +000086 self#writeI32 (Int32.logor version_1 (Int32.of_int (P.message_type_to_i t)));
iproctor9a41a0c2007-07-16 21:59:24 +000087 self#writeString n;
Bryan Duxburyfad8d6b2011-01-12 18:41:52 +000088 self#writeI32 (Int32.of_int s)
iproctor9a41a0c2007-07-16 21:59:24 +000089 method writeMessageEnd = ()
90 method writeStructBegin s = ()
91 method writeStructEnd = ()
92 method writeFieldBegin (n,t,i) =
93 self#writeByte (tv t);
94 self#writeI16 i
95 method writeFieldEnd = ()
96 method writeFieldStop =
Bryan Duxburyfad8d6b2011-01-12 18:41:52 +000097 self#writeByte (tv (P.T_STOP))
iproctor9a41a0c2007-07-16 21:59:24 +000098 method writeMapBegin (k,v,s) =
99 self#writeByte (tv k);
100 self#writeByte (tv v);
Bryan Duxburyfad8d6b2011-01-12 18:41:52 +0000101 self#writeI32 (Int32.of_int s)
iproctor9a41a0c2007-07-16 21:59:24 +0000102 method writeMapEnd = ()
103 method writeListBegin (t,s) =
104 self#writeByte (tv t);
Bryan Duxburyfad8d6b2011-01-12 18:41:52 +0000105 self#writeI32 (Int32.of_int s)
iproctor9a41a0c2007-07-16 21:59:24 +0000106 method writeListEnd = ()
107 method writeSetBegin (t,s) =
108 self#writeByte (tv t);
Bryan Duxburyfad8d6b2011-01-12 18:41:52 +0000109 self#writeI32 (Int32.of_int s)
iproctor9a41a0c2007-07-16 21:59:24 +0000110 method writeSetEnd = ()
David Reiss0c90f6f2008-02-06 22:18:40 +0000111 method readByte =
iproctor9a41a0c2007-07-16 21:59:24 +0000112 ignore (trans#readAll ibyte 0 1);
Bryan Duxburyfad8d6b2011-01-12 18:41:52 +0000113 Int32.to_int (comp_int ibyte 1)
iproctor9a41a0c2007-07-16 21:59:24 +0000114 method readI16 =
115 ignore (trans#readAll ibyte 0 2);
Bryan Duxburyfad8d6b2011-01-12 18:41:52 +0000116 Int32.to_int (comp_int ibyte 2)
iproctor9a41a0c2007-07-16 21:59:24 +0000117 method readI32 =
118 ignore (trans#readAll ibyte 0 4);
119 comp_int ibyte 4
120 method readI64 =
121 ignore (trans#readAll ibyte 0 8);
122 comp_int64 ibyte 8
123 method readDouble =
124 Int64.float_of_bits (self#readI64)
125 method readBool =
126 self#readByte = 1
127 method readString =
Bryan Duxburyfad8d6b2011-01-12 18:41:52 +0000128 let sz = Int32.to_int (self#readI32) in
iproctor9a41a0c2007-07-16 21:59:24 +0000129 let buf = String.create sz in
130 ignore (trans#readAll buf 0 sz);
131 buf
132 method readBinary = self#readString
133 method readMessageBegin =
iproctord4de1e92007-07-24 19:47:55 +0000134 let ver = self#readI32 in
Bryan Duxburyfad8d6b2011-01-12 18:41:52 +0000135 if Int32.compare (Int32.logand ver version_mask) version_1 != 0 then
136 raise (P.E (P.BAD_VERSION, "Missing version identifier"))
iproctord4de1e92007-07-24 19:47:55 +0000137 else
138 let s = self#readString in
Bryan Duxburyfad8d6b2011-01-12 18:41:52 +0000139 let mt = P.message_type_of_i (Int32.to_int (Int32.logand ver 0xFFl)) in
140 (s,mt, Int32.to_int self#readI32)
iproctor9a41a0c2007-07-16 21:59:24 +0000141 method readMessageEnd = ()
142 method readStructBegin =
143 ""
144 method readStructEnd = ()
145 method readFieldBegin =
David Reiss0c90f6f2008-02-06 22:18:40 +0000146 let t = (vt (self#readByte))
iproctor9a41a0c2007-07-16 21:59:24 +0000147 in
148 if t != P.T_STOP then
149 ("",t,self#readI16)
150 else ("",t,0);
151 method readFieldEnd = ()
152 method readMapBegin =
153 let kt = vt (self#readByte) in
154 let vt = vt (self#readByte) in
Bryan Duxburyfad8d6b2011-01-12 18:41:52 +0000155 (kt,vt, Int32.to_int self#readI32)
iproctor9a41a0c2007-07-16 21:59:24 +0000156 method readMapEnd = ()
157 method readListBegin =
158 let t = vt (self#readByte) in
Bryan Duxburyfad8d6b2011-01-12 18:41:52 +0000159 (t, Int32.to_int self#readI32)
iproctor9a41a0c2007-07-16 21:59:24 +0000160 method readListEnd = ()
161 method readSetBegin =
162 let t = vt (self#readByte) in
Bryan Duxburyfad8d6b2011-01-12 18:41:52 +0000163 (t, Int32.to_int self#readI32);
iproctor9a41a0c2007-07-16 21:59:24 +0000164 method readSetEnd = ()
165end
166
167class factory =
168object
169 inherit P.factory
170 method getProtocol tr = new t tr
171end