[hcoop/zz_old/domtool.git] / src / apache / apache.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.
*)

(* Apache vhost management module, with Webalizer support *)

structure Apache :> APACHE =
struct
    open Config ApacheConfig Util

    val vhosts = ref (NONE : TextIO.outstream option)
    val loggroups = ref (NONE : TextIO.outstream option)

    fun init () = (vhosts := SOME (TextIO.openOut (scratchDir ^ "/vhosts.conf"));
		   loggroups := SOME (TextIO.openOut (scratchDir ^ "/loggroups")))
    fun finish () = (TextIO.closeOut (valOf (!vhosts));
		     vhosts := NONE;
		     TextIO.closeOut (valOf (!loggroups));
		     loggroups := NONE)

    val noargs = ["redirect", "R", "forbidden", "F", "gone", "G", "last", "L", "chain", "C", "nosubeq", "NS", "nocase", "NC", "qsappend", "QSA", "noescape", "NE", "passthrough", "PT"]
	
    fun checkRewriteCondArgs (path, args) =
	if size args < 2 orelse String.sub (args, 0) <> #"[" orelse String.sub (args, size args - 1) <> #"]" then
	    (Domtool.error (path, "Not in brackets: " ^ args);
	     false)
	else let
	    val args = String.substring (args, 1, size args - 2)
	    val fields = String.fields (fn ch => ch = #",") args

	    fun checkOne f =
		case f of
		    "nocase" => true
		  | "NC" => true
		  | "ornext" => true
		  | "OR" => true
		  | _ => false
	in
	    List.all checkOne fields
	end
		     
	 
    fun checkRewriteArgs (path, args) =
	if size args < 2 orelse String.sub (args, 0) <> #"[" orelse String.sub (args, size args - 1) <> #"]" then
	    (Domtool.error (path, "Not in brackets: " ^ args);
	     false)
	else let
	    val args = String.substring (args, 1, size args - 2)
	    val fields = String.fields (fn ch => ch = #",") args
			 
	    fun checkField f =
		case String.fields (fn ch => ch = #"=") f of
		    [flag] => List.exists (fn x => x = flag) noargs orelse (Domtool.error (path, "Unknown argument-free flag " ^ flag);
									    false)
		  | ["type", _] => true
		  | ["T", _] => true
		  | ["skip", num] => isNat num orelse (Domtool.error (path, "Bad skip number " ^ num); false)
		  | ["S", num] => isNat num orelse (Domtool.error (path, "Bad skip number " ^ num); false)
		  | ["env", varval] =>
		    (case String.fields (fn ch => ch = #":") varval of
			 [_, _] => true
		       | _ => (Domtool.error (path, "Bad env setting " ^ varval);
			       false))
		  | ["E", varval] =>
		    (case String.fields (fn ch => ch = #":") varval of
			 [_, _] => true
		       | _ => (Domtool.error (path, "Bad env setting " ^ varval);
			       false))
		  | _ => (Domtool.error (path, "Unknown or disallowed mod_rewrite flag " ^ f);
			  false)
	in
	    List.all checkField fields
	end

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

	    val vhosts = valOf (!vhosts)
	    val loggroups = valOf (!loggroups)

	    val domfile = "/etc/domains/" ^ String.concatWith "/" (rev (String.tokens (fn ch => ch = #".") domain))
	    val stat = Posix.FileSys.stat domfile
	    val group' = Posix.SysDB.Group.name (Posix.SysDB.getgrgid (Posix.FileSys.ST.gid stat))

	    val _ = TextIO.output (loggroups, domain ^ "\t" ^ group' ^ "\n")

	    val hf = TextIO.openIn path
	    val rewrite = ref false

	    val conf = TextIO.openOut (wblConfDir ^ "/" ^ domain ^ ".conf")
	    val _ = TextIO.output (conf, "LogFile\t" ^ logDir ^ domain ^ "-access.log\n" ^
					 "OutputDir\t" ^ wblDocDir ^ "/" ^ domain ^ "\n" ^
					 "HostName\t" ^ domain ^ "\n" ^
					 "HideSite\t" ^ domain ^ "\n" ^
					 "HideReferrer\t" ^ domain ^ "\n")

	    val dir = wblDocDir ^ "/" ^ domain
	    val _ =
		if Posix.FileSys.access (dir, []) then
		    ()
		else
		    Posix.FileSys.mkdir (dir, Posix.FileSys.S.flags [Posix.FileSys.S.ixoth, Posix.FileSys.S.irwxu,
								     Posix.FileSys.S.irgrp, Posix.FileSys.S.iwgrp])

	    val htac = TextIO.openOut (dir ^ "/.htaccess")
	    val user = ref defaultUser
	    val group = ref defaultGroup

	    val blocked = ref []

	    fun loop (line, ()) =
		(case String.tokens Char.isSpace line of
		     [] => ()
		   | ["User", user'] =>
		     if StringSet.member (users, user') then
			 user := user'
		     else
			 Domtool.error (path, "not authorized to run as " ^ user')
		   | ["Group", group'] =>
		     if StringSet.member (groups, group') then
			 group := group'
		     else
			 Domtool.error (path, "not authorized to run as group " ^ group')
		   | ["ServerAdmin", email] => TextIO.output (vhosts, "\tServerAdmin " ^ email ^ "\n")
		   | ["UserDir"] => TextIO.output (vhosts, "\tUserDir public_html\n\t<Directory /home/*/public_html/cgi-bin>\n\t\tAllowOverride None\n\t\tOptions ExecCGI\n\t\tAllow from all\n\t\tSetHandler cgi-script\n\t</Directory>\n\tScriptAliasMatch ^/~(.*)/cgi-bin/(.*) /home/$1/public_html/cgi-bin/$2\n")
		   | ["DocumentRoot", p] =>
		     if checkPath (paths, p) then
			 TextIO.output (vhosts, "\tDocumentRoot " ^ p ^ "\n")
		     else
			 print (path ^ ": not authorized to use " ^ p ^ "\n")
		   | "RewriteRule" :: src :: dst :: rest =>
		     let
			 val flags =
			     case rest of
				 [] => SOME ""
			       | [flags] => if checkRewriteArgs (path, flags) then SOME flags else NONE
			       | _ => (Domtool.error (path, "Invalid mod_rewrite flags in " ^ chop line); NONE)
		     in
			 case flags of
			     SOME flags =>
			     (if not (!rewrite) then
				  (rewrite := true;
				   TextIO.output (vhosts, "\tRewriteEngine on\n"))
			     else
				 ();
  			     TextIO.output (vhosts, "\tRewriteRule\t" ^ src ^ " " ^ dst ^ " " ^ flags ^ "\n"))
			   | _ => ()
		     end
		   | "RewriteCond" :: thing :: pat :: rest =>
		     let
			 val flags =
			     case rest of
				 [] => SOME ""
			       | [flags] => if checkRewriteCondArgs (path, flags) then SOME flags else NONE
			       | _ => (Domtool.error (path, "Invalid mod_rewrite flags in " ^ chop line); NONE)
		     in
			 case flags of
			     SOME flags =>
			     (if not (!rewrite) then
				  (rewrite := true;
				   TextIO.output (vhosts, "\tRewriteEngine on\n"))
			     else
				 ();
  			     TextIO.output (vhosts, "\tRewriteCond\t" ^ thing ^ " " ^ pat ^ " " ^ flags ^ "\n"))
			   | _ => ()
		     end
		   | ["LocalProxy", src, dst, port] =>
		     (case Int.fromString port of
			  NONE => Domtool.error (path, "Invalid port number " ^ port)
			| SOME n =>
			  if n = 80 then
			      Domtool.error (path, "No proxying back to Apache itself allowed")
			  else if n <= 0 then
			      Domtool.error (path, "Port number must be positive: " ^ port)
			  else
			      (if not (!rewrite) then
				   (rewrite := true;
				    TextIO.output (vhosts, "\tRewriteEngine on\n"))
			       else
				   ();
				   TextIO.output (vhosts, "\tRewriteRule\t" ^ src ^ " http://localhost:" ^ port ^ "/" ^ dst ^ " [P]\n")))
		   | ["Alias", from, to] =>
		     if checkPath (paths, to) then
			 TextIO.output (vhosts, "\tAlias " ^ from ^ " " ^ to ^ "\n")
		     else
			 Domtool.error (path, "not authorized to use " ^ to)
		   | "ErrorDocument" :: code :: rest =>
		     TextIO.output (vhosts, foldl (fn (a, s) => s ^ " " ^ a) ("\tErrorDocument " ^ code) rest ^ "\n")
		   | ["ScriptAlias", from, to] =>
		     if checkPath (paths, to) then
			 TextIO.output (vhosts, "\tScriptAlias " ^ from ^ " \"" ^ to ^ "\"\n")
		     else
			 Domtool.error (path, "not authorized to use " ^ to)
		   | ["SSI"] =>
		     TextIO.output (vhosts, "\t<Location />\n\t\tOptions +Includes +IncludesNOEXEC\n\t</Location>\n")
		   | ["ServerAlias", dom] =>
		     if validDomain dom then
			 let
			     val file = foldr (fn (c, s) => s ^ "/" ^ c) dataDir (String.fields (fn ch => ch = #".") dom) ^ ".aliased"
			 in
			     if Posix.FileSys.access (file, []) then
				 (TextIO.output (vhosts, "\tServerAlias " ^ dom ^ "\n");
				  TextIO.output (conf, "HideSite\t" ^ dom ^ "\n" ^
						       "HideReferrer\t" ^ dom ^ "\n"))
			     else
				 Domtool.error (path, "not authorized to ServerAlias " ^ dom)
			 end
		     else
			 Domtool.error (path, "bad host: " ^ dom)
		   | "WebalizerUsers" :: users =>
		     TextIO.output (htac, "AuthType Basic\n" ^
					  "AuthName \"Abulafia web account\"\n" ^
					  "AuthUserFile " ^ passwdFile ^ "\n" ^
					  foldl (fn (u, s) => s ^ " " ^ u) "Require user" users ^ "\n")
		   | ["AbuPrivate"] => TextIO.output (vhosts,
						      "\t<Location />\n" ^
						      "\t\tAuthName \"Abulafia web account\"\n" ^
						      "\t\tAuthType basic\n" ^
						      "\t\tAuthUserFile " ^ passwdFile ^ "\n" ^
						      "\t\tRequire valid-user\n" ^
						      "\t\tOrder Deny,Allow\n" ^
						      "\t\tDeny from all\n" ^
						      "\t\tAllow from 127.0.0.1\n" ^
						      "\t\tAllow from 63.246.10.45\n" ^
						      "\t\tSatisfy any\n" ^
						      "\t</Location>\n")
		   | ["Block", pat] => blocked := pat :: (!blocked)
		   | ["Default"] => (TextIO.output (vhosts, "\tServerAlias " ^ parent ^ "\n");
				     TextIO.output (conf, "HideSite\t" ^ parent ^ "\n" ^
							  "HideReferrer\t" ^ parent ^ "\n"))
		   | ["CGI", p] =>
		     if checkPath (paths, p) then
			 TextIO.output (vhosts, "\t<Directory " ^ p ^ ">\n" ^
						"\t\tOptions ExecCGI\n" ^
						"\t\tSetHandler cgi-script\n" ^
						"\t</Directory>\n")
		     else
			 Domtool.error (path, "not authorized to use " ^ p)
		   | ["Mod", lang, p, file] =>
		     (case List.find (fn (lang', _) => lang = lang') langHandlers of
			  NONE => Domtool.error (p, "unknown Mod language " ^ lang)
			| SOME (_, f) =>
			  (TextIO.output (vhosts, "\t<Location " ^ p ^ ">\n");
			   TextIO.output (vhosts, f file);
			   TextIO.output (vhosts, "\t</Location>\n")))
		   | ["HTML", p] =>
		     if checkPath (paths, p) then
			 TextIO.output (vhosts, "\t<Directory " ^ p ^ ">\n" ^
						"\t\tForceType text/html\n" ^
						"\t</Directory>\n")
		     else
			 Domtool.error (path, "not authorized to use " ^ p)
		   | ["PerlSetVar", n, v] =>
		     TextIO.output (vhosts, "\tPerlSetVar " ^ n ^ " " ^ v ^ "\n")
		   | ["AddDefaultCharset", cs] =>
		     TextIO.output (vhosts, "\tAddDefaultCharSet " ^ cs ^ "\n")
		   | cmd::_ => Domtool.error (path, "unknown option: " ^ cmd))
	in
	    TextIO.output (vhosts, "<VirtualHost *>\n" ^
				   "\tServerName " ^ domain ^ "\n" ^
				   "\tErrorLog " ^ logDir ^ domain ^ "-error.log\n" ^
				   "\tCustomLog " ^ logDir ^ domain ^ "-access.log combined\n" ^
				   "\tIndexOptions FancyIndexing FoldersFirst\n");
	    ioOptLoop (fn () => Domtool.inputLine hf) loop ();

	    (case !blocked of
		 [] => ()
	       | _ =>
		 (TextIO.output (vhosts,
				 "\t<Location />\n" ^
				 "\t\tOrder Allow,Deny\n" ^
				 "\t\tAllow from all\n");
		  app (fn pat =>  TextIO.output (vhosts, "\t\tDeny from " ^ pat ^ "\n")) (!blocked);
		  TextIO.output (vhosts, "\t</Location>\n")));

	    TextIO.output (vhosts, "\tUser ");
	    TextIO.output (vhosts, !user);
	    TextIO.output (vhosts, "\n\tGroup ");
	    TextIO.output (vhosts, !group);
	    TextIO.output (vhosts, "\n</VirtualHost>\n\n");
	    TextIO.closeIn hf;
	    TextIO.closeOut conf;
	    TextIO.closeOut htac
	end handle Io => Domtool.error (path, "IO error")

    fun publish () =
	if OS.Process.isSuccess (OS.Process.system
	       (diff ^ " " ^ scratchDir ^ "/vhosts.conf " ^ dataFile)) then
	    OS.Process.success
	else if not (OS.Process.isSuccess (OS.Process.system
	       (cp ^ " " ^ scratchDir ^ "/vhosts.conf " ^ dataFile))) then
	    (print "Error copying vhosts.conf\n";
	     OS.Process.failure)
	else if not (OS.Process.isSuccess (OS.Process.system pubCommand)) then
	    (print "Error publishing vhosts.conf\n";
	     OS.Process.failure)
	else if OS.Process.isSuccess (OS.Process.system logpermsCommand) then
	    OS.Process.success
	else
	    (print "Error updating log permissions\n";
	     OS.Process.failure)

    fun mkdom _ = OS.Process.success

    val _ = Domtool.setVhostHandler {init = init,
				     file = handler,
				     finish = finish,
				     publish = publish,
				     mkdom = mkdom}
end
Commit	Line	Data
182a2654 AC	1	(*
	2	Domtool (http://hcoop.sf.net/)
	3	Copyright (C) 2004 Adam Chlipala
	4
	5	This program is free software; you can redistribute it and/or
	6	modify it under the terms of the GNU General Public License
	7	as published by the Free Software Foundation; either version 2
	8	of the License, or (at your option) any later version.
	9
	10	This program is distributed in the hope that it will be useful,
	11	but WITHOUT ANY WARRANTY; without even the implied warranty of
	12	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	13	GNU General Public License for more details.
	14
	15	You should have received a copy of the GNU General Public License
	16	along with this program; if not, write to the Free Software
	17	Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
	18	*)
	19
	20	(* Apache vhost management module, with Webalizer support *)
	21
	22	structure Apache :> APACHE =
	23	struct
	24	open Config ApacheConfig Util
	25
	26	val vhosts = ref (NONE : TextIO.outstream option)
1e2e348e	27	val loggroups = ref (NONE : TextIO.outstream option)
182a2654	28
1e2e348e AC	29	fun init () = (vhosts := SOME (TextIO.openOut (scratchDir ^ "/vhosts.conf"));
1e2e348e AC	30	loggroups := SOME (TextIO.openOut (scratchDir ^ "/loggroups")))
182a2654	31	fun finish () = (TextIO.closeOut (valOf (!vhosts));
1e2e348e AC	32	vhosts := NONE;
	33	TextIO.closeOut (valOf (!loggroups));
	34	loggroups := NONE)
182a2654	35
05060d16	36	val noargs = ["redirect", "R", "forbidden", "F", "gone", "G", "last", "L", "chain", "C", "nosubeq", "NS", "nocase", "NC", "qsappend", "QSA", "noescape", "NE", "passthrough", "PT"]
0e2e70f2 AC	37
	38	fun checkRewriteCondArgs (path, args) =
	39	if size args < 2 orelse String.sub (args, 0) <> #"[" orelse String.sub (args, size args - 1) <> #"]" then
	40	(Domtool.error (path, "Not in brackets: " ^ args);
	41	false)
	42	else let
	43	val args = String.substring (args, 1, size args - 2)
	44	val fields = String.fields (fn ch => ch = #",") args
	45
	46	fun checkOne f =
	47	case f of
	48	"nocase" => true
	49	\| "NC" => true
	50	\| "ornext" => true
	51	\| "OR" => true
	52	\| _ => false
	53	in
	54	List.all checkOne fields
	55	end
	56
	57
05060d16 AC	58	fun checkRewriteArgs (path, args) =
	59	if size args < 2 orelse String.sub (args, 0) <> #"[" orelse String.sub (args, size args - 1) <> #"]" then
	60	(Domtool.error (path, "Not in brackets: " ^ args);
	61	false)
	62	else let
	63	val args = String.substring (args, 1, size args - 2)
	64	val fields = String.fields (fn ch => ch = #",") args
	65
	66	fun checkField f =
	67	case String.fields (fn ch => ch = #"=") f of
	68	[flag] => List.exists (fn x => x = flag) noargs orelse (Domtool.error (path, "Unknown argument-free flag " ^ flag);
	69	false)
05060d16 AC	70	\| ["type", _] => true
	71	\| ["T", _] => true
	72	\| ["skip", num] => isNat num orelse (Domtool.error (path, "Bad skip number " ^ num); false)
	73	\| ["S", num] => isNat num orelse (Domtool.error (path, "Bad skip number " ^ num); false)
	74	\| ["env", varval] =>
	75	(case String.fields (fn ch => ch = #":") varval of
	76	[_, _] => true
	77	\| _ => (Domtool.error (path, "Bad env setting " ^ varval);
	78	false))
	79	\| ["E", varval] =>
	80	(case String.fields (fn ch => ch = #":") varval of
	81	[_, _] => true
	82	\| _ => (Domtool.error (path, "Bad env setting " ^ varval);
	83	false))
	84	\| _ => (Domtool.error (path, "Unknown or disallowed mod_rewrite flag " ^ f);
	85	false)
	86	in
	87	List.all checkField fields
	88	end
	89
874b616a	90	fun handler {path, domain, parent, vars, paths, users, groups, mxs} =
182a2654 AC	91	let
	92	val _ = Domtool.dprint ("Reading host " ^ path ^ " for " ^ domain ^ "....")
	93
	94	val vhosts = valOf (!vhosts)
1e2e348e	95	val loggroups = valOf (!loggroups)
182a2654	96
874b616a AC	97	val domfile = "/etc/domains/" ^ String.concatWith "/" (rev (String.tokens (fn ch => ch = #".") domain))
	98	val stat = Posix.FileSys.stat domfile
	99	val group' = Posix.SysDB.Group.name (Posix.SysDB.getgrgid (Posix.FileSys.ST.gid stat))
	100
	101	val _ = TextIO.output (loggroups, domain ^ "\t" ^ group' ^ "\n")
	102
182a2654 AC	103	val hf = TextIO.openIn path
	104	val rewrite = ref false
	105
	106	val conf = TextIO.openOut (wblConfDir ^ "/" ^ domain ^ ".conf")
	107	val _ = TextIO.output (conf, "LogFile\t" ^ logDir ^ domain ^ "-access.log\n" ^
	108	"OutputDir\t" ^ wblDocDir ^ "/" ^ domain ^ "\n" ^
	109	"HostName\t" ^ domain ^ "\n" ^
	110	"HideSite\t" ^ domain ^ "\n" ^
	111	"HideReferrer\t" ^ domain ^ "\n")
	112
	113	val dir = wblDocDir ^ "/" ^ domain
	114	val _ =
	115	if Posix.FileSys.access (dir, []) then
	116	()
	117	else
	118	Posix.FileSys.mkdir (dir, Posix.FileSys.S.flags [Posix.FileSys.S.ixoth, Posix.FileSys.S.irwxu,
	119	Posix.FileSys.S.irgrp, Posix.FileSys.S.iwgrp])
	120
	121	val htac = TextIO.openOut (dir ^ "/.htaccess")
	122	val user = ref defaultUser
	123	val group = ref defaultGroup
	124
30ac0378 AC	125	val blocked = ref []
30ac0378 AC	126
182a2654 AC	127	fun loop (line, ()) =
	128	(case String.tokens Char.isSpace line of
	129	[] => ()
	130	\| ["User", user'] =>
	131	if StringSet.member (users, user') then
	132	user := user'
	133	else
	134	Domtool.error (path, "not authorized to run as " ^ user')
	135	\| ["Group", group'] =>
	136	if StringSet.member (groups, group') then
874b616a	137	group := group'
182a2654	138	else
874b616a	139	Domtool.error (path, "not authorized to run as group " ^ group')
182a2654 AC	140	\| ["ServerAdmin", email] => TextIO.output (vhosts, "\tServerAdmin " ^ email ^ "\n")
	141	\| ["UserDir"] => TextIO.output (vhosts, "\tUserDir public_html\n\t<Directory /home//public_html/cgi-bin>\n\t\tAllowOverride None\n\t\tOptions ExecCGI\n\t\tAllow from all\n\t\tSetHandler cgi-script\n\t</Directory>\n\tScriptAliasMatch ^/~(.)/cgi-bin/(.*) /home/$1/public_html/cgi-bin/$2\n")
	142	\| ["DocumentRoot", p] =>
	143	if checkPath (paths, p) then
	144	TextIO.output (vhosts, "\tDocumentRoot " ^ p ^ "\n")
	145	else
	146	print (path ^ ": not authorized to use " ^ p ^ "\n")
05060d16 AC	147	\| "RewriteRule" :: src :: dst :: rest =>
	148	let
	149	val flags =
	150	case rest of
	151	[] => SOME ""
	152	\| [flags] => if checkRewriteArgs (path, flags) then SOME flags else NONE
	153	\| _ => (Domtool.error (path, "Invalid mod_rewrite flags in " ^ chop line); NONE)
	154	in
	155	case flags of
	156	SOME flags =>
	157	(if not (!rewrite) then
	158	(rewrite := true;
	159	TextIO.output (vhosts, "\tRewriteEngine on\n"))
	160	else
	161	();
	162	TextIO.output (vhosts, "\tRewriteRule\t" ^ src ^ " " ^ dst ^ " " ^ flags ^ "\n"))
	163	\| _ => ()
	164	end
0e2e70f2 AC	165	\| "RewriteCond" :: thing :: pat :: rest =>
	166	let
	167	val flags =
	168	case rest of
	169	[] => SOME ""
	170	\| [flags] => if checkRewriteCondArgs (path, flags) then SOME flags else NONE
	171	\| _ => (Domtool.error (path, "Invalid mod_rewrite flags in " ^ chop line); NONE)
	172	in
	173	case flags of
	174	SOME flags =>
	175	(if not (!rewrite) then
	176	(rewrite := true;
	177	TextIO.output (vhosts, "\tRewriteEngine on\n"))
	178	else
	179	();
	180	TextIO.output (vhosts, "\tRewriteCond\t" ^ thing ^ " " ^ pat ^ " " ^ flags ^ "\n"))
	181	\| _ => ()
	182	end
05060d16 AC	183	\| ["LocalProxy", src, dst, port] =>
	184	(case Int.fromString port of
	185	NONE => Domtool.error (path, "Invalid port number " ^ port)
	186	\| SOME n =>
	187	if n = 80 then
	188	Domtool.error (path, "No proxying back to Apache itself allowed")
	189	else if n <= 0 then
	190	Domtool.error (path, "Port number must be positive: " ^ port)
	191	else
1e2e348e AC	192	(if not (!rewrite) then
	193	(rewrite := true;
	194	TextIO.output (vhosts, "\tRewriteEngine on\n"))
	195	else
	196	();
	197	TextIO.output (vhosts, "\tRewriteRule\t" ^ src ^ " http://localhost:" ^ port ^ "/" ^ dst ^ " [P]\n")))
182a2654 AC	198	\| ["Alias", from, to] =>
	199	if checkPath (paths, to) then
	200	TextIO.output (vhosts, "\tAlias " ^ from ^ " " ^ to ^ "\n")
	201	else
	202	Domtool.error (path, "not authorized to use " ^ to)
	203	\| "ErrorDocument" :: code :: rest =>
	204	TextIO.output (vhosts, foldl (fn (a, s) => s ^ " " ^ a) ("\tErrorDocument " ^ code) rest ^ "\n")
	205	\| ["ScriptAlias", from, to] =>
	206	if checkPath (paths, to) then
	207	TextIO.output (vhosts, "\tScriptAlias " ^ from ^ " \"" ^ to ^ "\"\n")
	208	else
	209	Domtool.error (path, "not authorized to use " ^ to)
	210	\| ["SSI"] =>
	211	TextIO.output (vhosts, "\t<Location />\n\t\tOptions +Includes +IncludesNOEXEC\n\t</Location>\n")
	212	\| ["ServerAlias", dom] =>
	213	if validDomain dom then
	214	let
	215	val file = foldr (fn (c, s) => s ^ "/" ^ c) dataDir (String.fields (fn ch => ch = #".") dom) ^ ".aliased"
	216	in
	217	if Posix.FileSys.access (file, []) then
	218	(TextIO.output (vhosts, "\tServerAlias " ^ dom ^ "\n");
	219	TextIO.output (conf, "HideSite\t" ^ dom ^ "\n" ^
	220	"HideReferrer\t" ^ dom ^ "\n"))
	221	else
	222	Domtool.error (path, "not authorized to ServerAlias " ^ dom)
	223	end
	224	else
	225	Domtool.error (path, "bad host: " ^ dom)
	226	\| "WebalizerUsers" :: users =>
	227	TextIO.output (htac, "AuthType Basic\n" ^
	228	"AuthName \"Abulafia web account\"\n" ^
	229	"AuthUserFile " ^ passwdFile ^ "\n" ^
	230	foldl (fn (u, s) => s ^ " " ^ u) "Require user" users ^ "\n")
	231	\| ["AbuPrivate"] => TextIO.output (vhosts,
	232	"\t<Location />\n" ^
	233	"\t\tAuthName \"Abulafia web account\"\n" ^
	234	"\t\tAuthType basic\n" ^
	235	"\t\tAuthUserFile " ^ passwdFile ^ "\n" ^
	236	"\t\tRequire valid-user\n" ^
	237	"\t\tOrder Deny,Allow\n" ^
	238	"\t\tDeny from all\n" ^
	239	"\t\tAllow from 127.0.0.1\n" ^
	240	"\t\tAllow from 63.246.10.45\n" ^
	241	"\t\tSatisfy any\n" ^
	242	"\t</Location>\n")
30ac0378	243	\| ["Block", pat] => blocked := pat :: (!blocked)
182a2654 AC	244	\| ["Default"] => (TextIO.output (vhosts, "\tServerAlias " ^ parent ^ "\n");
	245	TextIO.output (conf, "HideSite\t" ^ parent ^ "\n" ^
	246	"HideReferrer\t" ^ parent ^ "\n"))
	247	\| ["CGI", p] =>
	248	if checkPath (paths, p) then
	249	TextIO.output (vhosts, "\t<Directory " ^ p ^ ">\n" ^
	250	"\t\tOptions ExecCGI\n" ^
	251	"\t\tSetHandler cgi-script\n" ^
	252	"\t</Directory>\n")
	253	else
	254	Domtool.error (path, "not authorized to use " ^ p)
874b616a AC	255	\| ["Mod", lang, p, file] =>
	256	(case List.find (fn (lang', _) => lang = lang') langHandlers of
	257	NONE => Domtool.error (p, "unknown Mod language " ^ lang)
	258	\| SOME (_, f) =>
	259	(TextIO.output (vhosts, "\t<Location " ^ p ^ ">\n");
	260	TextIO.output (vhosts, f file);
	261	TextIO.output (vhosts, "\t</Location>\n")))
182a2654 AC	262	\| ["HTML", p] =>
	263	if checkPath (paths, p) then
	264	TextIO.output (vhosts, "\t<Directory " ^ p ^ ">\n" ^
	265	"\t\tForceType text/html\n" ^
	266	"\t</Directory>\n")
	267	else
	268	Domtool.error (path, "not authorized to use " ^ p)
874b616a AC	269	\| ["PerlSetVar", n, v] =>
	270	TextIO.output (vhosts, "\tPerlSetVar " ^ n ^ " " ^ v ^ "\n")
	271	\| ["AddDefaultCharset", cs] =>
	272	TextIO.output (vhosts, "\tAddDefaultCharSet " ^ cs ^ "\n")
182a2654 AC	273	\| cmd::_ => Domtool.error (path, "unknown option: " ^ cmd))
	274	in
	275	TextIO.output (vhosts, "<VirtualHost *>\n" ^
	276	"\tServerName " ^ domain ^ "\n" ^
	277	"\tErrorLog " ^ logDir ^ domain ^ "-error.log\n" ^
	278	"\tCustomLog " ^ logDir ^ domain ^ "-access.log combined\n" ^
	279	"\tIndexOptions FancyIndexing FoldersFirst\n");
05060d16	280	ioOptLoop (fn () => Domtool.inputLine hf) loop ();
30ac0378 AC	281
	282	(case !blocked of
	283	[] => ()
	284	\| _ =>
	285	(TextIO.output (vhosts,
	286	"\t<Location />\n" ^
	287	"\t\tOrder Allow,Deny\n" ^
	288	"\t\tAllow from all\n");
	289	app (fn pat => TextIO.output (vhosts, "\t\tDeny from " ^ pat ^ "\n")) (!blocked);
	290	TextIO.output (vhosts, "\t</Location>\n")));
	291
182a2654 AC	292	TextIO.output (vhosts, "\tUser ");
	293	TextIO.output (vhosts, !user);
	294	TextIO.output (vhosts, "\n\tGroup ");
	295	TextIO.output (vhosts, !group);
	296	TextIO.output (vhosts, "\n</VirtualHost>\n\n");
	297	TextIO.closeIn hf;
	298	TextIO.closeOut conf;
	299	TextIO.closeOut htac
	300	end handle Io => Domtool.error (path, "IO error")
	301
	302	fun publish () =
	303	if OS.Process.isSuccess (OS.Process.system
	304	(diff ^ " " ^ scratchDir ^ "/vhosts.conf " ^ dataFile)) then
	305	OS.Process.success
	306	else if not (OS.Process.isSuccess (OS.Process.system
	307	(cp ^ " " ^ scratchDir ^ "/vhosts.conf " ^ dataFile))) then
	308	(print "Error copying vhosts.conf\n";
	309	OS.Process.failure)
1e2e348e AC	310	else if not (OS.Process.isSuccess (OS.Process.system pubCommand)) then
	311	(print "Error publishing vhosts.conf\n";
	312	OS.Process.failure)
	313	else if OS.Process.isSuccess (OS.Process.system logpermsCommand) then
182a2654 AC	314	OS.Process.success
182a2654 AC	315	else
1e2e348e	316	(print "Error updating log permissions\n";
182a2654 AC	317	OS.Process.failure)
	318
	319	fun mkdom _ = OS.Process.success
	320
	321	val _ = Domtool.setVhostHandler {init = init,
	322	file = handler,
	323	finish = finish,
	324	publish = publish,
	325	mkdom = mkdom}
	326	end
	327