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 (!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) + 1
 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