X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/d612d62cd04b713bb1057fd2e666365704aaf3d6..984a831b49726c8ac1b517631b4bb4d071d1bb6a:/src/slave.sml diff --git a/src/slave.sml b/src/slave.sml index b08d41d..299c0ed 100644 --- a/src/slave.sml +++ b/src/slave.sml @@ -22,17 +22,21 @@ structure Slave :> SLAVE = struct datatype file_action = Add - | Delete + | Delete of bool | Modify +fun isDelete (Delete _) = true + | isDelete _ = false + type file_status = {action : file_action, domain : string, + dir : string, file : string} - + val fileHandler = ref (fn _ : file_status => ()) val preHandler = ref (fn () => ()) val postHandler = ref (fn () => ()) - + fun registerFileHandler handler = let val old = !fileHandler @@ -55,7 +59,225 @@ fun registerPostHandler handler = end fun handleChanges fs = (!preHandler (); - app (!fileHandler) fs; + app (fn recd as {action, file, ...} => + (!fileHandler recd; + case action of + Delete b => + if b andalso Posix.FileSys.access (file, []) then + OS.FileSys.remove file + else + () + | _ => ())) fs; !postHandler ()) +fun shell ss = OS.Process.isSuccess (OS.Process.system (String.concat ss)) + +fun shellF (ss, msg) = + let + val s = String.concat ss + in + if OS.Process.isSuccess (OS.Process.system s) then + () + else + ErrorMsg.error NONE (msg s) + end + +fun run (program, argv) = + let + val proc = Unix.execute (program, argv) + + fun loop inf = + case TextIO.inputLine inf of + NONE => () + | SOME line => loop inf + (* Programs that output will fail unless we eat their output *) + val () = loop (Unix.textInstreamOf proc) + in + OS.Process.isSuccess (Unix.reap proc) + end + + +fun runOutput (program, argv) = + let + val proc = Unix.execute (program, argv) + val inf = Unix.textInstreamOf proc + + fun loop out = + case TextIO.inputLine inf of + NONE => if (List.length out) > 0 then + SOME (String.concat (rev out)) + else + NONE + | SOME line => loop (line :: out) + + val lines = loop [] + in + case lines of + SOME lines => print lines + | NONE => (); + + (OS.Process.isSuccess (Unix.reap proc), lines) + end + +fun shellOutput ss = + let + val proc = Unix.execute ("/bin/bash", ["-c", String.concat ss ^ " 2>&1"]) + val inf = Unix.textInstreamOf proc + + fun loop out = + case TextIO.inputLine inf of + NONE => String.concat (rev out) + | SOME line => loop (line :: out) + + val lines = loop [] + in + print lines; + if OS.Process.isSuccess (Unix.reap proc) then + NONE + else + SOME lines + end + +fun hostname () = + let + val inf = TextIO.openIn "/etc/hostname" + in + case TextIO.inputLine inf of + NONE => (TextIO.closeIn inf; raise Fail "No line in /etc/hostname") + | SOME line => (TextIO.closeIn inf; String.substring (line, 0, size line - 1)) + end + +fun concatTo p fname = + let + fun visitDir dname = + let + val dir = Posix.FileSys.opendir dname + + fun loop () = + case Posix.FileSys.readdir dir of + NONE => Posix.FileSys.closedir dir + | SOME fname' => + let + val path = OS.Path.joinDirFile {dir = dname, file = fname'} + in + if Posix.FileSys.ST.isDir (Posix.FileSys.stat path) then + visitDir path + else if p fname' then + shellF ([Config.cat, " ", path, " >>", fname], + fn cl => "Error concatenating: " ^ cl) + else + (); + loop () + end + in + loop () + end + in + TextIO.closeOut (TextIO.openOut fname); + visitDir (OS.Path.joinDirFile {dir = Config.resultRoot, file = hostname ()}) + end + +fun enumerateTo p sep fname = + let + val outf = TextIO.openOut fname + + val first = ref true + val baseLen = length (String.fields (fn ch => ch = #"/") Config.resultRoot) + 1 + + fun visitDir dname = + let + val dir = Posix.FileSys.opendir dname + + fun loop () = + case Posix.FileSys.readdir dir of + NONE => Posix.FileSys.closedir dir + | SOME fname' => + let + val path = OS.Path.joinDirFile {dir = dname, file = fname'} + in + if Posix.FileSys.ST.isDir (Posix.FileSys.stat path) then + visitDir path + else if p fname' then + let + val toks = String.fields (fn ch => ch = #"/") dname + val toks = List.drop (toks, baseLen) + val dom = String.concatWith "." (rev toks) + in + if !first then + first := false + else + TextIO.output (outf, sep); + TextIO.output (outf, dom) + end + else + (); + loop () + end + in + loop () + end + in + visitDir (OS.Path.joinDirFile {dir = Config.resultRoot, file = hostname ()}); + TextIO.closeOut outf + end + +fun readList fname = + let + val inf = TextIO.openIn fname + + fun loop acc = + case TextIO.inputLine inf of + NONE => rev acc + | SOME line => loop (String.substring (line, 0, size line - 1) :: acc) + in + loop [] + before TextIO.closeIn inf + end + +fun writeList (fname, ls) = + let + val outf = TextIO.openOut fname + in + app (fn s => (TextIO.output (outf, s); + TextIO.output1 (outf, #"\n"))) ls; + TextIO.closeOut outf + end + +fun lineInFile fname line = + let + val inf = TextIO.openIn fname + val line' = line ^ "\n" + + fun loop () = + case TextIO.inputLine inf of + NONE => false + | SOME line => line = line' orelse loop () + in + loop () + before TextIO.closeIn inf + end handle IO.Io _ => false + +fun inGroup {user, group} = + List.exists (fn x => x = user) + (Posix.SysDB.Group.members (Posix.SysDB.getgrnam group)) + handle OS.SysErr _ => false + +fun mkDirAll dir = ignore (OS.Process.system ("mkdir -p " ^ dir)) + +fun remove (ls, x) = List.filter (fn y => y <> x) ls +fun removeDups ls = List.foldr (fn (x, ls) => + if List.exists (fn y => y = x) ls then + ls + else + x :: ls) [] ls + +fun moveDirCreate {from, to} = + (mkDirAll to; + if Posix.FileSys.access (from, []) then + (ignore (OS.Process.system ("rm -rf " ^ to)); + ignore (OS.Process.system ("cp -r " ^ from ^ " " ^ to)); + ignore (OS.Process.system ("rm -rf " ^ from))) + else + ()) + end