Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 247 lines (191 sloc) 10.314 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
157 (** Registers a function to be called if the connection the channel relies on is lost.
158 It's not called if the channel is closed normally (by hand, or when we know nobody
159 may write to it anymore) *)
160 val on_disconnect: ('out','in') channel -> (unit -> unit) -> unit
161
162 (** Creates a new channel, linked to same endpoint as [chan] *)
163 val dup: ('out','in') channel -> ('out2','in2') channel_spec -> ('out2','in2') channel
164
165 (** Support for serialisation/deserialisation of channels:
166
167 - [serialise_channel] turns a local channel into a string of fixed length
168 [serialised_channel_size]
169
170 - [unserialise_remote_channel] uses a channel spec to re-build a channel
171 from that string on the other end (you must also provide the hosting
172 channel, used internally to get some connection information)
173
174 [unserialise_remote_channel] returns [`failure] if the string does not
175 describe a channel or if it doesn't agree with the service described by
176 [channel_spec] *)
177 val serialised_channel_size : int
178 val serialise_channel : ('out','in') channel -> string
179 val unserialise_remote_channel : ('out','in') channel_spec -> ('a,'b) channel -> ('out','in') channel stream_unserialise
180
181 (** Gives you the reverse of the channel, to use on a local channel before
182 serialising and sending. This is not mandatory, just helps the typing of
183 protocols ; the reversed channel should obviously not be used locally. *)
184 val reverse_channel : ('out','in') channel -> ('in','out') channel
185
186 val scheduler_of_channel: ('out', 'in') channel -> Scheduler.t
187 val remote_of_channel: ('out', 'in') channel -> endpoint
188 val local_of_channel: ('out','in') channel -> endpoint
189
190 (** {6 Debug} *)
191
192 (** Returns a string of given channel (for debug)*)
193 val channel_to_string : ('out', 'in') channel -> string
194
195 (** check that the channel is registered on this side,
196 * ie : a message handler is set, or a waiting handler or messages *)
197 val channel_is_listening : ('out', 'in') channel -> bool
198
199 (** Returns [true] if the channel is open, {e i.e.} if it can still
200 be used for communications *)
201 val is_open: ('out','in') channel -> bool
202
203 (** Returns a readable string from a [endpoint]. *)
204 val endpoint_to_string : endpoint -> string
205
206 (** Returns port from an [endpoint] *)
207 val port_of_endpoint : endpoint -> int
208
209 (** {6 Some useful tools and auxiliary functions} *)
210 module Aux : sig
211
212 (** A few tools on stream_unserialise: Stream unserialiser using
213 [Marshal.from_string] -- Use at your own risk ;) -- and a map function *)
214 val magic_unserialise : 'a stream_unserialise
215 val map_unserialise : ('a -> 'b) -> 'a stream_unserialise -> 'b stream_unserialise
216
217
218 (** Returns a polymorphic channel_spec using module Marshal. Fast and unsafe. *)
219 val magic_spec : service_id -> ('out','in') channel_spec
220
221 (** Returns a channel spec from simple to-string and from-string
222 functions. Less efficient than building your own stream_unserialiser (more
223 allocations), but easier to use. Strings are simply prefixed with 4 bytes
224 that indicate their length. In the unserialise function, return None to
225 indicate a failure to unserialise *)
226 val easy_spec : name:string -> version:int ->
227 serialise:('out' -> string) ->
228 unserialise:(('out','in') channel -> string -> 'in' option)
229 -> ('out','in') channel_spec
230
231 (** The easy version of [define_protocol] above *)
232 val easy_protocol : name:string -> version:int ->
233 serialise_query: ('query -> string) ->
234 unserialise_query: (('response,'query) channel -> string -> 'query option) ->
235 serialise_response: ('response -> string) ->
236 unserialise_response: (('query, 'response) channel -> string -> 'response option)
237 -> ('query,'response) protocol
238
239 (** Dups the given channel, registers a handler on it with [setup_respond] and
240 returns a (reverse) channel ready for sending back *)
241 val respond_on_new_channel:
242 ('out0,'in0) channel ->
243 ('out','in') channel_spec ->
244 ('in' -> ('out' -> unit) -> unit)
245 -> ('in','out') channel
246 end
Something went wrong with that request. Please try again.