|
1 (* Title: scgi_echo.ML |
|
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 |
|
53 (Thread.fork |
|
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 |
|
92 fun thread_req () = |
|
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 " |
|
118 ^ Int.toString port ^ ". Trying again in " |
|
119 ^ Int.toString delay ^ " seconds..."); |
|
120 OS.Process.sleep (Time.fromSeconds delay); |
|
121 server' (countdown - 1) server_prefix port); |
|
122 end; |
|
123 |
|
124 end; |
|
125 |