author | wenzelm |
Wed, 12 Jan 2011 15:15:51 +0100 | |
changeset 41522 | 42d13d00ccfb |
parent 41491 | a2ad5b824051 |
child 43074 | 8b566f0d226c |
permissions | -rw-r--r-- |
33823 | 1 |
(* Title: Tools/WWW_Find/scgi_server.ML |
33817 | 2 |
Author: Timothy Bourke, NICTA |
3 |
||
4 |
Simple SCGI server. |
|
5 |
*) |
|
6 |
||
7 |
signature SCGI_SERVER = |
|
8 |
sig |
|
9 |
val max_threads : int Unsynchronized.ref |
|
10 |
type handler = ScgiReq.t * Word8Vector.vector * (string -> unit) -> unit |
|
11 |
val register : (string * Mime.t option * handler) -> unit |
|
12 |
val server : string -> int -> unit |
|
13 |
val server' : int -> string -> int -> unit (* keeps trying for port *) |
|
14 |
end; |
|
15 |
||
16 |
structure ScgiServer : SCGI_SERVER = |
|
17 |
struct |
|
18 |
val max_threads = Unsynchronized.ref 5; |
|
19 |
||
20 |
type handler = ScgiReq.t * Word8Vector.vector * (string -> unit) -> unit; |
|
21 |
||
22 |
local |
|
23 |
val servers = Unsynchronized.ref (Symtab.empty : (Mime.t option * handler) Symtab.table); |
|
24 |
in |
|
25 |
fun register (name, mime, f) = |
|
26 |
Unsynchronized.change servers (Symtab.update_new (name, (mime, f))); |
|
27 |
fun lookup name = Symtab.lookup (!servers) name; |
|
28 |
||
29 |
fun dump_handlers () = ( |
|
30 |
tracing(" with handlers:"); |
|
31 |
app (fn (x, _) => tracing (" - " ^ x)) (Symtab.dest (!servers))) |
|
32 |
end; |
|
33 |
||
34 |
fun server server_prefix port = |
|
35 |
let |
|
36 |
val passive_sock = SocketUtil.init_server_socket (SOME "localhost") port; |
|
37 |
||
38 |
val thread_wait = ConditionVar.conditionVar (); |
|
39 |
val thread_wait_mutex = Mutex.mutex (); |
|
40 |
||
41 |
local |
|
42 |
val threads = Unsynchronized.ref ([] : Thread.thread list); |
|
43 |
fun purge () = Unsynchronized.change threads (filter Thread.isActive); |
|
44 |
in |
|
45 |
fun add_thread th = Unsynchronized.change threads (cons th); |
|
46 |
||
47 |
fun launch_thread threadf = |
|
48 |
(purge (); |
|
49 |
if length (!threads) < (!max_threads) then () |
|
50 |
else (tracing ("Waiting for a free thread..."); |
|
51 |
ConditionVar.wait (thread_wait, thread_wait_mutex)); |
|
52 |
add_thread |
|
39155 | 53 |
(Thread.fork (* FIXME avoid low-level Poly/ML thread primitives *) |
33817 | 54 |
(fn () => exception_trace threadf, |
55 |
[Thread.EnableBroadcastInterrupt true, |
|
56 |
Thread.InterruptState |
|
57 |
Thread.InterruptAsynchOnce]))) |
|
58 |
end; |
|
59 |
||
60 |
fun loop () = |
|
61 |
let |
|
62 |
val (sock, _)= Socket.accept passive_sock; |
|
63 |
||
64 |
val (sin, sout) = SocketUtil.make_streams sock; |
|
65 |
||
66 |
fun send msg = BinIO.output (sout, Byte.stringToBytes msg); |
|
67 |
fun send_log msg = (tracing msg; send msg); |
|
68 |
||
69 |
fun get_content (st, 0) = Word8Vector.fromList [] |
|
70 |
| get_content x = BinIO.inputN x; |
|
71 |
||
72 |
fun do_req () = |
|
73 |
let |
|
74 |
val (req as ScgiReq.Req {path_info, request_method, ...}, |
|
75 |
content_is) = |
|
76 |
ScgiReq.parse sin |
|
77 |
handle ScgiReq.InvalidReq s => |
|
78 |
(send |
|
79 |
(HttpUtil.reply_header (HttpStatus.bad_request, NONE, [])); |
|
80 |
raise Fail ("Invalid request: " ^ s)); |
|
81 |
val () = tracing ("request: " ^ path_info); |
|
82 |
in |
|
83 |
(case lookup (unprefix server_prefix path_info) of |
|
84 |
NONE => send (HttpUtil.reply_header (HttpStatus.not_found, NONE, [])) |
|
85 |
| SOME (NONE, f) => f (req, get_content content_is, send) |
|
86 |
| SOME (t, f) => |
|
87 |
(send (HttpUtil.reply_header (HttpStatus.ok, t, [])); |
|
88 |
if request_method = ScgiReq.Head then () |
|
89 |
else f (req, get_content content_is, send))) |
|
90 |
end; |
|
91 |
||
41522
42d13d00ccfb
more FIXMEs concerning bad catch-all exception handlers;
wenzelm
parents:
41491
diff
changeset
|
92 |
fun thread_req () = (* FIXME avoid handle e *) |
33817 | 93 |
(do_req () handle e => (warning (exnMessage e)); |
94 |
BinIO.closeOut sout handle e => warning (exnMessage e); |
|
95 |
BinIO.closeIn sin handle e => warning (exnMessage e); |
|
96 |
Socket.close sock handle e => warning (exnMessage e); |
|
97 |
tracing ("request done."); |
|
98 |
ConditionVar.signal thread_wait); |
|
99 |
in |
|
100 |
launch_thread thread_req; |
|
101 |
loop () |
|
102 |
end; |
|
103 |
in |
|
104 |
tracing ("SCGI server started."); |
|
105 |
dump_handlers (); |
|
106 |
loop (); |
|
107 |
Socket.close passive_sock |
|
108 |
end; |
|
109 |
||
110 |
local |
|
111 |
val delay = 5; |
|
112 |
in |
|
113 |
fun server' 0 server_prefix port = (warning "Giving up."; exit 1) |
|
114 |
| server' countdown server_prefix port = |
|
115 |
server server_prefix port |
|
116 |
handle OS.SysErr ("bind failed", _) => |
|
117 |
(warning ("Could not acquire port " |
|
41491 | 118 |
^ string_of_int port ^ ". Trying again in " |
119 |
^ string_of_int delay ^ " seconds..."); |
|
33817 | 120 |
OS.Process.sleep (Time.fromSeconds delay); |
121 |
server' (countdown - 1) server_prefix port); |
|
122 |
end; |
|
123 |
||
124 |
end; |
|
125 |