Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 251 lines (194 sloc) 10.457 kb
fccc685 Initial open-source release
MLstate authored
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18 (*
19 @author Louis Gesbert (original interface)
20 @author Raja Boujbel (review and implementation)
21 **)
22
23 (** Version number of the HLnet internal protocol *)
24 val protocol_version: int
25
26 (** High level network management *)
27
28 (** The type of channels *)
29 type ('out','in') channel
30
31 (** This type is used for asynchronous functions: returning ['a cps] means
32 returning right away but taking a continuation of ['a] that will be run
33 asynchronously.
34 *)
35 type 'a cps = ('a -> unit) -> unit
36
c835b24 [enhance] hlnet: providing functions with better error-handling
Louis Gesbert authored
37 (** Same as ['a cps], but also taking an error continuation *)
38 type 'a errcps = (exn -> unit) -> ('a -> unit) -> unit
39
fccc685 Initial open-source release
MLstate authored
40 (** An [endpoint] is one end of a connection. It may be local or remote. *)
41 type endpoint =
42 | Tcp of Unix.inet_addr * int
43 | Ssl of Unix.inet_addr * int * SslAS.secure_type option
44 (* | Udp of Unix.inet_addr * int *)
45 (*| ... *)
46
c835b24 [enhance] hlnet: providing functions with better error-handling
Louis Gesbert authored
47 (** Not raised, passed as parameter to error continuations *)
48 exception Disconnected of endpoint
49
fccc685 Initial open-source release
MLstate authored
50 (** A label for a service: used to provide or ask for a given service, with given version *)
51 type service_id = private {
52 name: string; (** the name of the service *)
53 version: int; (** current version of your protocol (so that you can handle upgrades) (must be in [0; 9999]) *)
54 }
55
56 (** May raise [Invalid_argument "make_service_id"] if the above restrictions are not respected *)
57 val make_service_id : name:string -> version:int -> service_id
58
59 val print_service_id : service_id -> string
60
61 (** The type of a de-serialisation function: takes a buffer and an offset.
62 In case of success, should return [`data] with the data successfully
63 unserialised and the new offset after you've consumed your data ;
64 If there is not enough data yet, should return [`needmore offset_needed]
65 (can be returned multiple times, e.g. if you first need a fixed-size
66 header, then only know the full size of the packet.) *)
67 type 'a stream_unserialise = string -> int -> [ `data of 'a * int | `needmore of int | `failure of string ]
68
69 (** Type of what should be provided to define a safe ('out','in') channel *)
70 type ('out','in') channel_spec = {
71 service: service_id; (** The id of the service provided/used by this channel *)
72 out_serialise: 'out' -> string; (** The serialisation function for outputting the values *)
73 in_unserialise: ('out','in') channel -> 'in' stream_unserialise;
74 (** the de-serialisation function to get back received values (the channel is
75 provided for cases where you need service or connection information) *)
76 }
77
78 (** Defines at once the types and specs for both ends of a channel. This
79 guarantees consistent typing between the client and server.
80
81 {b Guideline:} always explicitely coerce the return value of define_protocol,
82 to make the types used in the protocol visible. This will really help understanding
83 what your code does. *)
84 type ('query,'response) protocol = {
85 client_spec: ('query,'response) channel_spec;
86 server_spec: ('response,'query) channel_spec;
87 }
88 val define_protocol:
89 name:string -> version:int ->
90 serialise_query:('query -> string) ->
91 unserialise_query:(('response,'query) channel -> 'query stream_unserialise) ->
92 serialise_response:('response -> string) ->
93 unserialise_response:(('query,'response) channel -> 'response stream_unserialise)
94 -> ('query,'response) protocol
95
96 (** {6 Accept input channels (Server side)} *)
97
98 (** The default listening endpoint. *)
99 val default_endpoint: endpoint
100
101 (** Open a listening socket and setup the receiving queue on the given
102 local endpoint. Does nothing if already listening on that
103 endpoint *)
104 val listen: Scheduler.t -> endpoint -> unit
105
106 (** Setup a function to deal with incoming channels requesting the
107 service described by [channel_spec] on the local [endpoint].
108
109 Unless [safe], any previously existing handler for the same
110 service is overriden. Otherwise, may raise [Failure "Hlnet.safe_accept"].
111 *)
112 val accept: ?safe:bool -> Scheduler.t ->
113 endpoint -> ('out','in') channel_spec ->
114 (('out','in') channel -> unit)
115 -> unit
116
117 (* refuse_service: endpoint -> service_id -> unit : to stop listening for new channels on a
118 specific service. Write it if needed *)
119
120 (** Stop listening on local endpoint. Open channels will be kept open, but
121 remotes won't be able to open new ones. Does nothing if the local host was
122 not listening on the given endpoint. Called before closing endpoint's
123 channels *)
124 val refuse: Scheduler.t -> endpoint -> unit
125
126 (** {6 Openning channels (Client side)} *)
127
128 (** Just create a [channel] *)
129 val open_channel: Scheduler.t ->
130 endpoint -> ('out','in') channel_spec ->
131 ?on_disconnect:(unit -> [ `retry of Time.t | `abort ])
132 -> ('out','in') channel cps
133
134 (** {6 Using channels} *)
135
136 (** Sends a packet on a channel *)
137 val send: ('out','in') channel -> 'out' -> unit
138
139 (** Handles one incoming packet on channel *)
140 val receive: ('out','in') channel -> 'in' cps
c835b24 [enhance] hlnet: providing functions with better error-handling
Louis Gesbert authored
141 val receive': ('out','in') channel -> 'in' errcps
fccc685 Initial open-source release
MLstate authored
142
143 (** Sends a packet on the given channel, then gets ready to treat the answer with the given continuation.
144 * Returns immediately *)
145 val sendreceive: ('out','in') channel -> 'out' -> 'in' cps
c835b24 [enhance] hlnet: providing functions with better error-handling
Louis Gesbert authored
146 val sendreceive': ('out','in') channel -> 'out' -> 'in' errcps
fccc685 Initial open-source release
MLstate authored
147
148 (** Sends packets on givens channels, waits for all answer before treating them with given continuations *)
149 val multi_sendreceive: (('out','in') channel * 'out') list -> ('in' -> unit) list -> unit
150
151 (** Setups a handler for any incoming packets on channel *)
152 val setup_respond: ('out','in') channel -> ('in' -> ('out' -> unit) -> unit) -> unit
153
154 (** Closes given channel *)
155 val close_channel: ('out','in') channel -> unit
156
3321f32 [enhance] database: fatal database errors now trigger the fail-transacti...
Louis Gesbert authored
157 (** Closes the given channel and the underlying connection, triggering any
158 registered handlers *)
159 val panic: ('out','in') channel -> unit
160
fccc685 Initial open-source release
MLstate authored
161 (** Registers a function to be called if the connection the channel relies on is lost.
162 It's not called if the channel is closed normally (by hand, or when we know nobody
163 may write to it anymore) *)
164 val on_disconnect: ('out','in') channel -> (unit -> unit) -> unit
165
166 (** Creates a new channel, linked to same endpoint as [chan] *)
167 val dup: ('out','in') channel -> ('out2','in2') channel_spec -> ('out2','in2') channel
168
169 (** Support for serialisation/deserialisation of channels:
170
171 - [serialise_channel] turns a local channel into a string of fixed length
172 [serialised_channel_size]
173
174 - [unserialise_remote_channel] uses a channel spec to re-build a channel
175 from that string on the other end (you must also provide the hosting
176 channel, used internally to get some connection information)
177
178 [unserialise_remote_channel] returns [`failure] if the string does not
179 describe a channel or if it doesn't agree with the service described by
180 [channel_spec] *)
181 val serialised_channel_size : int
182 val serialise_channel : ('out','in') channel -> string
183 val unserialise_remote_channel : ('out','in') channel_spec -> ('a,'b) channel -> ('out','in') channel stream_unserialise
184
185 (** Gives you the reverse of the channel, to use on a local channel before
186 serialising and sending. This is not mandatory, just helps the typing of
187 protocols ; the reversed channel should obviously not be used locally. *)
188 val reverse_channel : ('out','in') channel -> ('in','out') channel
189
190 val scheduler_of_channel: ('out', 'in') channel -> Scheduler.t
191 val remote_of_channel: ('out', 'in') channel -> endpoint
192 val local_of_channel: ('out','in') channel -> endpoint
193
194 (** {6 Debug} *)
195
196 (** Returns a string of given channel (for debug)*)
197 val channel_to_string : ('out', 'in') channel -> string
198
199 (** check that the channel is registered on this side,
200 * ie : a message handler is set, or a waiting handler or messages *)
201 val channel_is_listening : ('out', 'in') channel -> bool
202
203 (** Returns [true] if the channel is open, {e i.e.} if it can still
204 be used for communications *)
205 val is_open: ('out','in') channel -> bool
206
207 (** Returns a readable string from a [endpoint]. *)
208 val endpoint_to_string : endpoint -> string
209
210 (** Returns port from an [endpoint] *)
211 val port_of_endpoint : endpoint -> int
212
213 (** {6 Some useful tools and auxiliary functions} *)
214 module Aux : sig
215
216 (** A few tools on stream_unserialise: Stream unserialiser using
217 [Marshal.from_string] -- Use at your own risk ;) -- and a map function *)
218 val magic_unserialise : 'a stream_unserialise
219 val map_unserialise : ('a -> 'b) -> 'a stream_unserialise -> 'b stream_unserialise
220
221
222 (** Returns a polymorphic channel_spec using module Marshal. Fast and unsafe. *)
223 val magic_spec : service_id -> ('out','in') channel_spec
224
225 (** Returns a channel spec from simple to-string and from-string
226 functions. Less efficient than building your own stream_unserialiser (more
227 allocations), but easier to use. Strings are simply prefixed with 4 bytes
228 that indicate their length. In the unserialise function, return None to
229 indicate a failure to unserialise *)
230 val easy_spec : name:string -> version:int ->
231 serialise:('out' -> string) ->
232 unserialise:(('out','in') channel -> string -> 'in' option)
233 -> ('out','in') channel_spec
234
235 (** The easy version of [define_protocol] above *)
236 val easy_protocol : name:string -> version:int ->
237 serialise_query: ('query -> string) ->
238 unserialise_query: (('response,'query) channel -> string -> 'query option) ->
239 serialise_response: ('response -> string) ->
240 unserialise_response: (('query, 'response) channel -> string -> 'response option)
241 -> ('query,'response) protocol
242
243 (** Dups the given channel, registers a handler on it with [setup_respond] and
244 returns a (reverse) channel ready for sending back *)
245 val respond_on_new_channel:
246 ('out0,'in0) channel ->
247 ('out','in') channel_spec ->
248 ('in' -> ('out' -> unit) -> unit)
249 -> ('in','out') channel
250 end
Something went wrong with that request. Please try again.