fwtool: allow udp/tcp for all user rules
[hcoop/domtool2.git] / src / slave.sml
1 (* HCoop Domtool (http://hcoop.sourceforge.net/)
2 * Copyright (c) 2006, Adam Chlipala
3 *
4 * This program is free software; you can redistribute it and/or
5 * modify it under the terms of the GNU General Public License
6 * as published by the Free Software Foundation; either version 2
7 * of the License, or (at your option) any later version.
8 *
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
13 *
14 * You should have received a copy of the GNU General Public License
15 * along with this program; if not, write to the Free Software
16 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
17 *)
18
19 (* Code for receiving and executing configuration files *)
20
21 structure Slave :> SLAVE = struct
22
23 datatype file_action =
24 Add
25 | Delete of bool
26 | Modify
27
28 fun isDelete (Delete _) = true
29 | isDelete _ = false
30
31 type file_status = {action : file_action,
32 domain : string,
33 dir : string,
34 file : string}
35
36 val fileHandler = ref (fn _ : file_status => ())
37 val preHandler = ref (fn () => ())
38 val postHandler = ref (fn () => ())
39
40 fun registerFileHandler handler =
41 let
42 val old = !fileHandler
43 in
44 fileHandler := (fn x => (handler x; old x))
45 end
46
47 fun registerPreHandler handler =
48 let
49 val old = !preHandler
50 in
51 preHandler := (fn () => (handler (); old ()))
52 end
53
54 fun registerPostHandler handler =
55 let
56 val old = !postHandler
57 in
58 postHandler := (fn () => (handler (); old ()))
59 end
60
61 fun handleChanges fs = (!preHandler ();
62 app (fn recd as {action, file, ...} =>
63 (!fileHandler recd;
64 case action of
65 Delete b =>
66 if b andalso Posix.FileSys.access (file, []) then
67 OS.FileSys.remove file
68 else
69 ()
70 | _ => ())) fs;
71 !postHandler ())
72
73 fun shell ss = OS.Process.isSuccess (OS.Process.system (String.concat ss))
74
75 fun shellF (ss, msg) =
76 let
77 val s = String.concat ss
78 in
79 if OS.Process.isSuccess (OS.Process.system s) then
80 ()
81 else
82 ErrorMsg.error NONE (msg s)
83 end
84
85 fun run (program, argv) =
86 let
87 val proc = Unix.execute (program, argv)
88
89 fun loop inf =
90 case TextIO.inputLine inf of
91 NONE => ()
92 | SOME line => loop inf
93 (* Programs that output will fail unless we eat their output *)
94 val () = loop (Unix.textInstreamOf proc)
95 in
96 OS.Process.isSuccess (Unix.reap proc)
97 end
98
99
100 fun runOutput (program, argv) =
101 let
102 val proc = Unix.execute (program, argv)
103 val inf = Unix.textInstreamOf proc
104
105 fun loop out =
106 case TextIO.inputLine inf of
107 NONE => if (List.length out) > 0 then
108 SOME (String.concat (rev out))
109 else
110 NONE
111 | SOME line => loop (line :: out)
112
113 val lines = loop []
114 in
115 case lines of
116 SOME lines => print lines
117 | NONE => ();
118
119 (OS.Process.isSuccess (Unix.reap proc), lines)
120 end
121
122 fun shellOutput ss =
123 let
124 val proc = Unix.execute ("/bin/bash", ["-c", String.concat ss ^ " 2>&1"])
125 val inf = Unix.textInstreamOf proc
126
127 fun loop out =
128 case TextIO.inputLine inf of
129 NONE => String.concat (rev out)
130 | SOME line => loop (line :: out)
131
132 val lines = loop []
133 in
134 print lines;
135 if OS.Process.isSuccess (Unix.reap proc) then
136 NONE
137 else
138 SOME lines
139 end
140
141 fun hostname () =
142 let
143 val inf = TextIO.openIn "/etc/hostname"
144 in
145 case TextIO.inputLine inf of
146 NONE => (TextIO.closeIn inf; raise Fail "No line in /etc/hostname")
147 | SOME line => (TextIO.closeIn inf; String.substring (line, 0, size line - 1))
148 end
149
150 fun concatTo p fname =
151 let
152 fun visitDir dname =
153 let
154 val dir = Posix.FileSys.opendir dname
155
156 fun loop () =
157 case Posix.FileSys.readdir dir of
158 NONE => Posix.FileSys.closedir dir
159 | SOME fname' =>
160 let
161 val path = OS.Path.joinDirFile {dir = dname, file = fname'}
162 in
163 if Posix.FileSys.ST.isDir (Posix.FileSys.stat path) then
164 visitDir path
165 else if p fname' then
166 shellF ([Config.cat, " ", path, " >>", fname],
167 fn cl => "Error concatenating: " ^ cl)
168 else
169 ();
170 loop ()
171 end
172 in
173 loop ()
174 end
175 in
176 TextIO.closeOut (TextIO.openOut fname);
177 visitDir (OS.Path.joinDirFile {dir = Config.resultRoot, file = hostname ()})
178 end
179
180 fun enumerateTo p sep fname =
181 let
182 val outf = TextIO.openOut fname
183
184 val first = ref true
185 val baseLen = length (String.fields (fn ch => ch = #"/") Config.resultRoot) + 1
186
187 fun visitDir dname =
188 let
189 val dir = Posix.FileSys.opendir dname
190
191 fun loop () =
192 case Posix.FileSys.readdir dir of
193 NONE => Posix.FileSys.closedir dir
194 | SOME fname' =>
195 let
196 val path = OS.Path.joinDirFile {dir = dname, file = fname'}
197 in
198 if Posix.FileSys.ST.isDir (Posix.FileSys.stat path) then
199 visitDir path
200 else if p fname' then
201 let
202 val toks = String.fields (fn ch => ch = #"/") dname
203 val toks = List.drop (toks, baseLen)
204 val dom = String.concatWith "." (rev toks)
205 in
206 if !first then
207 first := false
208 else
209 TextIO.output (outf, sep);
210 TextIO.output (outf, dom)
211 end
212 else
213 ();
214 loop ()
215 end
216 in
217 loop ()
218 end
219 in
220 visitDir (OS.Path.joinDirFile {dir = Config.resultRoot, file = hostname ()});
221 TextIO.closeOut outf
222 end
223
224 fun readList fname =
225 let
226 val inf = TextIO.openIn fname
227
228 fun loop acc =
229 case TextIO.inputLine inf of
230 NONE => rev acc
231 | SOME line => loop (String.substring (line, 0, size line - 1) :: acc)
232 in
233 loop []
234 before TextIO.closeIn inf
235 end
236
237 fun writeList (fname, ls) =
238 let
239 val outf = TextIO.openOut fname
240 in
241 app (fn s => (TextIO.output (outf, s);
242 TextIO.output1 (outf, #"\n"))) ls;
243 TextIO.closeOut outf
244 end
245
246 fun lineInFile fname line =
247 let
248 val inf = TextIO.openIn fname
249 val line' = line ^ "\n"
250
251 fun loop () =
252 case TextIO.inputLine inf of
253 NONE => false
254 | SOME line => line = line' orelse loop ()
255 in
256 loop ()
257 before TextIO.closeIn inf
258 end handle IO.Io _ => false
259
260 fun inGroup {user, group} =
261 List.exists (fn x => x = user)
262 (Posix.SysDB.Group.members (Posix.SysDB.getgrnam group))
263 handle OS.SysErr _ => false
264
265 fun mkDirAll dir = ignore (OS.Process.system ("mkdir -p " ^ dir))
266
267 fun remove (ls, x) = List.filter (fn y => y <> x) ls
268 fun removeDups ls = List.foldr (fn (x, ls) =>
269 if List.exists (fn y => y = x) ls then
270 ls
271 else
272 x :: ls) [] ls
273
274 fun moveDirCreate {from, to} =
275 (mkDirAll to;
276 if Posix.FileSys.access (from, []) then
277 (ignore (OS.Process.system ("rm -rf " ^ to));
278 ignore (OS.Process.system ("cp -r " ^ from ^ " " ^ to));
279 ignore (OS.Process.system ("rm -rf " ^ from)))
280 else
281 ())
282
283 end