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