Initial revision

[hcoop/zz_old/domtool.git] / src / exim / exim.sml

(*
Domtool (http://hcoop.sf.net/)
Copyright (C) 2004  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., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
*)

(* Exim e-mail alias and local domain configuration *)

structure Exim :> EXIM =
struct
    open Config EximConfig Util

    val aliases = ref (NONE : TextIO.outstream option)
    val aliasesDefault = ref (NONE : TextIO.outstream option)
    val local_domains = ref (NONE : TextIO.outstream option)

    fun init () = (aliases := SOME (TextIO.openOut (scratchDir ^ "/aliases"));
		   aliasesDefault := SOME (TextIO.openOut (scratchDir ^ "/aliases.default"));
		   local_domains := SOME (TextIO.openOut (scratchDir ^ "/local_domains"));
		   TextIO.output (valOf (!local_domains), "local_domains = localhost"))
    fun finish () = (TextIO.output (valOf (!local_domains), "\n\n");
		     TextIO.closeOut (valOf (!aliases));
		     aliases := NONE;
		     TextIO.closeOut (valOf (!aliasesDefault));
		     aliasesDefault := NONE;
		     TextIO.closeOut (valOf (!local_domains));
		     local_domains := NONE)

    fun handler {path, domain, parent, vars, paths, users, groups} =
	let
	    val _ = Domtool.dprint ("Reading aliases " ^ path ^ " for " ^ domain ^ "....")

	    val aliases = valOf (!aliases)
	    val aliasesDefault = valOf (!aliasesDefault)

	    val domain = "@" ^ parent
	    val al = TextIO.openIn path

	    fun loop (line, ()) =
		let
		    fun err () = Domtool.error (path, "invalid entry: " ^ line)
		in
		    case String.tokens Char.isSpace line of
			[] => ()
		      | ["*", target] =>
			if validUser target then
			    TextIO.output (aliasesDefault, "*" ^ domain ^ ":\t" ^ target ^ "@localhost\n")
			else if validEmail target then
			    TextIO.output (aliasesDefault, "*" ^ domain ^ ":\t" ^ target ^ "\n")
			else
			    err ()
		      | ["**", target] =>
			if validUser target then
			    TextIO.output (aliases, "*" ^ domain ^ ":\t" ^ target ^ "@localhost\n")
			else if validEmail target then
			    TextIO.output (aliases, "*" ^ domain ^ ":\t" ^ target ^ "\n")
			else
			    err ()
		      | [user, target] =>
			if validUser user then
			    (if target = "!" then
				 TextIO.output (aliases, user ^ domain ^ ":\t/dev/null\n")
			     else if validUser target then
				 TextIO.output (aliases, user ^ domain ^ ":\t" ^ target ^ "@localhost\n")
			     else if validEmail target then
				 TextIO.output (aliases, user ^ domain ^ ":\t" ^ target ^ "\n")
			     else
				 err ())
			else
			    err ()
		      | _ => err ()
		end
	in
	    ioLoop (fn () => Domtool.inputLine al) loop ();
	    TextIO.closeIn al
	end handle Io => Domtool.error (path, "IO error")

    fun publish () =
	if OS.Process.isSuccess (OS.Process.system
	       (diff ^ " " ^ scratchDir ^ "/aliases " ^ aliasesFile))
	   andalso OS.Process.isSuccess (OS.Process.system
	       (diff ^ " " ^ scratchDir ^ "/aliases.default " ^ aliasesDefaultFile))
	   andalso OS.Process.isSuccess (OS.Process.system
	       (diff ^ " " ^ scratchDir ^ "/local_domains " ^
		scratchDir ^ "/local_domains.last"))
	then
	    OS.Process.success
	else if not (OS.Process.isSuccess (OS.Process.system
	       (cp ^ " " ^ scratchDir ^ "/aliases " ^ aliasesFile))) then
	    (print "Error copying aliases\n";
	     OS.Process.failure)
	else if not (OS.Process.isSuccess (OS.Process.system
	       (cp ^ " " ^ scratchDir ^ "/aliases.default " ^ aliasesDefaultFile))) then
	    (print "Error copying aliases.default\n";
	     OS.Process.failure)
	else if not (OS.Process.isSuccess (OS.Process.system
	       (cp ^ " " ^ scratchDir ^ "/local_domains " ^
		scratchDir ^ "/local_domains.last"))) then
	    (print "Error copying local_domains\n";
	     OS.Process.failure)
	else if not (OS.Process.isSuccess (OS.Process.system
               (cat ^ " " ^ scratchDir ^ "/local_domains " ^ eximBase ^
		" >" ^ eximFile))) then
	    (print "Error creating exim.conf\n";
	     OS.Process.failure)
	else if OS.Process.isSuccess (OS.Process.system pubCommand) then
	    OS.Process.success
	else
	    (print "Error publishing exim data\n";
	     OS.Process.failure)

    fun mkdom _ = OS.Process.success

    val _ = Domtool.setHandler (".aliases", {init = init,
					     file = handler,
					     finish = finish,
					     publish = publish,
					     mkdom = mkdom})

    fun localDomain domain = TextIO.output (valOf (!local_domains), ":" ^ domain)
end