[MLton-commit] r6939
Vesa Karvonen
vesak at mlton.org
Wed Oct 15 04:05:01 PDT 2008
Changed to support running multiple TCP listeners in a single server
process. Added initial support for setting various TCP server options and
event notifications, but still needs tuning.
Changed the signature to make room for having other than TCP listeners,
----------------------------------------------------------------------
U mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/detail/client.sml
U mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/detail/protocol.sml
U mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/detail/server.sml
U mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/client.sml
U mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/server.sml
U mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/lib-client.mlb
U mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/lib-client.use
U mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/lib-server.mlb
U mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/lib-server.use
U mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/public/client/client.sig
U mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/public/client/export.sml
A mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/public/protocol.sig
U mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/public/server/export.sml
U mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/public/server/server.sig
----------------------------------------------------------------------
Modified: mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/detail/client.sml
===================================================================
--- mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/detail/client.sml 2008-10-15 06:45:21 UTC (rev 6938)
+++ mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/detail/client.sml 2008-10-15 11:04:48 UTC (rev 6939)
@@ -113,7 +113,7 @@
end
fun declare (signature' as (dom, cod, _)) = let
- val fingerprint = Fingerprint.make signature'
+ val fingerprint = Fingerprint.fromSignature signature'
val sendDom = send dom
val recvCod = recv cod
in
Modified: mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/detail/protocol.sml
===================================================================
--- mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/detail/protocol.sml 2008-10-15 06:45:21 UTC (rev 6938)
+++ mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/detail/protocol.sml 2008-10-15 11:04:48 UTC (rev 6939)
@@ -9,11 +9,16 @@
val recv : 'a Rep.t -> ('a, Socket.active) SocketEvents.monad
val send : 'a Rep.t -> 'a -> (Unit.t, Socket.active) SocketEvents.monad
+ structure Signature : sig
+ type ('d, 'c) t = 'd Rep.t * 'c Rep.t * String.t
+ end
+
structure Fingerprint : sig
eqtype t
val t : t Rep.t
+ val toString : t -> String.t
val toWord32 : t -> Word32.t
- val make : 'd Rep.t * 'c Rep.t * String.t -> t
+ val fromSignature : ('d, 'c) Signature.t -> t
end
structure Token : sig
@@ -45,6 +50,7 @@
structure Version : sig
eqtype t
val current : t
+ val toString : t -> String.t
val recv : (t, Socket.active) SocketEvents.monad
val send : t -> (Unit.t, Socket.active) SocketEvents.monad
end
@@ -90,10 +96,14 @@
; buffer)) >>= (fn () =>
SocketEvents.sendVec (Word8VectorSlice.full data))
+ structure Signature = struct
+ type ('d, 'c) t = 'd Rep.t * 'c Rep.t * String.t
+ end
+
structure Fingerprint = struct
open Word32
val toWord32 = id
- fun make (dom, cod, name) =
+ fun fromSignature (dom, cod, name) =
Generic.typeHash dom +
Generic.typeHash cod * 0w71 +
Generic.hash String.t name
Modified: mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/detail/server.sml
===================================================================
--- mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/detail/server.sml 2008-10-15 06:45:21 UTC (rev 6938)
+++ mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/detail/server.sml 2008-10-15 11:04:48 UTC (rev 6939)
@@ -7,93 +7,220 @@
structure Server :> SERVER = struct
open SocketEvents Async Protocol
- val entries : (Fingerprint.t,
- Token.t -> (Unit.t, Socket.active) monad) HashMap.t =
- HashMap.new {eq = op =, hash = Word32.toWord o Fingerprint.toWord32}
+ structure ProcMap = struct
+ type t = (Fingerprint.t,
+ Token.t -> (Unit.t, Socket.active) monad) HashMap.t
- val sendExn = send Exn.t
+ fun new () =
+ HashMap.new
+ {eq = (op =),
+ hash = Word32.toWord o Fingerprint.toWord32}
- fun define (signature' as (dom, cod, name)) = let
- val fingerprint = Fingerprint.make signature'
- val recvDom = recv dom
- val sendCod = send cod
- open Reply
- in
- fn f =>
- case HashMap.find entries fingerprint
- of SOME _ => fails ["fingerprint of ", name, " already in use"]
- | NONE =>
- (HashMap.insert entries)
- (fingerprint,
- fn token =>
- recvDom >>= (fn x =>
- try (fn () => f x,
- fn y =>
- send (RESULT token) >>= (fn () =>
- sendCod y),
- fn e =>
- send (EXN token) >>= (fn () =>
- sendExn e))))
+ val sendExn = send Exn.t
+
+ fun add entries (signature' as (dom, cod, name)) = let
+ val fingerprint = Fingerprint.fromSignature signature'
+ val recvDom = recv dom
+ val sendCod = send cod
+ open Reply
+ in
+ fn f =>
+ case HashMap.find entries fingerprint
+ of SOME _ => fails ["fingerprint of ", name, " already in use"]
+ | NONE =>
+ (HashMap.insert entries)
+ (fingerprint,
+ fn token =>
+ recvDom >>= (fn x =>
+ try (fn () => f x,
+ fn y =>
+ send (RESULT token) >>= (fn () =>
+ sendCod y),
+ fn e =>
+ send (EXN token) >>= (fn () =>
+ sendExn e))))
+ end
end
- fun serve () =
- Request.recv >>= (fn req =>
- case req
- of Request.CALL {token, fingerprint} =>
- case HashMap.find entries fingerprint
- of NONE =>
- skip >>= (fn () =>
- Reply.send (Reply.UNKNOWN token) >>=
- serve)
- | SOME procedure =>
- procedure token >>= serve)
+ structure TCP = struct
+ structure Opts = struct
+ datatype t = IN
+ of {name : String.t
+ , port : Int.t
+ , maxAccepts : Int.t Option.t
+ , tcpNoDelay : Bool.t
+ , serverError : Exn.t Effect.t
+ , closed : Unit.t Effect.t
+ , accept : {addr : INetSock.sock_addr} UnPr.t
+ , unknownProtocol :
+ {addr : INetSock.sock_addr,
+ version : Protocol.Version.t} Effect.t
+ , connected :
+ {addr : INetSock.sock_addr,
+ version : Protocol.Version.t} Effect.t
+ , unknownProc :
+ {addr : INetSock.sock_addr,
+ fingerprint : Protocol.Fingerprint.t} Effect.t
+ , protocolError :
+ {addr : INetSock.sock_addr,
+ error : Exn.t} Effect.t
+ , disconnected : {addr : INetSock.sock_addr} Effect.t}
- fun run {port, accept=filter} = let
- fun negotiate addr =
- if not (filter addr)
- then error (Fail "addr")
- else Version.recv >>= (fn version' =>
- if version' <> Version.current
- then error (Fail "version")
- else Version.send version' >>= serve)
+ datatype 'a opt = OPT of {get : t -> 'a, set : 'a -> t UnOp.t}
- fun accept ? =
- (SocketEvents.sockEvt OS.IO.pollIn >>= (fn socket =>
- case Socket.acceptNB socket
- of NONE => error (Fail "NONE")
- | SOME (socket, addr) =>
- (INetSock.TCP.setNODELAY (socket, true)
- ; (when (negotiate addr socket))
- (fn r =>
- (Socket.close socket
- ; case r
- of INR () => ()
- | INL e =>
- case e
- of Closed => ()
- | e =>
- printlns
- ("unhandled exception: " ::
- Exn.message e ::
- List.intersperse
- "\n"
- (Exn.history e))))
- ; accept))) ?
+ val default : t =
+ IN {name = "127.0.0.1"
+ , port = 45678
+ , maxAccepts = NONE
+ , tcpNoDelay = true
+ , serverError = ignore
+ , closed = ignore
+ , accept = const true
+ , unknownProtocol = ignore
+ , connected = ignore
+ , unknownProc = ignore
+ , protocolError = ignore
+ , disconnected = ignore}
- val socket = INetSock.TCP.socket ()
- in
- (Socket.bind
- (socket,
- INetSock.toAddr
- (valOf (NetHostDB.fromString "127.0.0.1"), port))
- ; Socket.listen (socket, 16))
- handle e => (Socket.close socket ; raise e)
- ; (when (accept socket))
- (fn r =>
- (Socket.close socket
- ; case r
- of INL e => println (Exn.message e)
- | INR () => ()))
- ; PollLoop.run Handler.runAll
+ fun mk get set =
+ OPT {set = fn value =>
+ fn IN {name
+ , port
+ , maxAccepts
+ , tcpNoDelay
+ , serverError
+ , closed
+ , accept
+ , unknownProtocol
+ , connected
+ , unknownProc
+ , protocolError
+ , disconnected} => let
+ val opts =
+ {name = ref name
+ , port = ref port
+ , maxAccepts = ref maxAccepts
+ , tcpNoDelay = ref tcpNoDelay
+ , serverError = ref serverError
+ , closed = ref closed
+ , accept = ref accept
+ , unknownProtocol = ref unknownProtocol
+ , connected = ref connected
+ , unknownProc = ref unknownProc
+ , protocolError = ref protocolError
+ , disconnected = ref disconnected}
+ fun get field = !(field opts)
+ in
+ set opts := value
+ ; IN {name = get #name
+ , port = get #port
+ , maxAccepts = get #maxAccepts
+ , tcpNoDelay = get #tcpNoDelay
+ , serverError = get #serverError
+ , closed = get #closed
+ , accept = get #accept
+ , unknownProtocol = get #unknownProtocol
+ , connected = get #connected
+ , unknownProc = get #unknownProc
+ , protocolError = get #protocolError
+ , disconnected = get #disconnected}
+ end,
+ get = fn IN r => get r}
+
+ val name = mk #name #name
+ val port = mk #port #port
+ val maxAccepts = mk #maxAccepts #maxAccepts
+ val tcpNoDelay = mk #tcpNoDelay #tcpNoDelay
+ val serverError = mk #serverError #serverError
+ val closed = mk #closed #closed
+ val accept = mk #accept #accept
+ val unknownProtocol = mk #unknownProtocol #unknownProtocol
+ val connected = mk #connected #connected
+ val unknownProc = mk #unknownProc #unknownProc
+ val protocolError = mk #protocolError #protocolError
+ val disconnected = mk #disconnected #disconnected
+
+ fun opts & (OPT {set, ...}, value) = set value opts
+ val op := = id
+ end
+
+ fun start entries
+ (Opts.IN {name
+ , port
+ , maxAccepts
+ , tcpNoDelay
+ , serverError
+ , closed
+ , accept
+ , unknownProtocol
+ , connected
+ , unknownProc
+ , protocolError
+ , disconnected}) = let
+ fun serve addr =
+ Request.recv >>= (fn req =>
+ case req
+ of Request.CALL {token, fingerprint} =>
+ case HashMap.find entries fingerprint
+ of NONE =>
+ (unknownProc {addr = addr, fingerprint = fingerprint}
+ ; skip >>= (fn () =>
+ Reply.send (Reply.UNKNOWN token) >>= (fn () =>
+ serve addr)))
+ | SOME procedure =>
+ procedure token >>= (fn () =>
+ serve addr))
+
+ fun negotiate addr =
+ Version.recv >>= (fn version' =>
+ if version' <> Version.current
+ then (unknownProtocol {addr = addr, version = version'}
+ ; return ())
+ else (connected {addr = addr, version = version'}
+ ; Version.send version' >>= (fn () =>
+ serve addr)))
+
+ fun listen maxAccepts =
+ if SOME 0 = maxAccepts
+ then return ()
+ else SocketEvents.sockEvt OS.IO.pollIn >>= (fn socket =>
+ case Socket.acceptNB socket
+ of NONE => error (Fail "acceptNB returned NONE")
+ | SOME (socket, addr) =>
+ (if not (accept {addr = addr})
+ then (Socket.close socket
+ ; listen maxAccepts)
+ else (INetSock.TCP.setNODELAY (socket, tcpNoDelay)
+ ; (when (negotiate addr socket))
+ (fn r =>
+ (Socket.close socket
+ ; case r
+ of INR () => ()
+ | INL Closed => ()
+ | INL e =>
+ protocolError {addr = addr, error = e}
+ ; disconnected {addr = addr}))
+ ; listen (Option.map (fn n => n-1) maxAccepts))))
+
+ val socket = INetSock.TCP.socket ()
+ in
+ (Socket.bind
+ (socket,
+ INetSock.toAddr
+ (NetHostDB.addr
+ (valOf (NetHostDB.getByName name)),
+ port))
+ ; Socket.listen (socket, 16))
+ handle e => (Socket.close socket ; raise e)
+ ; (when (listen maxAccepts socket))
+ (fn r =>
+ (Socket.close socket
+ ; case r
+ of INL e => serverError e
+ | INR () => ()
+ ; closed ()))
+ end
end
+
+ fun run () = PollLoop.run Handler.runAll
end
Modified: mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/client.sml
===================================================================
--- mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/client.sml 2008-10-15 06:45:21 UTC (rev 6938)
+++ mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/client.sml 2008-10-15 11:04:48 UTC (rev 6939)
@@ -4,7 +4,7 @@
* See the LICENSE file or http://mlton.org/License for details.
*)
-val conn = Client.Conn.byName {host = "127.0.0.1", port = 4321}
+val conn = Client.Conn.byName {host = "127.0.0.1", port = 45678}
local
fun mk signature' conn =
Modified: mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/server.sml
===================================================================
--- mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/server.sml 2008-10-15 06:45:21 UTC (rev 6938)
+++ mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/example/server.sml 2008-10-15 11:04:48 UTC (rev 6939)
@@ -12,10 +12,19 @@
fun bindings () = !assoc
end
-val () = Server.define (Pair.t (String.t, Int.t), Unit.t, "bind") bind
-val () = Server.define (String.t, Option.t Int.t, "find") find
-val () = Server.define
- (Unit.t, List.t (Pair.t (String.t, Int.t)), "bindings")
- bindings
-
-val () = Server.run {port = 4321, accept = const true}
+val () = let
+ open Server
+ val procMap = ProcMap.new ()
+ fun add ? = ProcMap.add procMap ?
+in
+ add (Pair.t (String.t, Int.t), Unit.t, "bind") bind
+ ; add (String.t, Option.t Int.t, "find") find
+ ; add (Unit.t, List.t (Pair.t (String.t, Int.t)), "bindings") bindings
+ ; TCP.start procMap let
+ open TCP.Opts
+ in
+ default
+ & maxAccepts := SOME 1
+ end
+ ; run ()
+end
Modified: mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/lib-client.mlb
===================================================================
--- mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/lib-client.mlb 2008-10-15 06:45:21 UTC (rev 6938)
+++ mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/lib-client.mlb 2008-10-15 11:04:48 UTC (rev 6939)
@@ -20,6 +20,8 @@
"warnUnused true"
in
local
+ public/protocol.sig
+
public/client/client.sig
detail/client.sml
in
Modified: mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/lib-client.use
===================================================================
--- mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/lib-client.use 2008-10-15 06:45:21 UTC (rev 6938)
+++ mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/lib-client.use 2008-10-15 11:04:48 UTC (rev 6939)
@@ -10,6 +10,7 @@
"${MLTON_LIB}/com/ssh/async/unstable/example/poll-loop/lib.use",
"${APPLICATION}/generic.use",
"detail/protocol.use",
+ "public/protocol.sig",
"public/client/client.sig",
"detail/client.sml",
"public/client/export.sml"] ;
Modified: mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/lib-server.mlb
===================================================================
--- mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/lib-server.mlb 2008-10-15 06:45:21 UTC (rev 6938)
+++ mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/lib-server.mlb 2008-10-15 11:04:48 UTC (rev 6939)
@@ -21,6 +21,8 @@
"warnUnused true"
in
local
+ public/protocol.sig
+
public/server/server.sig
detail/server.sml
in
Modified: mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/lib-server.use
===================================================================
--- mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/lib-server.use 2008-10-15 06:45:21 UTC (rev 6938)
+++ mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/lib-server.use 2008-10-15 11:04:48 UTC (rev 6939)
@@ -11,6 +11,7 @@
"${MLTON_LIB}/org/mlton/vesak/ds/unstable/lib.use",
"${APPLICATION}/generic.use",
"detail/protocol.use",
+ "public/protocol.sig",
"public/server/server.sig",
"detail/server.sml",
"public/server/export.sml"] ;
Modified: mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/public/client/client.sig
===================================================================
--- mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/public/client/client.sig 2008-10-15 06:45:21 UTC (rev 6938)
+++ mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/public/client/client.sig 2008-10-15 11:04:48 UTC (rev 6939)
@@ -41,9 +41,9 @@
(** Waits for the asynchronous reply and returns it. *)
end
- val declare : 'd Rep.t * 'c Rep.t * String.t -> Conn.t -> 'd -> 'c Reply.t
+ val declare : ('d, 'c) Protocol.Signature.t -> Conn.t -> 'd -> 'c Reply.t
(**
- * Declares a procedure with the given signature {(dom, cod, name)} and
- * allows it to be called through the given connection.
+ * Declares a procedure with the given signature and allows it to be
+ * called through the given connection.
*)
end
Modified: mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/public/client/export.sml
===================================================================
--- mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/public/client/export.sml 2008-10-15 06:45:21 UTC (rev 6938)
+++ mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/public/client/export.sml 2008-10-15 11:04:48 UTC (rev 6939)
@@ -6,3 +6,6 @@
signature CLIENT = CLIENT
structure Client : CLIENT = Client
+
+signature PROTOCOL = PROTOCOL
+structure Protocol : PROTOCOL = Protocol
Added: mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/public/protocol.sig
===================================================================
--- mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/public/protocol.sig 2008-10-15 06:45:21 UTC (rev 6938)
+++ mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/public/protocol.sig 2008-10-15 11:04:48 UTC (rev 6939)
@@ -0,0 +1,23 @@
+(* Copyright (C) 2008 Vesa Karvonen
+ *
+ * This code is released under the MLton license, a BSD-style license.
+ * See the LICENSE file or http://mlton.org/License for details.
+ *)
+
+signature PROTOCOL = sig
+ structure Signature : sig
+ type ('d, 'c) t = 'd Rep.t * 'c Rep.t * String.t
+ end
+
+ structure Fingerprint : sig
+ eqtype t
+ val toString : t -> String.t
+ val fromSignature : ('d, 'c) Signature.t -> t
+ end
+
+ structure Version : sig
+ eqtype t
+ val toString : t -> String.t
+ val current : t
+ end
+end
Property changes on: mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/public/protocol.sig
___________________________________________________________________
Name: svn:eol-style
+ native
Modified: mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/public/server/export.sml
===================================================================
--- mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/public/server/export.sml 2008-10-15 06:45:21 UTC (rev 6938)
+++ mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/public/server/export.sml 2008-10-15 11:04:48 UTC (rev 6939)
@@ -6,3 +6,6 @@
signature SERVER = SERVER
structure Server : SERVER = Server
+
+signature PROTOCOL = PROTOCOL
+structure Protocol : PROTOCOL = Protocol
Modified: mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/public/server/server.sig
===================================================================
--- mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/public/server/server.sig 2008-10-15 06:45:21 UTC (rev 6938)
+++ mltonlib/trunk/org/mlton/vesak/rpc-lib/unstable/public/server/server.sig 2008-10-15 11:04:48 UTC (rev 6939)
@@ -8,15 +8,100 @@
* Signature for the {Server} module for programming RPC servers.
*)
signature SERVER = sig
- val define : 'd Rep.t * 'c Rep.t * String.t -> ('d -> 'c) Effect.t
- (**
- * Defines a procedure with the given signature {(dom, cod, name)} and
- * implementation as callable via RPC.
- *)
- val run : {port : Int.t, accept : INetSock.sock_addr UnPr.t} Effect.t
+ structure ProcMap : sig
+ type t
+ (** Type of procedure maps. *)
+
+ val new : t Thunk.t
+ (** Creates a new procedure map. *)
+
+ val add : t -> ('d, 'c) Protocol.Signature.t -> ('d -> 'c) Effect.t
+ (**
+ * Adds a procedure with the given signature and implementation to
+ * the procedure map.
+ *)
+ end
+
+ structure TCP : sig
+ structure Opts : sig
+ type t and 'a opt
+
+ val default : t
+ (** Default options. *)
+
+ (** == Updating Options ==
+ *
+ * Example:
+ *
+ *> default & port := 4321
+ *> & maxAccepts := SOME 1
+ *)
+
+ val & : t * ('a opt * 'a) -> t
+ val := : ('a opt * 'a) UnOp.t
+
+ (** == Server Settings == *)
+
+ val name : String.t opt
+ (** default: {"127.0.0.1"} *)
+
+ val port : Int.t opt
+ (** default: 45678 *)
+
+ val maxAccepts : Int.t Option.t opt
+ (** default: {NONE} *)
+
+ val tcpNoDelay : Bool.t opt
+ (** default: {true} *)
+
+ (** == Server Events == *)
+
+ val serverError : Exn.t Effect.t opt
+ (** default: {ignore} *)
+
+ val closed : Unit.t Effect.t opt
+ (** default: {ignore} *)
+
+ val accept : {addr : INetSock.sock_addr} UnPr.t opt
+ (** default: {const true} *)
+
+ val unknownProtocol :
+ {addr : INetSock.sock_addr,
+ version : Protocol.Version.t} Effect.t opt
+ (** default: {ignore} *)
+
+ val connected :
+ {addr : INetSock.sock_addr,
+ version : Protocol.Version.t} Effect.t opt
+ (** default: {ignore} *)
+
+ val unknownProc :
+ {addr : INetSock.sock_addr,
+ fingerprint : Protocol.Fingerprint.t} Effect.t opt
+ (** default: {ignore} *)
+
+ val protocolError :
+ {addr : INetSock.sock_addr,
+ error : Exn.t} Effect.t opt
+ (** default: {ignore} *)
+
+ val disconnected : {addr : INetSock.sock_addr} Effect.t opt
+ (** default: {ignore} *)
+ end
+
+ val start : ProcMap.t -> Opts.t Effect.t
+ (**
+ * Starts an async server handler listening on the specified {name}d
+ * address and {port} for clients using the TCP protocol.
+ *)
+ end
+
+ val run : Unit.t Effect.t
(**
- * Starts the server process listening on the specified port for
- * clients.
+ * Runs the started server(s). Calling {run ()} is equivalent to
+ * executing:
+ *
+ *> PollLoop.run Handler.runAll
*)
end
More information about the MLton-commit
mailing list