(*
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.
*)

(* Main domtool structure *)

structure Domtool =
struct
    open Config Util

    val uid = Posix.ProcEnv.wordToUid (SysWord.fromInt uid)

    val dprint = if debug then (fn x => print (x ^ "\n")) else (fn _ => ())

    fun openIn fname =
	((*dprint ("Open " ^ fname ^ "....");*)
	 TextIO.openIn fname)

    fun opendir fname =
	((*dprint ("Open dir " ^ fname ^ "....");*)
	 Posix.FileSys.opendir fname)

    fun inputLine fl =
	let
	    val s = TextIO.inputLine fl
	in
	    if size s = 0 orelse String.sub (s, 0) <> #"#" then
		s
	    else
		inputLine fl
	end
			
    fun hd' ([], x) = x
      | hd' (h::_, _) = h

    fun domPrep (a, b) =
	(case b of
	     "" => a
	   | _ => a ^ "." ^ b)


    type map = string StringMap.map
    type set = StringSet.set

    type handlerData = {path : string,
			domain : string,
			parent : string,
			vars : map,
			paths : set,
			users : set,
			groups : set}
    type mkdomData = {path : string,
		      domain : string}
    type handler = {init : unit -> unit,
		    file : handlerData -> unit,
		    finish : unit -> unit,
		    publish : unit -> OS.Process.status,
		    mkdom : mkdomData -> OS.Process.status}

    val nullHandler = {init = fn () => (),
		       file = fn (_ : handlerData) => (),
		       finish = fn () => (),
		       publish = fn () => OS.Process.success,
		       mkdom = fn (_ : mkdomData) => OS.Process.success}

    val vhostHandler = ref nullHandler
    fun setVhostHandler f = vhostHandler := f

    val handlers = ref (StringMap.empty : handler StringMap.map)
    fun setHandler (fname, handler) = handlers := StringMap.insert (!handlers, fname, handler)

    fun error (path, msg) = print (path ^ ": " ^ msg ^ "\n")

    fun read () =
	let
	    val vhostHandler = !vhostHandler

	    val _ = Posix.FileSys.mkdir (lockFile, Posix.FileSys.S.irwxu)

	    fun readDir (path, prefix, vars, paths, users, groups) =
		let
		    val _ = dprint ("readDir: " ^ path)
		    val dir = opendir path

		    val vars =
			if Posix.FileSys.access (path ^ "/.vars", []) then
			    let
				val vf = openIn (path ^ "/.vars")

				fun loop vars =
				    let
					val line = inputLine vf
				    in
					case line of
					    "" => vars
					  | _ =>
					    (case String.tokens Char.isSpace line of
						 [n, v] =>
						 if validHost n then
						     loop (StringMap.insert (vars, n, v))
						 else
						     (error (path ^ "/.vars", "Invalid variable declaration: " ^
									      String.substring (line, 0, size line - 1));
						      loop vars)
					       | _ => loop vars)
				    end
			    in
				loop vars
				before TextIO.closeIn vf
			    end
			else
			    vars

		    val pp = path ^ "/.paths"
		    val paths =
			if Posix.FileSys.access (pp, []) then
			   (if Posix.FileSys.ST.uid (Posix.FileSys.stat pp) = uid then
				let
				    val vf = openIn pp
					     
				    fun loop paths =
					let
					    val line = inputLine vf
					in
					    case line of
						"" => paths
					      | _ =>
						(case String.tokens Char.isSpace line of
						     [path] => loop (StringSet.add (paths, path))
						   | _ => loop paths)
					end
				in
				    loop paths
				    before TextIO.closeIn vf
				end
			    else
				(error (pp, "wrong owner to be used");
				 paths))
			else
			    paths

		    val up = path ^ "/.users"
		    val users =
			if Posix.FileSys.access (up, []) then
			   (if Posix.FileSys.ST.uid (Posix.FileSys.stat up) = uid then
				let
				    val vf = openIn up
					     
				    fun loop users =
					let
					    val line = inputLine vf
					in
					    case line of
						"" => users
					      | _ =>
						(case String.tokens Char.isSpace line of
						     [user] => loop (StringSet.add (users, user))
						   | _ => loop users)
					end
				in
				    loop users
				    before TextIO.closeIn vf
				end
			    else
				(error (up, ": wrong owner to be used.");
				 users))
			else
			    users

		    val gp = path ^ "/.groups"
		    val groups =
			if Posix.FileSys.access (gp, []) then
			   (if Posix.FileSys.ST.uid (Posix.FileSys.stat gp) = uid then
				let
				    val vf = openIn gp
					     
				    fun loop groups =
					let
					    val line = inputLine vf
					in
					    case line of
						"" => groups
					      | _ =>
						(case String.tokens Char.isSpace line of
						     [group] => loop (StringSet.add (groups, group))
						   | _ => loop groups)
					end
				in
				    loop groups
				    before TextIO.closeIn vf
				end
			    else
				(error (gp, "wrong owner to be used.");
				 groups))
			else
			    groups

		    fun loop (name, ()) =
			let
			    val path' = path ^ "/" ^ name
			    val prefix' = domPrep (name, prefix)
			in
			    if not (Posix.FileSys.access (path', [])) then
				()
			    else if Posix.FileSys.ST.isDir (Posix.FileSys.stat path') then
				readDir (path', prefix', vars, paths, users, groups)
			    else if isTmp name then
				()
			    else case StringMap.find (!handlers, name) of
				     NONE => if validHost name andalso path' <> defaultWebPath then
						 #file vhostHandler {path = path',
								     domain = prefix',
								     parent = prefix,
								     vars = vars,
								     paths = paths,
								     users = users,
								     groups = groups}
					     else
						 ()
				   | SOME {file, ...} => file {path = path',
							       domain = prefix',
							       parent = prefix,
							       vars = vars,
							       paths = paths,
							       users = users,
							       groups = groups}
			end
		in
		    ioOptLoop (fn () => Posix.FileSys.readdir dir) loop ();
		    Posix.FileSys.closedir dir
		end handle Io => error (path, "IO error")
	in
	    #init vhostHandler ();
	    StringMap.app (fn {init, ...} => init ()) (!handlers);
	    readDir (dataDir, "", StringMap.empty,
		     StringSet.empty, StringSet.empty, StringSet.empty);
	    StringMap.app (fn {finish, ...} => finish ()) (!handlers);
	    #finish vhostHandler ();
	    Posix.FileSys.rmdir lockFile;
	    print "Processing complete.\n";
	    OS.Process.system dompub
	end handle Io => (print "IO error. Is domtool already running?\n";
			  OS.Process.failure)

    fun combineStatus (a, b) =
	if OS.Process.isSuccess a andalso OS.Process.isSuccess b then
	    OS.Process.success
	else
	    OS.Process.failure

    fun publish () =
	StringMap.foldl (fn ({publish, ...}, status) =>
			    combineStatus (status, publish ()))
			(#publish (!vhostHandler) ())
			(!handlers)

    fun mkdir dir =
	let
	    fun mkd (tokens, acc) =
		case tokens of
		    [] => true
		  | (dir::rest) =>
		    let
			val dir = acc ^ "/" ^ dir
		    in
			if not (Posix.FileSys.access (dir, []))
			   andalso OS.Process.system ("mkdir " ^ dir) = OS.Process.failure then
			    (print ("Can't created directory " ^ dir ^ "\n");
			     false)
			else
			    mkd (rest, dir)
		    end
	in
	    mkd (String.tokens (fn ch => ch = #"/") dir, dataDir)
	end

    fun mkdom (dom, user) =
	if not (validDomain dom) then
	    (print "Invalid domain\n";
	     OS.Process.failure)
	else if not (validUser user) then
	    (print "Invalid user\n";
	     OS.Process.failure)
	else
	    let
		val dir' = toDir dom
		val dir = dataDir ^ dir'
	    in
		if not (mkdir dir')
		   orelse OS.Process.system ("echo " ^ user ^ " >" ^ dir ^ "/.users") = OS.Process.failure
		   orelse OS.Process.system ("echo " ^ user ^ " >" ^ dir ^ "/.groups") = OS.Process.failure
		   orelse OS.Process.system ("echo /home/" ^ user ^ " >" ^ dir ^ "/.paths") = OS.Process.failure
		   orelse OS.Process.system ("chown -R " ^ user ^ "." ^ user ^ " " ^ dir) = OS.Process.failure
		   orelse OS.Process.system ("chmod -R g+w " ^ dir) = OS.Process.failure
		   orelse OS.Process.system ("chown domains.adm " ^ dir ^ "/.users " ^ dir ^ "/.groups " ^ dir ^ "/.paths") = OS.Process.failure then
		    (print "Setup failed\n";
		     OS.Process.failure)
		else if not (OS.Process.isSuccess
			     (StringMap.foldl (fn ({mkdom, ...}, status) =>
						  combineStatus (status, mkdom {path = dir, domain = dom}))
					      (#mkdom (!vhostHandler) {path = dir, domain = dom})
					      (!handlers))) then
		    (print "Setup failed\n";
		     OS.Process.failure)
		else
		    (print "Domain created\n";
		     OS.Process.success)
	    end
end