Slave dispatching working
[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 concatTo p fname =
75 let
76 fun visitDir dname =
77 let
78 val dir = Posix.FileSys.opendir dname
79
80 fun loop () =
81 case Posix.FileSys.readdir dir of
82 NONE => Posix.FileSys.closedir dir
83 | SOME fname' =>
84 let
85 val path = OS.Path.joinDirFile {dir = dname, file = fname'}
86 in
87 if Posix.FileSys.ST.isDir (Posix.FileSys.stat path) then
88 visitDir path
89 else if p fname' then
90 shellF ([Config.cat, " ", path, " >>", fname],
91 fn cl => "Error concatenating: " ^ cl)
92 else
93 ();
94 loop ()
95 end
96 in
97 loop ()
98 end
99 in
100 TextIO.closeOut (TextIO.openOut fname);
101 visitDir Config.resultRoot
102 end
103
104 fun enumerateTo p sep fname =
105 let
106 val outf = TextIO.openOut fname
107
108 val first = ref true
109 val baseLen = length (String.fields (fn ch => ch = #"/") Config.resultRoot) + 1
110
111 fun visitDir dname =
112 let
113 val dir = Posix.FileSys.opendir dname
114
115 fun loop () =
116 case Posix.FileSys.readdir dir of
117 NONE => Posix.FileSys.closedir dir
118 | SOME fname' =>
119 let
120 val path = OS.Path.joinDirFile {dir = dname, file = fname'}
121 in
122 if Posix.FileSys.ST.isDir (Posix.FileSys.stat path) then
123 visitDir path
124 else if p fname' then
125 let
126 val toks = String.fields (fn ch => ch = #"/") dname
127 val toks = List.drop (toks, baseLen)
128 val dom = String.concatWith "." (rev toks)
129 in
130 if !first then
131 first := false
132 else
133 TextIO.output (outf, sep);
134 TextIO.output (outf, dom)
135 end
136 else
137 ();
138 loop ()
139 end
140 in
141 loop ()
142 end
143 in
144 visitDir Config.resultRoot;
145 TextIO.closeOut outf
146 end
147
148 end