Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh |
2 | * Jagannathan, and Stephen Weeks. | |
3 | * | |
4 | * MLton is released under a BSD-style license. | |
5 | * See the file MLton-LICENSE for details. | |
6 | *) | |
7 | ||
8 | structure InitScript: INIT_SCRIPT = | |
9 | struct | |
10 | ||
11 | val messageStr = Trace.Immediate.messageStr | |
12 | val op / = String./ | |
13 | ||
14 | (* Losely based on /etc/sysconfig/init *) | |
15 | local | |
16 | open Console open Foreground CharRendition | |
17 | fun make (settings, msg) = | |
18 | let | |
19 | val color = concat [moveToColumn 60, "[ ", set settings, msg, | |
20 | set [Default], " ]\n"] | |
21 | val normal = concat [" [ ", msg, " ]\n"] | |
22 | in fn () => | |
23 | print (case Process.getEnv "TERM" of | |
24 | SOME "linux" => color | |
25 | | SOME "xterm" => color | |
26 | | _ => normal) | |
27 | end | |
28 | in | |
29 | val succeed = make ([Bold, Foreground BrightGreen], "OK") | |
30 | val fail = make ([Bold, Foreground BrightRed], "FAILED") | |
31 | val warn = make ([Bold, Foreground Yellow], "PASSED") | |
32 | end | |
33 | ||
34 | fun wrap (th: unit -> unit): unit = | |
35 | ((th () handle e => (fail (); raise e)) | |
36 | ; succeed ()) | |
37 | ||
38 | fun startStop {name, action, log, thunk, usage} = | |
39 | let | |
40 | val me = Pid.current () | |
41 | fun getProc () = | |
42 | List.peek (Process.ps (), fn {name = n, pid, ...} => | |
43 | n = name andalso not (Pid.equals (me, pid))) | |
44 | val isRunning = isSome o getProc | |
45 | fun start () = | |
46 | if isRunning () | |
47 | then print (concat [name, " is already running\n"]) | |
48 | else | |
49 | wrap | |
50 | (fn () => | |
51 | let | |
52 | val _ = print (concat ["Starting ", name, ":"]) | |
53 | val _ = Out.close Out.error | |
54 | val _ = Out.set (Out.error, Out.openAppend log) | |
55 | val _ = | |
56 | Process.doubleFork | |
57 | (fn () => | |
58 | let | |
59 | val _ = In.close In.standard | |
60 | val _ = Out.close Out.standard | |
61 | val _ = Posix.ProcEnv.setpgid {pid = NONE, pgid = NONE} | |
62 | val _ = | |
63 | Signal.setHandler | |
64 | (Posix.Signal.term, Signal.Handler.handler (fn _ => | |
65 | Thread.new | |
66 | (fn () => | |
67 | (messageStr "received Signal.term -- exiting" | |
68 | ; Process.succeed ())))) | |
69 | in | |
70 | thunk () | |
71 | end) | |
72 | in () | |
73 | end) | |
74 | fun status () = | |
75 | print (concat [name, | |
76 | if isRunning () | |
77 | then " is running\n" | |
78 | else " is not running\n"]) | |
79 | fun stop () = | |
80 | case getProc () of | |
81 | NONE => print (concat [name, " is not running\n"]) | |
82 | | SOME {pgrp, ...} => | |
83 | wrap (fn () => | |
84 | (print (concat ["Shutting down ", name, ":"]) | |
85 | ; Process.signalGroup (pgrp, Posix.Signal.term))) | |
86 | in case action of | |
87 | "start" => start () | |
88 | | "status" => status () | |
89 | | "stop" => stop () | |
90 | | _ => usage "must start|status|stop" | |
91 | end | |
92 | end |