Subversion Repositories SmartDukaan

Rev

Go to most recent revision | Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
30 ashish 1 
(*
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 
 
20 
exception Break;;
21 
exception Thrift_error;;
22 
exception Field_empty of string;;
23 
 
24 
class t_exn =
25 
object
26 
  val mutable message = ""
27 
  method get_message = message
28 
  method set_message s = message <- s
29 
end;;
30 
 
31 
module Transport =
32 
struct
33 
  type exn_type =
34 
      | UNKNOWN
35 
      | NOT_OPEN
36 
      | ALREADY_OPEN
37 
      | TIMED_OUT
38 
      | END_OF_FILE;;
39 
 
40 
  exception E of exn_type * string
41 
 
42 
  class virtual t =
43 
  object (self)
44 
    method virtual isOpen : bool
45 
    method virtual opn : unit
46 
    method virtual close : unit
47 
    method virtual read : string -> int -> int -> int
48 
    method readAll buf off len =
49 
      let got = ref 0 in
50 
      let ret = ref 0 in
51 
        while !got < len do
52 
          ret := self#read buf (off+(!got)) (len - (!got));
53 
          if !ret <= 0 then
54 
            raise (E (UNKNOWN, "Cannot read. Remote side has closed."));
55 
          got := !got + !ret
56 
        done;
57 
        !got
58 
    method virtual write : string -> int -> int -> unit
59 
    method virtual flush : unit
60 
  end
61 
 
62 
  class factory =
63 
  object
64 
    method getTransport (t : t) = t
65 
  end
66 
 
67 
  class virtual server_t =
68 
  object (self)
69 
    method virtual listen : unit
70 
    method accept = self#acceptImpl
71 
    method virtual close : unit
72 
    method virtual acceptImpl : t
73 
  end
74 
 
75 
end;;
76 
 
77 
 
78 
 
79 
module Protocol =
80 
struct
81 
  type t_type =
82 
      | T_STOP
83 
      | T_VOID
84 
      | T_BOOL
85 
      | T_BYTE
86 
      | T_I08
87 
      | T_I16
88 
      | T_I32
89 
      | T_U64
90 
      | T_I64
91 
      | T_DOUBLE
92 
      | T_STRING
93 
      | T_UTF7
94 
      | T_STRUCT
95 
      | T_MAP
96 
      | T_SET
97 
      | T_LIST
98 
      | T_UTF8
99 
      | T_UTF16
100 
 
101 
  let t_type_to_i = function
102 
      T_STOP       -> 0
103 
    | T_VOID       -> 1
104 
    | T_BOOL       -> 2
105 
    | T_BYTE       -> 3
106 
    | T_I08        -> 3
107 
    | T_I16        -> 6
108 
    | T_I32        -> 8
109 
    | T_U64        -> 9
110 
    | T_I64        -> 10
111 
    | T_DOUBLE     -> 4
112 
    | T_STRING     -> 11
113 
    | T_UTF7       -> 11
114 
    | T_STRUCT     -> 12
115 
    | T_MAP        -> 13
116 
    | T_SET        -> 14
117 
    | T_LIST       -> 15
118 
    | T_UTF8       -> 16
119 
    | T_UTF16      -> 17
120 
 
121 
  let t_type_of_i = function
122 
 
123 
    | 1 -> T_VOID
124 
    | 2 -> T_BOOL
125 
    | 3 ->  T_BYTE
126 
    | 6-> T_I16
127 
    | 8 -> T_I32
128 
    | 9 -> T_U64
129 
    | 10 -> T_I64
130 
    | 4 -> T_DOUBLE
131 
    | 11 -> T_STRING
132 
    | 12 -> T_STRUCT
133 
    | 13 -> T_MAP
134 
    | 14 -> T_SET
135 
    | 15 -> T_LIST
136 
    | 16 -> T_UTF8
137 
    | 17 -> T_UTF16
138 
    | _ -> raise Thrift_error
139 
 
140 
  type message_type =
141 
    | CALL
142 
    | REPLY
143 
    | EXCEPTION
144 
    | ONEWAY
145 
 
146 
  let message_type_to_i = function
147 
    | CALL -> 1
148 
    | REPLY -> 2
149 
    | EXCEPTION -> 3
150 
    | ONEWAY -> 4
151 
 
152 
  let message_type_of_i = function
153 
    | 1 -> CALL
154 
    | 2 -> REPLY
155 
    | 3 -> EXCEPTION
156 
    | 4 -> ONEWAY
157 
    | _ -> raise Thrift_error
158 
 
159 
  class virtual t (trans: Transport.t) =
160 
  object (self)
161 
    val mutable trans_ = trans
162 
    method getTransport = trans_
163 
      (* writing methods *)
164 
    method virtual writeMessageBegin : string * message_type * int -> unit
165 
    method virtual writeMessageEnd : unit
166 
    method virtual writeStructBegin : string -> unit
167 
    method virtual writeStructEnd : unit
168 
    method virtual writeFieldBegin : string * t_type * int -> unit
169 
    method virtual writeFieldEnd : unit
170 
    method virtual writeFieldStop : unit
171 
    method virtual writeMapBegin : t_type * t_type * int -> unit
172 
    method virtual writeMapEnd : unit
173 
    method virtual writeListBegin : t_type * int -> unit
174 
    method virtual writeListEnd : unit
175 
    method virtual writeSetBegin : t_type * int -> unit
176 
    method virtual writeSetEnd : unit
177 
    method virtual writeBool : bool -> unit
178 
    method virtual writeByte : int -> unit
179 
    method virtual writeI16 : int -> unit
180 
    method virtual writeI32 : int -> unit
181 
    method virtual writeI64 : Int64.t -> unit
182 
    method virtual writeDouble : float -> unit
183 
    method virtual writeString : string -> unit
184 
    method virtual writeBinary : string -> unit
185 
      (* reading methods *)
186 
    method virtual readMessageBegin : string * message_type * int
187 
    method virtual readMessageEnd : unit
188 
    method virtual readStructBegin : string
189 
    method virtual readStructEnd : unit
190 
    method virtual readFieldBegin : string * t_type * int
191 
    method virtual readFieldEnd : unit
192 
    method virtual readMapBegin : t_type * t_type * int
193 
    method virtual readMapEnd : unit
194 
    method virtual readListBegin : t_type * int
195 
    method virtual readListEnd : unit
196 
    method virtual readSetBegin : t_type * int
197 
    method virtual readSetEnd : unit
198 
    method virtual readBool : bool
199 
    method virtual readByte : int
200 
    method virtual readI16 : int
201 
    method virtual readI32: int
202 
    method virtual readI64 : Int64.t
203 
    method virtual readDouble : float
204 
    method virtual readString : string
205 
    method virtual readBinary : string
206 
        (* skippage *)
207 
    method skip typ =
208 
      match typ with
209 
        | T_STOP -> ()
210 
        | T_VOID -> ()
211 
        | T_BOOL -> ignore self#readBool
212 
        | T_BYTE
213 
        | T_I08 -> ignore self#readByte
214 
        | T_I16 -> ignore self#readI16
215 
        | T_I32 -> ignore self#readI32
216 
        | T_U64
217 
        | T_I64 -> ignore self#readI64
218 
        | T_DOUBLE -> ignore self#readDouble
219 
        | T_STRING -> ignore self#readString
220 
        | T_UTF7 -> ()
221 
        | T_STRUCT -> ignore ((ignore self#readStructBegin);
222 
                              (try
223 
                                   while true do
224 
                                     let (_,t,_) = self#readFieldBegin in
225 
                                       if t = T_STOP then
226 
                                         raise Break
227 
                                       else
228 
                                         (self#skip t;
229 
                                          self#readFieldEnd)
230 
                                   done
231 
                               with Break -> ());
232 
                              self#readStructEnd)
233 
        | T_MAP -> ignore (let (k,v,s) = self#readMapBegin in
234 
                             for i=0 to s do
235 
                               self#skip k;
236 
                               self#skip v;
237 
                             done;
238 
                             self#readMapEnd)
239 
        | T_SET -> ignore (let (t,s) = self#readSetBegin in
240 
                             for i=0 to s do
241 
                               self#skip t
242 
                             done;
243 
                             self#readSetEnd)
244 
        | T_LIST -> ignore (let (t,s) = self#readListBegin in
245 
                              for i=0 to s do
246 
                                self#skip t
247 
                              done;
248 
                              self#readListEnd)
249 
        | T_UTF8 -> ()
250 
        | T_UTF16 -> ()
251 
  end
252 
 
253 
  class virtual factory =
254 
  object
255 
    method virtual getProtocol : Transport.t -> t
256 
  end
257 
 
258 
  type exn_type =
259 
      | UNKNOWN
260 
      | INVALID_DATA
261 
      | NEGATIVE_SIZE
262 
      | SIZE_LIMIT
263 
      | BAD_VERSION
264 
 
265 
  exception E of exn_type * string;;
266 
 
267 
end;;
268 
 
269 
 
270 
module Processor =
271 
struct
272 
  class virtual t =
273 
  object
274 
    method virtual process : Protocol.t -> Protocol.t -> bool
275 
  end;;
276 
 
277 
  class factory (processor : t) =
278 
  object
279 
    val processor_ = processor
280 
    method getProcessor (trans : Transport.t) = processor_
281 
  end;;
282 
end
283 
 
284 
 
285 
(* Ugly *)
286 
module Application_Exn =
287 
struct
288 
  type typ=
289 
      | UNKNOWN
290 
      | UNKNOWN_METHOD
291 
      | INVALID_MESSAGE_TYPE
292 
      | WRONG_METHOD_NAME
293 
      | BAD_SEQUENCE_ID
294 
      | MISSING_RESULT
295 
 
296 
  let typ_of_i = function
297 
 
298 
    | 1 -> UNKNOWN_METHOD
299 
    | 2 -> INVALID_MESSAGE_TYPE
300 
    | 3 -> WRONG_METHOD_NAME
301 
    | 4 -> BAD_SEQUENCE_ID
302 
    | 5 -> MISSING_RESULT
303 
    | _ -> raise Thrift_error;;
304 
  let typ_to_i = function
305 
    | UNKNOWN -> 0
306 
    | UNKNOWN_METHOD -> 1
307 
    | INVALID_MESSAGE_TYPE -> 2
308 
    | WRONG_METHOD_NAME -> 3
309 
    | BAD_SEQUENCE_ID -> 4
310 
    | MISSING_RESULT -> 5
311 
 
312 
  class t =
313 
  object (self)
314 
    inherit t_exn
315 
    val mutable typ = UNKNOWN
316 
    method get_type = typ
317 
    method set_type t = typ <- t
318 
    method write (oprot : Protocol.t) =
319 
      oprot#writeStructBegin "TApplicationExeception";
320 
      if self#get_message != "" then
321 
        (oprot#writeFieldBegin ("message",Protocol.T_STRING, 1);
322 
         oprot#writeString self#get_message;
323 
         oprot#writeFieldEnd)
324 
      else ();
325 
      oprot#writeFieldBegin ("type",Protocol.T_I32,2);
326 
      oprot#writeI32 (typ_to_i typ);
327 
      oprot#writeFieldEnd;
328 
      oprot#writeFieldStop;
329 
      oprot#writeStructEnd
330 
  end;;
331 
 
332 
  let create typ msg =
333 
    let e = new t in
334 
      e#set_type typ;
335 
    e#set_message msg;
336 
    e
337 
 
338 
  let read (iprot : Protocol.t) =
339 
    let msg = ref "" in
340 
    let typ = ref 0 in
341 
      ignore iprot#readStructBegin;
342 
      (try
343 
           while true do
344 
             let (name,ft,id) =iprot#readFieldBegin in
345 
               if ft = Protocol.T_STOP then
346 
                 raise Break
347 
               else ();
348 
               (match id with
349 
             | 1 -> (if ft = Protocol.T_STRING then
350 
                         msg := (iprot#readString)
351 
                     else
352 
                         iprot#skip ft)
353 
             | 2 -> (if ft = Protocol.T_I32 then
354 
                         typ := iprot#readI32
355 
                     else
356 
                         iprot#skip ft)
357 
             | _ -> iprot#skip ft);
358 
               iprot#readFieldEnd
359 
      done
360 
       with Break -> ());
361 
      iprot#readStructEnd;
362 
      let e = new t in
363 
        e#set_type (typ_of_i !typ);
364 
        e#set_message !msg;
365 
        e;;
366 
 
367 
  exception E of t
368 
end;;