ceph/src/jaegertracing/thrift/lib/ocaml/src/Thrift.ml

   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       0 -> T_STOP
 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 : Int32.t -> 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: Int32.t
 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_BOOL -> ignore self#readBool
 210         | T_BYTE
 211         | T_I08 -> ignore self#readByte
 212         | T_I16 -> ignore self#readI16
 213         | T_I32 -> ignore self#readI32
 214         | T_U64
 215         | T_I64 -> ignore self#readI64
 216         | T_DOUBLE -> ignore self#readDouble
 217         | T_STRING -> ignore self#readString
 218         | T_UTF7 -> ()
 219         | T_STRUCT -> ignore ((ignore self#readStructBegin);
 220                               (try
 221                                    while true do
 222                                      let (_,t,_) = self#readFieldBegin in
 223                                        if t = T_STOP then
 224                                          raise Break
 225                                        else
 226                                          (self#skip t;
 227                                           self#readFieldEnd)
 228                                    done
 229                                with Break -> ());
 230                               self#readStructEnd)
 231         | T_MAP -> ignore (let (k,v,s) = self#readMapBegin in
 232                              for i=0 to s do
 233                                self#skip k;
 234                                self#skip v;
 235                              done;
 236                              self#readMapEnd)
 237         | T_SET -> ignore (let (t,s) = self#readSetBegin in
 238                              for i=0 to s do
 239                                self#skip t
 240                              done;
 241                              self#readSetEnd)
 242         | T_LIST -> ignore (let (t,s) = self#readListBegin in
 243                               for i=0 to s do
 244                                 self#skip t
 245                               done;
 246                               self#readListEnd)
 247         | T_UTF8 -> ()
 248         | T_UTF16 -> ()
 249         | _ -> raise (Protocol.E (Protocol.INVALID_DATA, "Invalid data"))
 250   end
 251
 252   class virtual factory =
 253   object
 254     method virtual getProtocol : Transport.t -> t
 255   end
 256
 257   type exn_type =
 258       | UNKNOWN
 259       | INVALID_DATA
 260       | NEGATIVE_SIZE
 261       | SIZE_LIMIT
 262       | BAD_VERSION
 263       | NOT_IMPLEMENTED
 264       | DEPTH_LIMIT
 265
 266   exception E of exn_type * string;;
 267
 268 end;;
 269
 270
 271 module Processor =
 272 struct
 273   class virtual t =
 274   object
 275     method virtual process : Protocol.t -> Protocol.t -> bool
 276   end;;
 277
 278   class factory (processor : t) =
 279   object
 280     val processor_ = processor
 281     method getProcessor (trans : Transport.t) = processor_
 282   end;;
 283 end
 284
 285
 286 (* Ugly *)
 287 module Application_Exn =
 288 struct
 289   type typ=
 290       | UNKNOWN
 291       | UNKNOWN_METHOD
 292       | INVALID_MESSAGE_TYPE
 293       | WRONG_METHOD_NAME
 294       | BAD_SEQUENCE_ID
 295       | MISSING_RESULT
 296       | INTERNAL_ERROR
 297       | PROTOCOL_ERROR
 298       | INVALID_TRANSFORM
 299       | INVALID_PROTOCOL
 300       | UNSUPPORTED_CLIENT_TYPE
 301
 302   let typ_of_i = function
 303       0l -> UNKNOWN
 304     | 1l -> UNKNOWN_METHOD
 305     | 2l -> INVALID_MESSAGE_TYPE
 306     | 3l -> WRONG_METHOD_NAME
 307     | 4l -> BAD_SEQUENCE_ID
 308     | 5l -> MISSING_RESULT
 309     | 6l -> INTERNAL_ERROR
 310     | 7l -> PROTOCOL_ERROR
 311     | 8l -> INVALID_TRANSFORM
 312     | 9l -> INVALID_PROTOCOL
 313     | 10l -> UNSUPPORTED_CLIENT_TYPE
 314     | _ -> raise Thrift_error;;
 315   let typ_to_i = function
 316     | UNKNOWN -> 0l
 317     | UNKNOWN_METHOD -> 1l
 318     | INVALID_MESSAGE_TYPE -> 2l
 319     | WRONG_METHOD_NAME -> 3l
 320     | BAD_SEQUENCE_ID -> 4l
 321     | MISSING_RESULT -> 5l
 322     | INTERNAL_ERROR -> 6l
 323     | PROTOCOL_ERROR -> 7l
 324     | INVALID_TRANSFORM -> 8l
 325     | INVALID_PROTOCOL -> 9l
 326     | UNSUPPORTED_CLIENT_TYPE -> 10l
 327
 328   class t =
 329   object (self)
 330     inherit t_exn
 331     val mutable typ = UNKNOWN
 332     method get_type = typ
 333     method set_type t = typ <- t
 334     method write (oprot : Protocol.t) =
 335       oprot#writeStructBegin "TApplicationExeception";
 336       if self#get_message != "" then
 337         (oprot#writeFieldBegin ("message",Protocol.T_STRING, 1);
 338          oprot#writeString self#get_message;
 339          oprot#writeFieldEnd)
 340       else ();
 341       oprot#writeFieldBegin ("type",Protocol.T_I32,2);
 342       oprot#writeI32 (typ_to_i typ);
 343       oprot#writeFieldEnd;
 344       oprot#writeFieldStop;
 345       oprot#writeStructEnd
 346   end;;
 347
 348   let create typ msg =
 349     let e = new t in
 350       e#set_type typ;
 351     e#set_message msg;
 352     e
 353
 354   let read (iprot : Protocol.t) =
 355     let msg = ref "" in
 356     let typ = ref 0l in
 357       ignore iprot#readStructBegin;
 358       (try
 359            while true do
 360              let (name,ft,id) =iprot#readFieldBegin in
 361                if ft = Protocol.T_STOP
 362                then raise Break
 363                else ();
 364                (match id with
 365              | 1 -> (if ft = Protocol.T_STRING
 366                then msg := (iprot#readString)
 367                else iprot#skip ft)
 368              | 2 -> (if ft = Protocol.T_I32
 369                then typ := iprot#readI32
 370                else iprot#skip ft)
 371              | _ -> iprot#skip ft);
 372                iprot#readFieldEnd
 373       done
 374        with Break -> ());
 375       iprot#readStructEnd;
 376       let e = new t in
 377         e#set_type (typ_of_i !typ);
 378         e#set_message !msg;
 379         e;;
 380
 381   exception E of t
 382 end;;