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