Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 134 lines (109 sloc) 2.937 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 (**
20 Ports and Description module for the Runtime layer.
21 @author Cedric Soulas
22 *)
23
24 module rec Ports :
25 sig
26
27 type t =
28 (string *
29 [ `Connection of Network.port
30 | `Http_dialog of Http_dialog.port
31 | `HttpDialog of HttpDialog.port
32 | `Logger
33 | `None
34 ]) list
35
36 val add : Scheduler.t -> t -> unit
37
38 val init : Scheduler.t -> unit
39
40 end =
41 struct
42
43 type t =
44 (string *
45 [ `Connection of Network.port
46 | `Http_dialog of Http_dialog.port
47 | `HttpDialog of HttpDialog.port
48 | `Logger
49 | `None
50 ]) list
51
52 let ports = ref []
53
54 let init_port sched (name, port) =
55 match port with
56 | `Connection c ->
57 let module N = Network in
58 let abort_listen = Network.listen sched c.N.port_spec c.N.secure_mode c.N.conn_incoming in
59 let _ = abort_listen in
60 ()
61 | `Http_dialog hd ->
62 let e = Description.get name in
63 let dialog = match e with
64 | `Http_dialog dialog -> dialog
65 | _ -> assert false
66 in
67 hd.Http_dialog.set_dialog dialog
68 | `HttpDialog hd ->
69 let e = Description.get name in
70 let dialog = match e with
71 | `HttpDialog dialog -> dialog
72 | _ -> assert false
73 in
74 hd.HttpDialog.set_dialog dialog
75 | `Logger ->()
76 | `None -> ()
77 | _ -> assert false
78
79 let add _sched l =
80 ports := l@(!ports)
81
82 let init sched =
83 List.iter (init_port sched) !ports
84
85 end
86 and Description :
87 sig
88
89 type t =
90 [
91 | `Connection
92 | `Http_dialog of Http_dialog.t
93 | `HttpDialog of HttpDialog.t
94 | `Logger
95 | `HttpServer
96 | `FtpServer
97 | `SmtpServer
98 | `Watchdog
99 ]
100
101 val get : string -> t
102
103 val add : string -> t -> unit
104
105 end =
106 struct
107
108 type t =
109 [
110 | `Connection
111 | `Http_dialog of Http_dialog.t
112 | `HttpDialog of HttpDialog.t
113 | `Logger
114 | `HttpServer
115 | `FtpServer
116 | `SmtpServer
117 | `Watchdog
118 ]
119
120 exception Not_found
121 let (output: (string, t) Hashtbl.t) = Hashtbl.create 5
122
123 let add k e =
124 Hashtbl.add output k e
125
126 let get k =
127 if Hashtbl.mem output k then
128 Hashtbl.find output k
129 else begin
130 Logger.error "Unbound port '%s'" k;
131 raise Not_found
132 end
133 end
Something went wrong with that request. Please try again.