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 run (program, argv) =
  86     let
  87         val proc = Unix.execute (program, argv)
  88
  89         fun loop inf =
  90             case TextIO.inputLine inf of
  91                 NONE => ()
  92               | SOME line => loop inf
  93         (* Programs that output will fail unless we eat their output *)
  94         val () = loop (Unix.textInstreamOf proc)
  95     in
  96         OS.Process.isSuccess (Unix.reap proc)
  97     end
  98
  99
 100 fun runOutput (program, argv) =
 101     let
 102         val proc = Unix.execute (program, argv)
 103         val inf = Unix.textInstreamOf proc
 104
 105         fun loop out =
 106             case TextIO.inputLine inf of
 107                 NONE => if (List.length out) > 0 then
 108                             SOME (String.concat (rev out))
 109                         else
 110                             NONE
 111               | SOME line => loop (line :: out)
 112
 113         val lines = loop []
 114     in
 115         case lines of
 116             SOME lines => print lines
 117           | NONE => ();
 118
 119         (OS.Process.isSuccess (Unix.reap proc), lines)
 120     end
 121
 122 fun shellOutput ss =
 123     let
 124         val proc = Unix.execute ("/bin/bash", ["-c", String.concat ss ^ " 2>&1"])
 125         val inf = Unix.textInstreamOf proc
 126
 127         fun loop out =
 128             case TextIO.inputLine inf of
 129                 NONE => String.concat (rev out)
 130               | SOME line => loop (line :: out)
 131
 132         val lines = loop []
 133     in
 134         print lines;
 135         if OS.Process.isSuccess (Unix.reap proc) then
 136             NONE
 137         else
 138             SOME lines
 139     end
 140
 141 fun hostname () =
 142     let
 143         val inf = TextIO.openIn "/etc/hostname"
 144     in
 145         case TextIO.inputLine inf of
 146             NONE => (TextIO.closeIn inf; raise Fail "No line in /etc/hostname")
 147           | SOME line => (TextIO.closeIn inf; String.substring (line, 0, size line - 1))
 148     end
 149
 150 fun concatTo p fname =
 151     let
 152         fun visitDir dname =
 153             let
 154                 val dir = Posix.FileSys.opendir dname
 155
 156                 fun loop () =
 157                     case Posix.FileSys.readdir dir of
 158                         NONE => Posix.FileSys.closedir dir
 159                       | SOME fname' =>
 160                         let
 161                             val path = OS.Path.joinDirFile {dir = dname, file = fname'}
 162                         in
 163                             if Posix.FileSys.ST.isDir (Posix.FileSys.stat path) then
 164                                 visitDir path
 165                             else if p fname' then
 166                                 shellF ([Config.cat, " ", path, " >>", fname],
 167                                      fn cl => "Error concatenating: " ^ cl)
 168                             else
 169                                 ();
 170                             loop ()
 171                         end
 172             in
 173                 loop ()
 174             end
 175     in
 176         TextIO.closeOut (TextIO.openOut fname);
 177         visitDir (OS.Path.joinDirFile {dir = Config.resultRoot, file = hostname ()})
 178     end
 179
 180 fun enumerateTo p sep fname =
 181     let
 182         val outf = TextIO.openOut fname
 183
 184         val first = ref true
 185         val baseLen = length (String.fields (fn ch => ch = #"/") Config.resultRoot) + 1
 186
 187         fun visitDir dname =
 188             let
 189                 val dir = Posix.FileSys.opendir dname
 190
 191                 fun loop () =
 192                     case Posix.FileSys.readdir dir of
 193                         NONE => Posix.FileSys.closedir dir
 194                       | SOME fname' =>
 195                         let
 196                             val path = OS.Path.joinDirFile {dir = dname, file = fname'}
 197                         in
 198                             if Posix.FileSys.ST.isDir (Posix.FileSys.stat path) then
 199                                 visitDir path
 200                             else if p fname' then
 201                                 let
 202                                     val toks = String.fields (fn ch => ch = #"/") dname
 203                                     val toks = List.drop (toks, baseLen)
 204                                     val dom = String.concatWith "." (rev toks)
 205                                 in
 206                                     if !first then
 207                                         first := false
 208                                     else
 209                                         TextIO.output (outf, sep);
 210                                     TextIO.output (outf, dom)
 211                                 end
 212                             else
 213                                 ();
 214                             loop ()
 215                         end
 216             in
 217                 loop ()
 218             end
 219     in
 220         visitDir (OS.Path.joinDirFile {dir = Config.resultRoot, file = hostname ()});
 221         TextIO.closeOut outf
 222     end
 223
 224 fun readList fname =
 225     let
 226         val inf = TextIO.openIn fname
 227
 228         fun loop acc =
 229             case TextIO.inputLine inf of
 230                 NONE => rev acc
 231               | SOME line => loop (String.substring (line, 0, size line - 1) :: acc)
 232     in
 233         loop []
 234         before TextIO.closeIn inf
 235     end
 236
 237 fun writeList (fname, ls) =
 238     let
 239         val outf = TextIO.openOut fname
 240     in
 241         app (fn s => (TextIO.output (outf, s);
 242                       TextIO.output1 (outf, #"\n"))) ls;
 243         TextIO.closeOut outf
 244     end
 245
 246 fun lineInFile fname line =
 247     let
 248         val inf = TextIO.openIn fname
 249         val line' = line ^ "\n"
 250
 251         fun loop () =
 252             case TextIO.inputLine inf of
 253                 NONE => false
 254               | SOME line => line = line' orelse loop ()
 255     in
 256         loop ()
 257         before TextIO.closeIn inf
 258     end handle IO.Io _ => false
 259
 260 fun inGroup {user, group} =
 261     List.exists (fn x => x = user)
 262                 (Posix.SysDB.Group.members (Posix.SysDB.getgrnam group))
 263                 handle OS.SysErr _ => false
 264
 265 fun mkDirAll dir = ignore (OS.Process.system ("mkdir -p " ^ dir))
 266
 267 fun remove (ls, x) = List.filter (fn y => y <> x) ls
 268 fun removeDups ls = List.foldr (fn (x, ls) =>
 269                                    if List.exists (fn y => y = x) ls then
 270                                        ls
 271                                    else
 272                                        x :: ls) [] ls
 273
 274 fun moveDirCreate {from, to} =
 275     (mkDirAll to;
 276      if Posix.FileSys.access (from, []) then
 277          (ignore (OS.Process.system ("rm -rf " ^ to));
 278           ignore (OS.Process.system ("cp -r " ^ from ^ " " ^ to));
 279           ignore (OS.Process.system ("rm -rf " ^ from)))
 280      else
 281          ())
 282
 283 end