Fix tiny Makefile bug

[hcoop/domtool2.git] / src / slave.sml

(* HCoop Domtool (http://hcoop.sourceforge.net/)
 * Copyright (c) 2006, Adam Chlipala
 *
 * This program is free software; you can redistribute it and/or
 * modify it under the terms of the GNU General Public License
 * as published by the Free Software Foundation; either version 2
 * of the License, or (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 *)

(* Code for receiving and executing configuration files *)

structure Slave :> SLAVE = struct

datatype file_action =
	 Add
       | Delete
       | Modify

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
    in
	fileHandler := (fn x => (handler x; old x))
    end

fun registerPreHandler handler =
    let
	val old = !preHandler
    in
	preHandler := (fn () => (handler (); old ()))
    end

fun registerPostHandler handler =
    let
	val old = !postHandler
    in
	postHandler := (fn () => (handler (); old ()))
    end

fun handleChanges fs = (!preHandler ();
			app (fn recd as {action, file, ...} =>
				(!fileHandler recd;
				 if action = Delete 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 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

end