fb336aec4454f7eeed172dad9b8cb98ab5d86f31
[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
26 | Modify
27
28 type file_status = {action : file_action,
29 domain : string,
30 dir : string,
31 file : string}
32
33 val fileHandler = ref (fn _ : file_status => ())
34 val preHandler = ref (fn () => ())
35 val postHandler = ref (fn () => ())
36
37 fun registerFileHandler handler =
38 let
39 val old = !fileHandler
40 in
41 fileHandler := (fn x => (handler x; old x))
42 end
43
44 fun registerPreHandler handler =
45 let
46 val old = !preHandler
47 in
48 preHandler := (fn () => (handler (); old ()))
49 end
50
51 fun registerPostHandler handler =
52 let
53 val old = !postHandler
54 in
55 postHandler := (fn () => (handler (); old ()))
56 end
57
58 fun handleChanges fs = (!preHandler ();
59 app (!fileHandler) fs;
60 !postHandler ())
61
62 fun shell ss = OS.Process.isSuccess (OS.Process.system (String.concat ss))
63
64 fun shellF (ss, msg) =
65 let
66 val s = String.concat ss
67 in
68 if OS.Process.isSuccess (OS.Process.system s) then
69 ()
70 else
71 ErrorMsg.error NONE (msg s)
72 end
73
74 fun hostname () =
75 let
76 val inf = TextIO.openIn "/etc/hostname"
77 in
78 case TextIO.inputLine inf of
79 NONE => (TextIO.closeIn inf; raise Fail "No line in /etc/hostname")
80 | SOME line => (TextIO.closeIn inf; String.substring (line, 0, size line - 1))
81 end
82
83 fun concatTo p fname =
84 let
85 fun visitDir dname =
86 let
87 val dir = Posix.FileSys.opendir dname
88
89 fun loop () =
90 case Posix.FileSys.readdir dir of
91 NONE => Posix.FileSys.closedir dir
92 | SOME fname' =>
93 let
94 val path = OS.Path.joinDirFile {dir = dname, file = fname'}
95 in
96 if Posix.FileSys.ST.isDir (Posix.FileSys.stat path) then
97 visitDir path
98 else if p fname' then
99 shellF ([Config.cat, " ", path, " >>", fname],
100 fn cl => "Error concatenating: " ^ cl)
101 else
102 ();
103 loop ()
104 end
105 in
106 loop ()
107 end
108 in
109 TextIO.closeOut (TextIO.openOut fname);
110 visitDir (OS.Path.joinDirFile {dir = Config.resultRoot, file = hostname ()})
111 end
112
113 fun enumerateTo p sep fname =
114 let
115 val outf = TextIO.openOut fname
116
117 val first = ref true
118 val baseLen = length (String.fields (fn ch => ch = #"/") Config.resultRoot) + 1
119
120 fun visitDir dname =
121 let
122 val dir = Posix.FileSys.opendir dname
123
124 fun loop () =
125 case Posix.FileSys.readdir dir of
126 NONE => Posix.FileSys.closedir dir
127 | SOME fname' =>
128 let
129 val path = OS.Path.joinDirFile {dir = dname, file = fname'}
130 in
131 if Posix.FileSys.ST.isDir (Posix.FileSys.stat path) then
132 visitDir path
133 else if p fname' then
134 let
135 val toks = String.fields (fn ch => ch = #"/") dname
136 val toks = List.drop (toks, baseLen)
137 val dom = String.concatWith "." (rev toks)
138 in
139 if !first then
140 first := false
141 else
142 TextIO.output (outf, sep);
143 TextIO.output (outf, dom)
144 end
145 else
146 ();
147 loop ()
148 end
149 in
150 loop ()
151 end
152 in
153 visitDir (OS.Path.joinDirFile {dir = Config.resultRoot, file = hostname ()});
154 TextIO.closeOut outf
155 end
156
157 end