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 (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;
  65                         !postHandler ())
  66
  67 fun shell ss = OS.Process.isSuccess (OS.Process.system (String.concat ss))
  68
  69 fun 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
  79 fun 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
  88 fun 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],
 105                                      fn cl => "Error concatenating: " ^ cl)
 106                             else
 107                                 ();
 108                             loop ()
 109                         end
 110             in
 111                 loop ()
 112             end
 113     in
 114         TextIO.closeOut (TextIO.openOut fname);
 115         visitDir (OS.Path.joinDirFile {dir = Config.resultRoot, file = hostname ()})
 116     end
 117
 118 fun enumerateTo p sep fname =
 119     let
 120         val outf = TextIO.openOut fname
 121
 122         val first = ref true
 123         val baseLen = length (String.fields (fn ch => ch = #"/") Config.resultRoot) + 1
 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
 158         visitDir (OS.Path.joinDirFile {dir = Config.resultRoot, file = hostname ()});
 159         TextIO.closeOut outf
 160     end
 161
 162 fun 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
 175 fun 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
 184 fun 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
 198 fun 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
 203 fun mkDirAll dir = ignore (OS.Process.system ("mkdir -p " ^ dir))
 204
 205 fun remove (ls, x) = List.filter (fn y => y <> x) ls
 206 fun 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
 212 end