Thrift: OCaml and HS servers more general
Summary: The library now provides servers that are general like the other languages.
Reviewed by: mcslee
Test plan: Yes
Revert plan: yes
git-svn-id: https://svn.apache.org/repos/asf/incubator/thrift/trunk@665195 13f79535-47bb-0310-9956-ffa450edef68
diff --git a/lib/ocaml/src/Makefile b/lib/ocaml/src/Makefile
index 0b989ce..723402b 100644
--- a/lib/ocaml/src/Makefile
+++ b/lib/ocaml/src/Makefile
@@ -1,6 +1,7 @@
-SOURCES = Thrift.ml TBinaryProtocol.ml TSocket.ml TChannelTransport.ml TServer.ml TSimpleServer.ml
+SOURCES = Thrift.ml TBinaryProtocol.ml TSocket.ml TChannelTransport.ml TServer.ml TSimpleServer.ml TServerSocket.ml TThreadedServer.ml
RESULT = thrift
-LIBS = unix
+LIBS = unix threads
+THREADS = yes
all: native-code-library byte-code-library top
OCAMLMAKEFILE = ../OCamlMakefile
include $(OCAMLMAKEFILE)
diff --git a/lib/ocaml/src/TServer.ml b/lib/ocaml/src/TServer.ml
index d8509ff..a4dcc44 100644
--- a/lib/ocaml/src/TServer.ml
+++ b/lib/ocaml/src/TServer.ml
@@ -1,23 +1,17 @@
open Thrift
class virtual t
- (pf : Processor.factory)
+ (pf : Processor.t)
(st : Transport.server_t)
- (itf : Transport.factory)
- (otf : Transport.factory)
+ (tf : Transport.factory)
(ipf : Protocol.factory)
(opf : Protocol.factory)=
object
- val processorFactory = pf
- val serverTransport = st
- val inputTransportFactory = itf
- val outputTransportFactory = otf
- val inputProtocolFactory = ipf
- val outputProtocolFactory = opf
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
diff --git a/lib/ocaml/src/TServerSocket.ml b/lib/ocaml/src/TServerSocket.ml
new file mode 100644
index 0000000..ac98b08
--- /dev/null
+++ b/lib/ocaml/src/TServerSocket.ml
@@ -0,0 +1,21 @@
+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)
+ | _ -> Transport.raise_TTransportExn "ServerSocket: Not listening but tried to accept" Transport.NOT_OPEN
+end
diff --git a/lib/ocaml/src/TSimpleServer.ml b/lib/ocaml/src/TSimpleServer.ml
index 1a85809..db3ac3b 100644
--- a/lib/ocaml/src/TSimpleServer.ml
+++ b/lib/ocaml/src/TSimpleServer.ml
@@ -1,24 +1,19 @@
open Thrift
module S = TServer
-class t pf st itf otf ipf opf =
+class t pf st tf ipf opf =
object
- inherit S.t pf st itf otf ipf opf
+ inherit S.t pf st tf ipf opf
method serve =
try
st#listen;
let c = st#accept in
- let proc = pf#getProcessor c in
- let itrans = itf#getTransport c in
- let otrans = try
- otf#getTransport c
- with e -> itrans#close; raise e
- in
- let inp = ipf#getProtocol itrans in
- let op = opf#getProtocol otrans in
+ let trans = tf#getTransport c in
+ let inp = ipf#getProtocol trans in
+ let op = opf#getProtocol trans in
try
- while (proc#process inp op) do () done;
- itrans#close; otrans#close
- with e -> itrans#close; otrans#close; raise e
+ while (pf#process inp op) do () done;
+ trans#close
+ with e -> trans#close; raise e
with _ -> ()
end
diff --git a/lib/ocaml/src/TThreadedServer.ml b/lib/ocaml/src/TThreadedServer.ml
new file mode 100644
index 0000000..10f1614
--- /dev/null
+++ b/lib/ocaml/src/TThreadedServer.ml
@@ -0,0 +1,26 @@
+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
+