diff options
Diffstat (limited to 'src/jaegertracing/thrift/lib/ocaml')
19 files changed, 1180 insertions, 0 deletions
diff --git a/src/jaegertracing/thrift/lib/ocaml/.gitignore b/src/jaegertracing/thrift/lib/ocaml/.gitignore new file mode 100644 index 000000000..0d9a6af46 --- /dev/null +++ b/src/jaegertracing/thrift/lib/ocaml/.gitignore @@ -0,0 +1,11 @@ +_build/ +_tags +configure +setup.data +setup.ml +myocamlbuild.ml +*/META +*/*.mllib +*/*.mldylib +Makefile +OCamlMakefile diff --git a/src/jaegertracing/thrift/lib/ocaml/DEVELOPMENT b/src/jaegertracing/thrift/lib/ocaml/DEVELOPMENT new file mode 100644 index 000000000..3d5a03c24 --- /dev/null +++ b/src/jaegertracing/thrift/lib/ocaml/DEVELOPMENT @@ -0,0 +1,76 @@ +Thrift OCaml Development +======================== + +Prerequisites +------------- + +In order to build this library, you must have the following installed: + + * The OCaml compiler, preferably >4.00 + * The Oasis build tool + +In addition you may want to install OPAM, which will allow you to setup an +OCaml development environment that's isolated from your system installation, +much like virutalenv for Python or the myriad systems available for Ruby. If +you have OPAM installed, then installing Oasis is as simple as running: + + $ opam install oasis + +Building +-------- + +Once all the prerequisites have been installed, run the following commands: + + $ oasis setup + $ ./configure + $ make + +The `oasis setup` command will generate the configure script and Makefile, +along with other files that opam will use to create an installable library. +The cofigure script will ensure that all build dependencies are installed, and +make will actually build the library. + +To remove files that the compiler geneates, run: + + $ make clean + +To remove those files _as well as_ files that the setup and configure process +generates, run: + + $ rm `cat .gitignore` + +Installing +---------- + +If you're using opam, simply run the following command: + + $ make install + +While development, you may want to install your latest build on the system to +test against other libraries or programs. To do this, use: + + $ make reinstall + +Distribution +------------ + +The de facto preferred method for distributing OCaml libraries is through the +OPAM package repository. To publish the latest package, issue a pull request +against the following github repository: + + https://github.com/ocaml/opam-repository + +The pull requestion should add the following directory structure and files: + + package + |__thrift + |__thrift.<VERSION> + |__ descr + |__ opam + |__ url + +Templates for the following files can be found in the opam/ subdirectory of +this library's root, with XXX(...) indicating fields that need to be filled +out. You can find further documentation here: + + http://opam.ocaml.org/doc/Packaging.html diff --git a/src/jaegertracing/thrift/lib/ocaml/README.md b/src/jaegertracing/thrift/lib/ocaml/README.md new file mode 100644 index 000000000..5a47a4247 --- /dev/null +++ b/src/jaegertracing/thrift/lib/ocaml/README.md @@ -0,0 +1,119 @@ +Thrift OCaml Software Library + +License +======= + +Licensed to the Apache Software Foundation (ASF) under one +or more contributor license agreements. See the NOTICE file +distributed with this work for additional information +regarding copyright ownership. The ASF licenses this file +to you under the Apache License, Version 2.0 (the +"License"); you may not use this file except in compliance +with the License. You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, +software distributed under the License is distributed on an +"AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +KIND, either express or implied. See the License for the +specific language governing permissions and limitations +under the License. + + +Library +======= + +The library abstract classes, exceptions, and general use functions +are mostly jammed in Thrift.ml (an exception being +TServer). + +Generally, classes are used, however they are often put in their own +module along with other relevant types and functions. The classes +often called t, exceptions are called E. + +Implementations live in their own files. There is TBinaryProtocol, +TSocket, TThreadedServer, TSimpleServer, and TServerSocket. + +A note on making the library: Running make should create native, debug +code libraries, and a toplevel. + + +Struct format +------------- +Structs are turned into classes. The fields are all option types and +are initially None. Write is a method, but reading is done by a +separate function (since there is no such thing as a static +class). The class type is t and is in a module with the name of the +struct. + + +enum format +----------- +Enums are put in their own module along with +functions to_i and of_i which convert the ocaml types into ints. For +example: + +enum Numberz +{ + ONE = 1, + TWO, + THREE, + FIVE = 5, + SIX, + EIGHT = 8 +} + +==> + +module Numberz = +struct +type t = +| ONE +| TWO +| THREE +| FIVE +| SIX +| EIGHT + +let of_i = ... +let to_i = ... +end + +typedef format +-------------- +Typedef turns into the type declaration: +typedef i64 UserId + +==> + +type userid Int64.t + +exception format +---------------- +The same as structs except that the module also has an exception type +E of t that is raised/caught. + +For example, with an exception Xception, +raise (Xception.E (new Xception.t)) +and +try + ... +with Xception.E e -> ... + +list format +----------- +Lists are turned into OCaml native lists. + +Map/Set formats +--------------- +These are both turned into Hashtbl.t's. Set values are bool. + +Services +-------- +The client is a class "client" parametrized on input and output +protocols. The processor is a class parametrized on a handler. A +handler is a class inheriting the iface abstract class. Unlike other +implementations, client does not implement iface since iface functions +must take option arguments so as to deal with the case where a client +does not send all the arguments. diff --git a/src/jaegertracing/thrift/lib/ocaml/TODO b/src/jaegertracing/thrift/lib/ocaml/TODO new file mode 100644 index 000000000..4d1dc771b --- /dev/null +++ b/src/jaegertracing/thrift/lib/ocaml/TODO @@ -0,0 +1,5 @@ +Write interfaces +Clean up the code generator +Avoid capture properly instead of relying on the user not to use _ + + diff --git a/src/jaegertracing/thrift/lib/ocaml/_oasis b/src/jaegertracing/thrift/lib/ocaml/_oasis new file mode 100644 index 000000000..83566aaa9 --- /dev/null +++ b/src/jaegertracing/thrift/lib/ocaml/_oasis @@ -0,0 +1,19 @@ +Name: libthrift-ocaml +Version: 0.13.0 +OASISFormat: 0.3 +Synopsis: OCaml bindings for the Apache Thrift RPC system +Authors: Apache Thrift Developers <dev@thrift.apache.org> +License: Apache-2.0 +Homepage: http://thrift.apache.org +BuildTools: ocamlbuild +Plugins: META (0.3), + DevFiles (0.3) + +Library "libthrift-ocaml" + Path: src + FindlibName: thrift + buildTools: ocamlbuild + BuildDepends: threads + Modules: Thrift,TBinaryProtocol,TSocket,TFramedTransport,TChannelTransport,TServer,TSimpleServer,TServerSocket,TThreadedServer + XMETARequires: threads + diff --git a/src/jaegertracing/thrift/lib/ocaml/coding_standards.md b/src/jaegertracing/thrift/lib/ocaml/coding_standards.md new file mode 100644 index 000000000..fa0390bb5 --- /dev/null +++ b/src/jaegertracing/thrift/lib/ocaml/coding_standards.md @@ -0,0 +1 @@ +Please follow [General Coding Standards](/doc/coding_standards.md) diff --git a/src/jaegertracing/thrift/lib/ocaml/descr b/src/jaegertracing/thrift/lib/ocaml/descr new file mode 100644 index 000000000..a41749d5e --- /dev/null +++ b/src/jaegertracing/thrift/lib/ocaml/descr @@ -0,0 +1 @@ +OCaml bindings for the Apache Thrift RPC system diff --git a/src/jaegertracing/thrift/lib/ocaml/opam b/src/jaegertracing/thrift/lib/ocaml/opam new file mode 100644 index 000000000..9dbc3d911 --- /dev/null +++ b/src/jaegertracing/thrift/lib/ocaml/opam @@ -0,0 +1,8 @@ +opam-version: "1" +maintainer: "XXX(FILL ME IN WITH EMAIL)" +build: [ + [make] + [make "install"] +] +remove: [["ocamlfind" "remove" "thrift"]] +depends: ["ocamlfind"] diff --git a/src/jaegertracing/thrift/lib/ocaml/src/Makefile b/src/jaegertracing/thrift/lib/ocaml/src/Makefile new file mode 100644 index 000000000..a97ade5ef --- /dev/null +++ b/src/jaegertracing/thrift/lib/ocaml/src/Makefile @@ -0,0 +1,26 @@ +# +# Licensed to the Apache Software Foundation (ASF) under one +# or more contributor license agreements. See the NOTICE file +# distributed with this work for additional information +# regarding copyright ownership. The ASF licenses this file +# to you under the Apache License, Version 2.0 (the +# "License"); you may not use this file except in compliance +# with the License. You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, +# software distributed under the License is distributed on an +# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +# KIND, either express or implied. See the License for the +# specific language governing permissions and limitations +# under the License. +# + +SOURCES = Thrift.ml TBinaryProtocol.ml TSocket.ml TFramedTransport.ml TChannelTransport.ml TServer.ml TSimpleServer.ml TServerSocket.ml TThreadedServer.ml +RESULT = thrift +LIBS = unix threads +THREADS = yes +all: native-code-library debug-code-library top +OCAMLMAKEFILE = ../OCamlMakefile +include $(OCAMLMAKEFILE) diff --git a/src/jaegertracing/thrift/lib/ocaml/src/TBinaryProtocol.ml b/src/jaegertracing/thrift/lib/ocaml/src/TBinaryProtocol.ml new file mode 100644 index 000000000..6d7500e9c --- /dev/null +++ b/src/jaegertracing/thrift/lib/ocaml/src/TBinaryProtocol.ml @@ -0,0 +1,171 @@ +(* + Licensed to the Apache Software Foundation (ASF) under one + or more contributor license agreements. See the NOTICE file + distributed with this work for additional information + regarding copyright ownership. The ASF licenses this file + to you under the Apache License, Version 2.0 (the + "License"); you may not use this file except in compliance + with the License. You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, + software distributed under the License is distributed on an + "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY + KIND, either express or implied. See the License for the + specific language governing permissions and limitations + under the License. +*) + +open Thrift + +module P = Protocol + +let get_byte i b = 255 land (i lsr (8*b)) +let get_byte32 i b = 255 land (Int32.to_int (Int32.shift_right i (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.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 = 0xffff0000l +let version_1 = 0x80010000l + +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_byte32 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 (Int32.of_int n); + trans#write s 0 n + method writeBinary a = self#writeString a + method writeMessageBegin (n,t,s) = + self#writeI32 (Int32.logor version_1 (Int32.of_int (P.message_type_to_i t))); + self#writeString n; + self#writeI32 (Int32.of_int 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 (P.T_STOP)) + method writeMapBegin (k,v,s) = + self#writeByte (tv k); + self#writeByte (tv v); + self#writeI32 (Int32.of_int s) + method writeMapEnd = () + method writeListBegin (t,s) = + self#writeByte (tv t); + self#writeI32 (Int32.of_int s) + method writeListEnd = () + method writeSetBegin (t,s) = + self#writeByte (tv t); + self#writeI32 (Int32.of_int s) + method writeSetEnd = () + method readByte = + ignore (trans#readAll ibyte 0 1); + Int32.to_int (comp_int ibyte 1) + method readI16 = + ignore (trans#readAll ibyte 0 2); + Int32.to_int (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 = Int32.to_int (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 Int32.compare (Int32.logand ver version_mask) version_1 != 0 then + raise (P.E (P.BAD_VERSION, "Missing version identifier")) + else + let s = self#readString in + let mt = P.message_type_of_i (Int32.to_int (Int32.logand ver 0xFFl)) in + (s,mt, Int32.to_int 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, Int32.to_int self#readI32) + method readMapEnd = () + method readListBegin = + let t = vt (self#readByte) in + (t, Int32.to_int self#readI32) + method readListEnd = () + method readSetBegin = + let t = vt (self#readByte) in + (t, Int32.to_int self#readI32); + method readSetEnd = () +end + +class factory = +object + inherit P.factory + method getProtocol tr = new t tr +end diff --git a/src/jaegertracing/thrift/lib/ocaml/src/TChannelTransport.ml b/src/jaegertracing/thrift/lib/ocaml/src/TChannelTransport.ml new file mode 100644 index 000000000..0f7d616f5 --- /dev/null +++ b/src/jaegertracing/thrift/lib/ocaml/src/TChannelTransport.ml @@ -0,0 +1,39 @@ +(* + Licensed to the Apache Software Foundation (ASF) under one + or more contributor license agreements. See the NOTICE file + distributed with this work for additional information + regarding copyright ownership. The ASF licenses this file + to you under the Apache License, Version 2.0 (the + "License"); you may not use this file except in compliance + with the License. You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, + software distributed under the License is distributed on an + "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY + KIND, either express or implied. See the License for the + specific language governing permissions and limitations + under the License. +*) + +open Thrift +module T = Transport + +class t (i,o) = +object (self) + val mutable opened = true + inherit Transport.t + method isOpen = opened + method opn = () + method close = close_in i; opened <- false + method read buf off len = + if opened then + try + really_input i buf off len; len + with _ -> raise (T.E (T.UNKNOWN, ("TChannelTransport: Could not read "^(string_of_int len)))) + else + raise (T.E (T.NOT_OPEN, "TChannelTransport: Channel was closed")) + method write buf off len = output o buf off len + method flush = flush o +end diff --git a/src/jaegertracing/thrift/lib/ocaml/src/TFramedTransport.ml b/src/jaegertracing/thrift/lib/ocaml/src/TFramedTransport.ml new file mode 100644 index 000000000..1be51e763 --- /dev/null +++ b/src/jaegertracing/thrift/lib/ocaml/src/TFramedTransport.ml @@ -0,0 +1,93 @@ +open Thrift + +module T = Transport + +let c_0xff_32 = Int32.of_string "0xff" + +(* Copied from OCamlnet rtypes.ml *) +let encode_frame_size x = + let s = String.create 4 in + let n3 = Int32.to_int (Int32.shift_right_logical x 24) land 0xff in + let n2 = Int32.to_int (Int32.shift_right_logical x 16) land 0xff in + let n1 = Int32.to_int (Int32.shift_right_logical x 8) land 0xff in + let n0 = Int32.to_int (Int32.logand x c_0xff_32) in + String.unsafe_set s 0 (Char.unsafe_chr n3); + String.unsafe_set s 1 (Char.unsafe_chr n2); + String.unsafe_set s 2 (Char.unsafe_chr n1); + String.unsafe_set s 3 (Char.unsafe_chr n0); + s + +let decode_frame_size s = + let n3 = Int32.of_int (Char.code s.[0]) in + let n2 = Int32.of_int (Char.code s.[1]) in + let n1 = Int32.of_int (Char.code s.[2]) in + let n0 = Int32.of_int (Char.code s.[3]) in + Int32.logor + (Int32.shift_left n3 24) + (Int32.logor + (Int32.shift_left n2 16) + (Int32.logor + (Int32.shift_left n1 8) + n0)) + +class t ?(max_length=Sys.max_string_length) (transport: T.t) = +object (self) + inherit T.t + + method isOpen = transport#isOpen + method opn = transport#opn + method close = transport#close + + val mutable read_buf = None + val mutable read_buf_offset = 0 + val mutable write_buf = "" + + method private read_frame = + let len_buf = String.create 4 in + assert (transport#readAll len_buf 0 4 = 4); + + let size = Int32.to_int (decode_frame_size len_buf) in + + (if size < 0 + then failwith (Printf.sprintf "Read a negative frame size (%i)!" size)); + + (if size > max_length + then failwith (Printf.sprintf "Frame size (%i) larger than max length (%i)!" size max_length)); + + let buf = String.create size in + assert (transport#readAll buf 0 size = size); + read_buf <- Some buf; + read_buf_offset <- 0 + + method private read_from_frame frame buf off len = + let to_copy = min len ((String.length frame) - read_buf_offset) in + String.blit frame read_buf_offset buf off to_copy; + read_buf_offset <- read_buf_offset + to_copy; + to_copy + + method read buf off len = + match read_buf with + | Some frame -> + let i = self#read_from_frame frame buf off len in + if i > 0 + then i + else begin + self#read_frame; + self#read_from_frame frame buf off len + end + | None -> + self#read_frame; + self#read buf off len + + method write buf off len = + write_buf <- write_buf ^ (String.sub buf off len) + + method flush = + let encoded_size = encode_frame_size (Int32.of_int (String.length write_buf)) in + transport#write encoded_size 0 (String.length encoded_size); + transport#write write_buf 0 (String.length write_buf); + transport#flush; + write_buf <- "" +end + + diff --git a/src/jaegertracing/thrift/lib/ocaml/src/TServer.ml b/src/jaegertracing/thrift/lib/ocaml/src/TServer.ml new file mode 100644 index 000000000..fc51efa8f --- /dev/null +++ b/src/jaegertracing/thrift/lib/ocaml/src/TServer.ml @@ -0,0 +1,42 @@ +(* + Licensed to the Apache Software Foundation (ASF) under one + or more contributor license agreements. See the NOTICE file + distributed with this work for additional information + regarding copyright ownership. The ASF licenses this file + to you under the Apache License, Version 2.0 (the + "License"); you may not use this file except in compliance + with the License. You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, + software distributed under the License is distributed on an + "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY + KIND, either express or implied. See the License for the + specific language governing permissions and limitations + under the License. +*) + +open Thrift + +class virtual t + (pf : Processor.t) + (st : Transport.server_t) + (tf : Transport.factory) + (ipf : Protocol.factory) + (opf : Protocol.factory)= +object + method virtual serve : unit +end;; + + + +let run_basic_server proc port = + Unix.establish_server (fun inp -> fun out -> + let trans = new TChannelTransport.t (inp,out) in + let proto = new TBinaryProtocol.t (trans :> Transport.t) in + try + while proc#process proto proto do () done; () + with e -> ()) (Unix.ADDR_INET (Unix.inet_addr_of_string "127.0.0.1",port)) + + diff --git a/src/jaegertracing/thrift/lib/ocaml/src/TServerSocket.ml b/src/jaegertracing/thrift/lib/ocaml/src/TServerSocket.ml new file mode 100644 index 000000000..405ef82c1 --- /dev/null +++ b/src/jaegertracing/thrift/lib/ocaml/src/TServerSocket.ml @@ -0,0 +1,41 @@ +(* + Licensed to the Apache Software Foundation (ASF) under one + or more contributor license agreements. See the NOTICE file + distributed with this work for additional information + regarding copyright ownership. The ASF licenses this file + to you under the Apache License, Version 2.0 (the + "License"); you may not use this file except in compliance + with the License. You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, + software distributed under the License is distributed on an + "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY + KIND, either express or implied. See the License for the + specific language governing permissions and limitations + under the License. +*) + +open Thrift + +class t port = +object + inherit Transport.server_t + val mutable sock = None + method listen = + let s = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in + sock <- Some s; + Unix.bind s (Unix.ADDR_INET (Unix.inet_addr_any, port)); + Unix.listen s 256 + method close = + match sock with + Some s -> Unix.shutdown s Unix.SHUTDOWN_ALL; Unix.close s; + sock <- None + | _ -> () + method acceptImpl = + match sock with + Some s -> let (fd,_) = Unix.accept s in + new TChannelTransport.t (Unix.in_channel_of_descr fd,Unix.out_channel_of_descr fd) + | _ -> raise (Transport.E (Transport.NOT_OPEN,"TServerSocket: Not listening but tried to accept")) +end diff --git a/src/jaegertracing/thrift/lib/ocaml/src/TSimpleServer.ml b/src/jaegertracing/thrift/lib/ocaml/src/TSimpleServer.ml new file mode 100644 index 000000000..2927c08fd --- /dev/null +++ b/src/jaegertracing/thrift/lib/ocaml/src/TSimpleServer.ml @@ -0,0 +1,40 @@ +(* + Licensed to the Apache Software Foundation (ASF) under one + or more contributor license agreements. See the NOTICE file + distributed with this work for additional information + regarding copyright ownership. The ASF licenses this file + to you under the Apache License, Version 2.0 (the + "License"); you may not use this file except in compliance + with the License. You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, + software distributed under the License is distributed on an + "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY + KIND, either express or implied. See the License for the + specific language governing permissions and limitations + under the License. +*) + +open Thrift +module S = TServer + +class t pf st tf ipf opf = +object + inherit S.t pf st tf ipf opf + method serve = + try + st#listen; + while true do + let c = st#accept in + let trans = tf#getTransport c in + let inp = ipf#getProtocol trans in + let op = opf#getProtocol trans in + try + while (pf#process inp op) do () done; + trans#close + with e -> trans#close; raise e + done + with _ -> () +end diff --git a/src/jaegertracing/thrift/lib/ocaml/src/TSocket.ml b/src/jaegertracing/thrift/lib/ocaml/src/TSocket.ml new file mode 100644 index 000000000..109e11c56 --- /dev/null +++ b/src/jaegertracing/thrift/lib/ocaml/src/TSocket.ml @@ -0,0 +1,59 @@ +(* + Licensed to the Apache Software Foundation (ASF) under one + or more contributor license agreements. See the NOTICE file + distributed with this work for additional information + regarding copyright ownership. The ASF licenses this file + to you under the Apache License, Version 2.0 (the + "License"); you may not use this file except in compliance + with the License. You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, + software distributed under the License is distributed on an + "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY + KIND, either express or implied. See the License for the + specific language governing permissions and limitations + under the License. +*) + +open Thrift + +module T = Transport + +class t host port= +object (self) + inherit T.t + val mutable chans = None + method isOpen = chans != None + method opn = + try + let addr = (let {Unix.h_addr_list=x} = Unix.gethostbyname host in x.(0)) in + chans <- Some(Unix.open_connection (Unix.ADDR_INET (addr,port))) + with + Unix.Unix_error (e,fn,_) -> raise (T.E (T.NOT_OPEN, ("TSocket: Could not connect to "^host^":"^(string_of_int port)^" because: "^fn^":"^(Unix.error_message e)))) + | _ -> raise (T.E (T.NOT_OPEN, ("TSocket: Could not connect to "^host^":"^(string_of_int port)))) + + method close = + match chans with + None -> () + | Some(inc,out) -> (Unix.shutdown_connection inc; + close_in inc; + chans <- None) + method read buf off len = match chans with + None -> raise (T.E (T.NOT_OPEN, "TSocket: Socket not open")) + | Some(i,o) -> + try + really_input i buf off len; len + with + Unix.Unix_error (e,fn,_) -> raise (T.E (T.UNKNOWN, ("TSocket: Could not read "^(string_of_int len)^" from "^host^":"^(string_of_int port)^" because: "^fn^":"^(Unix.error_message e)))) + | _ -> raise (T.E (T.UNKNOWN, ("TSocket: Could not read "^(string_of_int len)^" from "^host^":"^(string_of_int port)))) + method write buf off len = match chans with + None -> raise (T.E (T.NOT_OPEN, "TSocket: Socket not open")) + | Some(i,o) -> output o buf off len + method flush = match chans with + None -> raise (T.E (T.NOT_OPEN, "TSocket: Socket not open")) + | Some(i,o) -> flush o +end + + diff --git a/src/jaegertracing/thrift/lib/ocaml/src/TThreadedServer.ml b/src/jaegertracing/thrift/lib/ocaml/src/TThreadedServer.ml new file mode 100644 index 000000000..4462dbd73 --- /dev/null +++ b/src/jaegertracing/thrift/lib/ocaml/src/TThreadedServer.ml @@ -0,0 +1,45 @@ +(* + Licensed to the Apache Software Foundation (ASF) under one + or more contributor license agreements. See the NOTICE file + distributed with this work for additional information + regarding copyright ownership. The ASF licenses this file + to you under the Apache License, Version 2.0 (the + "License"); you may not use this file except in compliance + with the License. You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, + software distributed under the License is distributed on an + "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY + KIND, either express or implied. See the License for the + specific language governing permissions and limitations + under the License. +*) + +open Thrift + +class t + (pf : Processor.t) + (st : Transport.server_t) + (tf : Transport.factory) + (ipf : Protocol.factory) + (opf : Protocol.factory)= +object + inherit TServer.t pf st tf ipf opf + method serve = + st#listen; + while true do + let tr = tf#getTransport (st#accept) in + ignore (Thread.create + (fun _ -> + let ip = ipf#getProtocol tr in + let op = opf#getProtocol tr in + try + while pf#process ip op do + () + done + with _ -> ()) ()) + done +end + diff --git a/src/jaegertracing/thrift/lib/ocaml/src/Thrift.ml b/src/jaegertracing/thrift/lib/ocaml/src/Thrift.ml new file mode 100644 index 000000000..063459ba0 --- /dev/null +++ b/src/jaegertracing/thrift/lib/ocaml/src/Thrift.ml @@ -0,0 +1,382 @@ +(* + Licensed to the Apache Software Foundation (ASF) under one + or more contributor license agreements. See the NOTICE file + distributed with this work for additional information + regarding copyright ownership. The ASF licenses this file + to you under the Apache License, Version 2.0 (the + "License"); you may not use this file except in compliance + with the License. You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, + software distributed under the License is distributed on an + "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY + KIND, either express or implied. See the License for the + specific language governing permissions and limitations + under the License. +*) + +exception Break;; +exception Thrift_error;; +exception Field_empty of string;; + +class t_exn = +object + val mutable message = "" + method get_message = message + method set_message s = message <- s +end;; + +module Transport = +struct + type exn_type = + | UNKNOWN + | NOT_OPEN + | ALREADY_OPEN + | TIMED_OUT + | END_OF_FILE;; + + exception E of exn_type * string + + class virtual t = + object (self) + method virtual isOpen : bool + method virtual opn : unit + method virtual close : unit + method virtual read : string -> int -> int -> int + method readAll buf off len = + let got = ref 0 in + let ret = ref 0 in + while !got < len do + ret := self#read buf (off+(!got)) (len - (!got)); + if !ret <= 0 then + raise (E (UNKNOWN, "Cannot read. Remote side has closed.")); + got := !got + !ret + done; + !got + method virtual write : string -> int -> int -> unit + method virtual flush : unit + end + + class factory = + object + method getTransport (t : t) = t + end + + class virtual server_t = + object (self) + method virtual listen : unit + method accept = self#acceptImpl + method virtual close : unit + method virtual acceptImpl : t + end + +end;; + + + +module Protocol = +struct + type t_type = + | T_STOP + | T_VOID + | T_BOOL + | T_BYTE + | T_I08 + | T_I16 + | T_I32 + | T_U64 + | T_I64 + | T_DOUBLE + | T_STRING + | T_UTF7 + | T_STRUCT + | T_MAP + | T_SET + | T_LIST + | T_UTF8 + | T_UTF16 + + let t_type_to_i = function + T_STOP -> 0 + | T_VOID -> 1 + | T_BOOL -> 2 + | T_BYTE -> 3 + | T_I08 -> 3 + | T_I16 -> 6 + | T_I32 -> 8 + | T_U64 -> 9 + | T_I64 -> 10 + | T_DOUBLE -> 4 + | T_STRING -> 11 + | T_UTF7 -> 11 + | T_STRUCT -> 12 + | T_MAP -> 13 + | T_SET -> 14 + | T_LIST -> 15 + | T_UTF8 -> 16 + | T_UTF16 -> 17 + + let t_type_of_i = function + 0 -> T_STOP + | 1 -> T_VOID + | 2 -> T_BOOL + | 3 -> T_BYTE + | 6-> T_I16 + | 8 -> T_I32 + | 9 -> T_U64 + | 10 -> T_I64 + | 4 -> T_DOUBLE + | 11 -> T_STRING + | 12 -> T_STRUCT + | 13 -> T_MAP + | 14 -> T_SET + | 15 -> T_LIST + | 16 -> T_UTF8 + | 17 -> T_UTF16 + | _ -> raise Thrift_error + + type message_type = + | CALL + | REPLY + | EXCEPTION + | ONEWAY + + let message_type_to_i = function + | CALL -> 1 + | REPLY -> 2 + | EXCEPTION -> 3 + | ONEWAY -> 4 + + let message_type_of_i = function + | 1 -> CALL + | 2 -> REPLY + | 3 -> EXCEPTION + | 4 -> ONEWAY + | _ -> raise Thrift_error + + class virtual t (trans: Transport.t) = + object (self) + val mutable trans_ = trans + method getTransport = trans_ + (* writing methods *) + method virtual writeMessageBegin : string * message_type * int -> unit + method virtual writeMessageEnd : unit + method virtual writeStructBegin : string -> unit + method virtual writeStructEnd : unit + method virtual writeFieldBegin : string * t_type * int -> unit + method virtual writeFieldEnd : unit + method virtual writeFieldStop : unit + method virtual writeMapBegin : t_type * t_type * int -> unit + method virtual writeMapEnd : unit + method virtual writeListBegin : t_type * int -> unit + method virtual writeListEnd : unit + method virtual writeSetBegin : t_type * int -> unit + method virtual writeSetEnd : unit + method virtual writeBool : bool -> unit + method virtual writeByte : int -> unit + method virtual writeI16 : int -> unit + method virtual writeI32 : Int32.t -> unit + method virtual writeI64 : Int64.t -> unit + method virtual writeDouble : float -> unit + method virtual writeString : string -> unit + method virtual writeBinary : string -> unit + (* reading methods *) + method virtual readMessageBegin : string * message_type * int + method virtual readMessageEnd : unit + method virtual readStructBegin : string + method virtual readStructEnd : unit + method virtual readFieldBegin : string * t_type * int + method virtual readFieldEnd : unit + method virtual readMapBegin : t_type * t_type * int + method virtual readMapEnd : unit + method virtual readListBegin : t_type * int + method virtual readListEnd : unit + method virtual readSetBegin : t_type * int + method virtual readSetEnd : unit + method virtual readBool : bool + method virtual readByte : int + method virtual readI16 : int + method virtual readI32: Int32.t + method virtual readI64 : Int64.t + method virtual readDouble : float + method virtual readString : string + method virtual readBinary : string + (* skippage *) + method skip typ = + match typ with + | T_BOOL -> ignore self#readBool + | T_BYTE + | T_I08 -> ignore self#readByte + | T_I16 -> ignore self#readI16 + | T_I32 -> ignore self#readI32 + | T_U64 + | T_I64 -> ignore self#readI64 + | T_DOUBLE -> ignore self#readDouble + | T_STRING -> ignore self#readString + | T_UTF7 -> () + | T_STRUCT -> ignore ((ignore self#readStructBegin); + (try + while true do + let (_,t,_) = self#readFieldBegin in + if t = T_STOP then + raise Break + else + (self#skip t; + self#readFieldEnd) + done + with Break -> ()); + self#readStructEnd) + | T_MAP -> ignore (let (k,v,s) = self#readMapBegin in + for i=0 to s do + self#skip k; + self#skip v; + done; + self#readMapEnd) + | T_SET -> ignore (let (t,s) = self#readSetBegin in + for i=0 to s do + self#skip t + done; + self#readSetEnd) + | T_LIST -> ignore (let (t,s) = self#readListBegin in + for i=0 to s do + self#skip t + done; + self#readListEnd) + | T_UTF8 -> () + | T_UTF16 -> () + | _ -> raise (Protocol.E (Protocol.INVALID_DATA, "Invalid data")) + end + + class virtual factory = + object + method virtual getProtocol : Transport.t -> t + end + + type exn_type = + | UNKNOWN + | INVALID_DATA + | NEGATIVE_SIZE + | SIZE_LIMIT + | BAD_VERSION + | NOT_IMPLEMENTED + | DEPTH_LIMIT + + exception E of exn_type * string;; + +end;; + + +module Processor = +struct + class virtual t = + object + method virtual process : Protocol.t -> Protocol.t -> bool + end;; + + class factory (processor : t) = + object + val processor_ = processor + method getProcessor (trans : Transport.t) = processor_ + end;; +end + + +(* Ugly *) +module Application_Exn = +struct + type typ= + | UNKNOWN + | UNKNOWN_METHOD + | INVALID_MESSAGE_TYPE + | WRONG_METHOD_NAME + | BAD_SEQUENCE_ID + | MISSING_RESULT + | INTERNAL_ERROR + | PROTOCOL_ERROR + | INVALID_TRANSFORM + | INVALID_PROTOCOL + | UNSUPPORTED_CLIENT_TYPE + + let typ_of_i = function + 0l -> UNKNOWN + | 1l -> UNKNOWN_METHOD + | 2l -> INVALID_MESSAGE_TYPE + | 3l -> WRONG_METHOD_NAME + | 4l -> BAD_SEQUENCE_ID + | 5l -> MISSING_RESULT + | 6l -> INTERNAL_ERROR + | 7l -> PROTOCOL_ERROR + | 8l -> INVALID_TRANSFORM + | 9l -> INVALID_PROTOCOL + | 10l -> UNSUPPORTED_CLIENT_TYPE + | _ -> raise Thrift_error;; + let typ_to_i = function + | UNKNOWN -> 0l + | UNKNOWN_METHOD -> 1l + | INVALID_MESSAGE_TYPE -> 2l + | WRONG_METHOD_NAME -> 3l + | BAD_SEQUENCE_ID -> 4l + | MISSING_RESULT -> 5l + | INTERNAL_ERROR -> 6l + | PROTOCOL_ERROR -> 7l + | INVALID_TRANSFORM -> 8l + | INVALID_PROTOCOL -> 9l + | UNSUPPORTED_CLIENT_TYPE -> 10l + + class t = + object (self) + inherit t_exn + val mutable typ = UNKNOWN + method get_type = typ + method set_type t = typ <- t + method write (oprot : Protocol.t) = + oprot#writeStructBegin "TApplicationExeception"; + if self#get_message != "" then + (oprot#writeFieldBegin ("message",Protocol.T_STRING, 1); + oprot#writeString self#get_message; + oprot#writeFieldEnd) + else (); + oprot#writeFieldBegin ("type",Protocol.T_I32,2); + oprot#writeI32 (typ_to_i typ); + oprot#writeFieldEnd; + oprot#writeFieldStop; + oprot#writeStructEnd + end;; + + let create typ msg = + let e = new t in + e#set_type typ; + e#set_message msg; + e + + let read (iprot : Protocol.t) = + let msg = ref "" in + let typ = ref 0l in + ignore iprot#readStructBegin; + (try + while true do + let (name,ft,id) =iprot#readFieldBegin in + if ft = Protocol.T_STOP + then raise Break + else (); + (match id with + | 1 -> (if ft = Protocol.T_STRING + then msg := (iprot#readString) + else iprot#skip ft) + | 2 -> (if ft = Protocol.T_I32 + then typ := iprot#readI32 + else iprot#skip ft) + | _ -> iprot#skip ft); + iprot#readFieldEnd + done + with Break -> ()); + iprot#readStructEnd; + let e = new t in + e#set_type (typ_of_i !typ); + e#set_message !msg; + e;; + + exception E of t +end;; diff --git a/src/jaegertracing/thrift/lib/ocaml/url b/src/jaegertracing/thrift/lib/ocaml/url new file mode 100644 index 000000000..fe4d604e8 --- /dev/null +++ b/src/jaegertracing/thrift/lib/ocaml/url @@ -0,0 +1,2 @@ +archive: "XXX(FILL ME IN WITH URL)" +checksum: "XXX(FILL ME IN WITH MD5)" |