summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lib/hs/src/TServer.hs14
-rw-r--r--lib/ocaml/src/Makefile5
-rw-r--r--lib/ocaml/src/TServer.ml12
-rw-r--r--lib/ocaml/src/TServerSocket.ml21
-rw-r--r--lib/ocaml/src/TSimpleServer.ml21
-rw-r--r--lib/ocaml/src/TThreadedServer.ml26
-rw-r--r--test/ocaml/client/Makefile2
-rw-r--r--test/ocaml/server/Makefile5
-rw-r--r--test/ocaml/server/TestServer.ml10
9 files changed, 81 insertions, 35 deletions
diff --git a/lib/hs/src/TServer.hs b/lib/hs/src/TServer.hs
index c71882c97..83a6ee3f7 100644
--- a/lib/hs/src/TServer.hs
+++ b/lib/hs/src/TServer.hs
@@ -11,19 +11,19 @@ proc_loop hand proc ps = do v <-proc hand ps
if v then proc_loop hand proc ps
else return ()
-accept_loop hand sock proc transgen iprotgen oprotgen =
- do (h,hn,_) <- accept sock
+accept_loop accepter hand sock proc transgen iprotgen oprotgen =
+ do (h,hn,_) <- accepter sock
let t = transgen h
let ip = iprotgen t
let op = oprotgen t
forkIO (handle (\e -> return ()) (proc_loop hand proc (ip,op)))
- accept_loop hand sock proc transgen iprotgen oprotgen
+ accept_loop accepter hand sock proc transgen iprotgen oprotgen
-run_threaded_server hand proc port transgen iprotgen oprotgen =
- do sock <- listenOn (PortNumber port)
- accept_loop hand sock proc transgen iprotgen oprotgen
+run_threaded_server accepter listener hand proc port transgen iprotgen oprotgen =
+ do sock <- listener
+ accept_loop accepter hand sock proc transgen iprotgen oprotgen
return ()
-- A basic threaded binary protocol socket server.
-run_basic_server hand proc port = run_threaded_server hand proc port TChannelTrans TBinaryProtocol TBinaryProtocol
+run_basic_server hand proc port = run_threaded_server accept (listenOn (PortNumber port)) hand proc port TChannelTrans TBinaryProtocol TBinaryProtocol
diff --git a/lib/ocaml/src/Makefile b/lib/ocaml/src/Makefile
index 0b989ce28..723402b11 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 d8509ff4a..a4dcc4428 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 000000000..ac98b087b
--- /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 1a85809b0..db3ac3bcb 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 000000000..10f161411
--- /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
+
diff --git a/test/ocaml/client/Makefile b/test/ocaml/client/Makefile
index 67757b9cf..ce284eaf3 100644
--- a/test/ocaml/client/Makefile
+++ b/test/ocaml/client/Makefile
@@ -1,6 +1,6 @@
SOURCES = ../gen-ocaml/ThriftTest_types.ml ../gen-ocaml/ThriftTest_consts.ml ../gen-ocaml/SecondService.ml ../gen-ocaml/ThriftTest.ml TestClient.ml
RESULT = tc
-INCDIRS = "/home/iproctor/code/projects/thrift/trunk/lib/ocaml/src/" "../gen-ocaml/"
+INCDIRS = "../../../lib/ocaml/src/" "../gen-ocaml/"
LIBS = unix thrift
all: nc
OCAMLMAKEFILE = ../../../lib/ocaml/OCamlMakefile
diff --git a/test/ocaml/server/Makefile b/test/ocaml/server/Makefile
index 839292d1a..88a618ac2 100644
--- a/test/ocaml/server/Makefile
+++ b/test/ocaml/server/Makefile
@@ -1,7 +1,8 @@
SOURCES = ../gen-ocaml/ThriftTest_types.ml ../gen-ocaml/ThriftTest_consts.ml ../gen-ocaml/SecondService.ml ../gen-ocaml/ThriftTest.ml TestServer.ml
RESULT = ts
-INCDIRS = "/home/iproctor/code/projects/thrift/trunk/lib/ocaml/src/" "../gen-ocaml/"
-LIBS = unix thrift
+INCDIRS = "../../../lib/ocaml/src/" "../gen-ocaml/"
+LIBS = thrift
+THREADS = yes
all: nc
OCAMLMAKEFILE = ../../../lib/ocaml/OCamlMakefile
include $(OCAMLMAKEFILE)
diff --git a/test/ocaml/server/TestServer.ml b/test/ocaml/server/TestServer.ml
index 378903539..afcd7895b 100644
--- a/test/ocaml/server/TestServer.ml
+++ b/test/ocaml/server/TestServer.ml
@@ -102,6 +102,14 @@ end;;
let h = new test_handler in
let proc = new ThriftTest.processor h in
let port = 9090 in
- TServer.run_basic_server proc port;;
+let pf = new TBinaryProtocol.factory in
+let server = new TThreadedServer.t
+ proc
+ (new TServerSocket.t port)
+ (new Transport.factory)
+ pf
+ pf
+in
+ server#serve
View Lorry Controller Status