Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 86 lines (62 sloc) 2.04 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 module A = ServerArg
20
21 type dialog = Scheduler.t -> HttpServerTypes.web_info -> unit
22
23 type t = {
24 body : dialog Lazy.t;
25 allowed : (Unix.inet_addr -> bool) ;
26 content : (string -> int -> int -> unit) ;
27 url_prefix : string
28 }
29
30 type options = {
31 opt_allowed : Unix.inet_addr -> bool;
32 dialog_name : string;
33 dialog : unit -> dialog;
34 opt_url_prefix : string;
35 }
36
37 type port = {
38 set_dialog : t -> unit
39 }
40
41
42 let name = "httpDialog"
43 let version = "1.0"
44
45 let null_dialog = Obj.magic None
46
47 let default_options = {
48 opt_allowed = (fun _ -> true);
49 dialog_name = "default";
50 dialog = null_dialog;
51 opt_url_prefix = "";
52 }
53
54 let options_with_dialog dialog =
55 {default_options with dialog = dialog}
56
57 let spec_args _name = []
58
59 let make _name opt _sched =
60 if opt.dialog == null_dialog then begin
61 Logger.error "No dialog provided"; exit 1
62 end;
63 {
64 body = Lazy.lazy_from_fun opt.dialog;
65 allowed = opt.opt_allowed ;
66 url_prefix = opt.opt_url_prefix ;
67 content = (fun _url _total _current -> ()) ;
68 }
69
70 let get_ports _ _ = []
71
72 let get_description http_dialog _sched =
73 `HttpDialog http_dialog
74
75 let run http_dialog _ = http_dialog
76
77 let close _ _ = ()
78
79 let body http_dialog sched winfo =
80 (Lazy.force http_dialog.body) sched winfo
81
82 let content http_dialog = http_dialog.content
83
84 let is_allowed http_dialog conn =
85 http_dialog.allowed (Scheduler.get_connection_inet_addr conn)
Something went wrong with that request. Please try again.