Testing log directory backup
[hcoop/domtool2.git] / src / slave.sml
CommitLineData
d612d62c
AC
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
21structure Slave :> SLAVE = struct
22
23datatype file_action =
24 Add
25 | Delete
26 | Modify
27
28type file_status = {action : file_action,
29 domain : string,
6ae327f8 30 dir : string,
d612d62c 31 file : string}
36e42cb8 32
d612d62c
AC
33val fileHandler = ref (fn _ : file_status => ())
34val preHandler = ref (fn () => ())
35val postHandler = ref (fn () => ())
36
37fun registerFileHandler handler =
38 let
39 val old = !fileHandler
40 in
41 fileHandler := (fn x => (handler x; old x))
42 end
43
44fun registerPreHandler handler =
45 let
46 val old = !preHandler
47 in
48 preHandler := (fn () => (handler (); old ()))
49 end
50
51fun registerPostHandler handler =
52 let
53 val old = !postHandler
54 in
55 postHandler := (fn () => (handler (); old ()))
56 end
57
58fun handleChanges fs = (!preHandler ();
c189cbe9
AC
59 app (fn recd as {action, file, ...} =>
60 (!fileHandler recd;
61 if action = Delete andalso Posix.FileSys.access (file, []) then
62 OS.FileSys.remove file
63 else
64 ())) fs;
d612d62c
AC
65 !postHandler ())
66
8df2e702
AC
67fun shell ss = OS.Process.isSuccess (OS.Process.system (String.concat ss))
68
69fun shellF (ss, msg) =
70 let
71 val s = String.concat ss
72 in
73 if OS.Process.isSuccess (OS.Process.system s) then
74 ()
75 else
76 ErrorMsg.error NONE (msg s)
77 end
78
6e62228d
AC
79fun hostname () =
80 let
81 val inf = TextIO.openIn "/etc/hostname"
82 in
83 case TextIO.inputLine inf of
84 NONE => (TextIO.closeIn inf; raise Fail "No line in /etc/hostname")
85 | SOME line => (TextIO.closeIn inf; String.substring (line, 0, size line - 1))
86 end
87
8df2e702
AC
88fun concatTo p fname =
89 let
90 fun visitDir dname =
91 let
92 val dir = Posix.FileSys.opendir dname
93
94 fun loop () =
95 case Posix.FileSys.readdir dir of
96 NONE => Posix.FileSys.closedir dir
97 | SOME fname' =>
98 let
99 val path = OS.Path.joinDirFile {dir = dname, file = fname'}
100 in
101 if Posix.FileSys.ST.isDir (Posix.FileSys.stat path) then
102 visitDir path
103 else if p fname' then
104 shellF ([Config.cat, " ", path, " >>", fname],
6ae327f8 105 fn cl => "Error concatenating: " ^ cl)
8df2e702
AC
106 else
107 ();
108 loop ()
109 end
110 in
8df2e702
AC
111 loop ()
112 end
113 in
6ae327f8 114 TextIO.closeOut (TextIO.openOut fname);
6e62228d 115 visitDir (OS.Path.joinDirFile {dir = Config.resultRoot, file = hostname ()})
8df2e702
AC
116 end
117
ed9fda3a
AC
118fun enumerateTo p sep fname =
119 let
120 val outf = TextIO.openOut fname
121
122 val first = ref true
e0b0abd2 123 val baseLen = length (String.fields (fn ch => ch = #"/") Config.resultRoot) + 1
ed9fda3a
AC
124
125 fun visitDir dname =
126 let
127 val dir = Posix.FileSys.opendir dname
128
129 fun loop () =
130 case Posix.FileSys.readdir dir of
131 NONE => Posix.FileSys.closedir dir
132 | SOME fname' =>
133 let
134 val path = OS.Path.joinDirFile {dir = dname, file = fname'}
135 in
136 if Posix.FileSys.ST.isDir (Posix.FileSys.stat path) then
137 visitDir path
138 else if p fname' then
139 let
140 val toks = String.fields (fn ch => ch = #"/") dname
141 val toks = List.drop (toks, baseLen)
142 val dom = String.concatWith "." (rev toks)
143 in
144 if !first then
145 first := false
146 else
147 TextIO.output (outf, sep);
148 TextIO.output (outf, dom)
149 end
150 else
151 ();
152 loop ()
153 end
154 in
155 loop ()
156 end
157 in
6e62228d 158 visitDir (OS.Path.joinDirFile {dir = Config.resultRoot, file = hostname ()});
ed9fda3a
AC
159 TextIO.closeOut outf
160 end
161
7db53a0b
AC
162fun readList fname =
163 let
164 val inf = TextIO.openIn fname
165
166 fun loop acc =
167 case TextIO.inputLine inf of
168 NONE => rev acc
169 | SOME line => loop (String.substring (line, 0, size line - 1) :: acc)
170 in
171 loop []
172 before TextIO.closeIn inf
173 end
174
175fun writeList (fname, ls) =
176 let
177 val outf = TextIO.openOut fname
178 in
179 app (fn s => (TextIO.output (outf, s);
180 TextIO.output1 (outf, #"\n"))) ls;
181 TextIO.closeOut outf
182 end
183
d351d679
AC
184fun lineInFile fname line =
185 let
186 val inf = TextIO.openIn fname
187 val line' = line ^ "\n"
188
189 fun loop () =
190 case TextIO.inputLine inf of
191 NONE => false
192 | SOME line => line = line' orelse loop ()
193 in
194 loop ()
195 before TextIO.closeIn inf
196 end handle IO.Io _ => false
197
737c68d4
AC
198fun inGroup {user, group} =
199 List.exists (fn x => x = user)
200 (Posix.SysDB.Group.members (Posix.SysDB.getgrnam group))
201 handle OS.SysErr _ => false
202
409542d7
AC
203fun mkDirAll dir = ignore (OS.Process.system ("mkdir -p " ^ dir))
204
e0b80e65
AC
205fun remove (ls, x) = List.filter (fn y => y <> x) ls
206fun removeDups ls = List.foldr (fn (x, ls) =>
207 if List.exists (fn y => y = x) ls then
208 ls
209 else
210 x :: ls) [] ls
211
31b50af0
AC
212fun copyDirCreate {from, to} =
213 (mkDirAll to;
214 if Posix.FileSys.access (from, []) then
215 ignore (OS.Process.system ("cp -r " ^ from ^ " " ^ to))
216 else
217 ())
218
219fun moveDirCreate {from, to} =
220 (mkDirAll to;
221 if Posix.FileSys.access (from, []) then
222 ignore (OS.Process.system ("mv " ^ from ^ " " ^ to))
223 else
224 ())
225
d612d62c 226end