Mercurial > urweb
comparison src/main.mlton.sml @ 1744:6fcce0592178
Send daemon output to calling process
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Sat, 05 May 2012 12:45:35 -0400 |
parents | c414850f206f |
children | 518e0b23c4ef |
comparison
equal
deleted
inserted
replaced
1743:1e940643a5f0 | 1744:6fcce0592178 |
---|---|
39 val demo = ref (NONE : (string * bool) option) | 39 val demo = ref (NONE : (string * bool) option) |
40 val tutorial = ref false | 40 val tutorial = ref false |
41 val css = ref false | 41 val css = ref false |
42 | 42 |
43 val () = (Compiler.debug := false; | 43 val () = (Compiler.debug := false; |
44 Elaborate.verbose := false; | |
44 Elaborate.dumpTypes := false; | 45 Elaborate.dumpTypes := false; |
45 Elaborate.unifyMore := false; | 46 Elaborate.unifyMore := false; |
46 Compiler.dumpSource := false; | 47 Compiler.dumpSource := false; |
47 Compiler.doIflow := false; | 48 Compiler.doIflow := false; |
48 Demo.noEmacs := false; | 49 Demo.noEmacs := false; |
89 | "-debug" :: rest => | 90 | "-debug" :: rest => |
90 (Settings.setDebug true; | 91 (Settings.setDebug true; |
91 doArgs rest) | 92 doArgs rest) |
92 | "-verbose" :: rest => | 93 | "-verbose" :: rest => |
93 (Compiler.debug := true; | 94 (Compiler.debug := true; |
95 Elaborate.verbose := true; | |
94 doArgs rest) | 96 doArgs rest) |
95 | "-timing" :: rest => | 97 | "-timing" :: rest => |
96 (timing := true; | 98 (timing := true; |
97 doArgs rest) | 99 doArgs rest) |
98 | "-tc" :: rest => | 100 | "-tc" :: rest => |
241 let | 243 let |
242 val cmd = Substring.string befor | 244 val cmd = Substring.string befor |
243 val rest = Substring.string (Substring.slice (after, 1, NONE)) | 245 val rest = Substring.string (Substring.slice (after, 1, NONE)) |
244 in | 246 in |
245 case cmd of | 247 case cmd of |
246 "" => send (sock, if OS.Process.isSuccess ((oneRun (rev args)) | 248 "" => |
247 handle ex => (print "unhandled exception:\n"; | 249 let |
248 print (General.exnMessage ex ^ "\n"); | 250 val success = (oneRun (rev args)) |
249 OS.Process.failure)) then | 251 handle ex => (print "unhandled exception:\n"; |
250 "0" | 252 print (General.exnMessage ex ^ "\n"); |
251 else | 253 OS.Process.failure) |
252 "1") | 254 in |
255 TextIO.flushOut TextIO.stdOut; | |
256 TextIO.flushOut TextIO.stdErr; | |
257 send (sock, if OS.Process.isSuccess success then | |
258 "\001" | |
259 else | |
260 "\002") | |
261 end | |
253 | _ => loop' (rest, cmd :: args) | 262 | _ => loop' (rest, cmd :: args) |
254 end | 263 end |
255 end handle OS.SysErr _ => () | 264 end handle OS.SysErr _ => () |
265 | |
266 fun redirect old = | |
267 Posix.IO.dup2 {old = valOf (Posix.FileSys.iodToFD (Socket.ioDesc sock)), | |
268 new = old} | |
269 | |
270 val oldStdout = Posix.IO.dup Posix.FileSys.stdout | |
271 val oldStderr = Posix.IO.dup Posix.FileSys.stderr | |
256 in | 272 in |
273 (* Redirect the daemon's output to the socket. *) | |
274 redirect Posix.FileSys.stdout; | |
275 redirect Posix.FileSys.stderr; | |
276 | |
257 loop' ("", []); | 277 loop' ("", []); |
258 Socket.close sock; | 278 Socket.close sock; |
279 | |
280 Posix.IO.dup2 {old = oldStdout, new = Posix.FileSys.stdout}; | |
281 Posix.IO.dup2 {old = oldStderr, new = Posix.FileSys.stderr}; | |
282 Posix.IO.close oldStdout; | |
283 Posix.IO.close oldStderr; | |
284 | |
259 MLton.GC.pack (); | 285 MLton.GC.pack (); |
260 loop () | 286 loop () |
261 end | 287 end |
262 in | 288 in |
263 OS.Process.atExit (fn () => OS.FileSys.remove socket); | 289 OS.Process.atExit (fn () => OS.FileSys.remove socket); |
270 let | 296 let |
271 val sock = UnixSock.Strm.socket () | 297 val sock = UnixSock.Strm.socket () |
272 | 298 |
273 fun wait () = | 299 fun wait () = |
274 let | 300 let |
275 val v = Socket.recvVec (sock, 1) | 301 val v = Socket.recvVec (sock, 1024) |
276 in | 302 in |
277 if Vector.length v = 0 then | 303 if Vector.length v = 0 then |
278 OS.Process.failure | 304 OS.Process.failure |
279 else | 305 else |
280 case chr (Word8.toInt (Vector.sub (v, 0))) of | 306 let |
281 #"0" => OS.Process.success | 307 val s = Vector.map (chr o Word8.toInt) v |
282 | #"1" => OS.Process.failure | 308 val last = Vector.sub (v, Vector.length v - 1) |
283 | _ => raise Fail "Weird return code from daemon" | 309 val (rc, s) = if last = Word8.fromInt 1 then |
310 (SOME OS.Process.success, String.substring (s, 0, size s - 1)) | |
311 else if last = Word8.fromInt 2 then | |
312 (SOME OS.Process.failure, String.substring (s, 0, size s - 1)) | |
313 else | |
314 (NONE, s) | |
315 in | |
316 print s; | |
317 case rc of | |
318 NONE => wait () | |
319 | SOME rc => rc | |
320 end | |
284 end handle OS.SysErr _ => OS.Process.failure | 321 end handle OS.SysErr _ => OS.Process.failure |
285 in | 322 in |
286 if Socket.connectNB (sock, UnixSock.toAddr socket) | 323 if Socket.connectNB (sock, UnixSock.toAddr socket) |
287 orelse not (List.null (#wrs (Socket.select {rds = [], | 324 orelse not (List.null (#wrs (Socket.select {rds = [], |
288 wrs = [Socket.sockDesc sock], | 325 wrs = [Socket.sockDesc sock], |