1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
(* Serves $HOME as docroot *)
open Nethttpd_types
open Nethttpd_services
open Nethttpd_reactor
open Printf
let counter = ref 0
let hit_counter env (cgi:Netcgi.cgi) =
let cur_counter = !counter in
incr counter;
cgi # output # output_string "<html><body>\n";
cgi # output # output_string (sprintf "Counter = %d<br>\n" cur_counter);
List.iter
(fun arg ->
cgi # output # output_string (sprintf "Arg %s = %s<br>\n"
(Netencoding.Html.encode_from_latin1 arg#name)
(Netencoding.Html.encode_from_latin1 arg#value))
)
cgi # arguments;
cgi # output # output_string (sprintf "SCRIPT_NAME = %s<br>\n"
(Netencoding.Html.encode_from_latin1
env#cgi_script_name));
cgi # output # output_string (sprintf "PATH_INFO = %s<br>\n"
(Netencoding.Html.encode_from_latin1
env#cgi_path_info));
cgi # output # output_string (sprintf "PATH_TRANSLATED = %s<br>\n"
(Netencoding.Html.encode_from_latin1
env#cgi_path_translated));
cgi # output # output_string (sprintf "<a href='%s/tmp'>Append 'tmp'</a><br>\n"
env#cgi_script_name);
cgi # output # output_string "<a href='?p=foo'>Append argument</a><br>\n";
cgi # output # output_string "</body></html>\n";
cgi # output # commit_work();
;;
let fs_spec =
{ file_docroot = Sys.getenv "HOME";
file_uri = "/";
file_suffix_types = [ "txt", "text/plain";
"html", "text/html" ];
file_default_type = "application/octet-stream";
file_options = [ `Enable_gzip;
`Enable_listings (simple_listing ?hide:None)
]
}
let srv =
host_distributor
[ default_host ~pref_name:"localhost" ~pref_port:8765 (),
uri_distributor
[ "*", (options_service());
"/", (file_service fs_spec);
"/easteregg", (dynamic_service
{ dyn_handler = hit_counter;
dyn_activation = std_activation `Std_activation_buffered;
dyn_uri = Some "/easteregg";
dyn_translator = file_translator fs_spec;
dyn_accept_all_conditionals = false
})
]
]
;;
let start () =
let config = Nethttpd_reactor.default_http_reactor_config in
let master_sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
Unix.setsockopt master_sock Unix.SO_REUSEADDR true;
Unix.bind master_sock (Unix.ADDR_INET(Unix.inet_addr_any, 8765));
Unix.listen master_sock 100;
printf "Listening on port 8765\n";
flush stdout;
while true do
try
let conn_sock, _ = Unix.accept master_sock in
Unix.set_nonblock conn_sock;
process_connection config conn_sock srv;
with
Unix.Unix_error(Unix.EINTR,_,_) -> () (* ignore *)
done
;;
let conf_debug() =
(* Set the environment variable DEBUG to either:
- a list of Netlog module names
- the keyword "ALL" to output all messages
- the keyword "LIST" to output a list of modules
By setting DEBUG_WIN32 additional debugging for Win32 is enabled.
*)
let debug = try Sys.getenv "DEBUG" with Not_found -> "" in
if debug = "ALL" then
Netlog.Debug.enable_all()
else if debug = "LIST" then (
List.iter print_endline (Netlog.Debug.names());
exit 0
)
else (
let l = Netstring_str.split (Netstring_str.regexp "[ \t\r\n]+") debug in
List.iter
(fun m -> Netlog.Debug.enable_module m)
l
);
if (try ignore(Sys.getenv "DEBUG_WIN32"); true with Not_found -> false) then
Netsys_win32.Debug.debug_c_wrapper true
;;
Netsys_signal.init();
conf_debug();
start();;
|
