| 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) |
| 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 |