[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)

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

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

	    val vhosts = valOf (!vhosts)

	    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

	    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" :: args =>
		     (if not (!rewrite) then
			  (rewrite := true;
			   TextIO.output (vhosts, "\tRewriteEngine on\n"))
		      else
			  ();
			  TextIO.output (vhosts, foldl (fn (a, s) => s ^ " " ^ a) "\tRewriteRule" args ^ "\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")
		   | ["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)
		   | ["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)
		   | 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");
	    ioLoop (fn () => Domtool.inputLine hf) loop ();
	    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 OS.Process.isSuccess (OS.Process.system pubCommand) then
	    OS.Process.success
	else
	    (print "Error publishing vhosts.conf\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)
	27
	28	fun init () = vhosts := SOME (TextIO.openOut (scratchDir ^ "/vhosts.conf"))
	29	fun finish () = (TextIO.closeOut (valOf (!vhosts));
	30	vhosts := NONE)
	31
	32	fun handler {path, domain, parent, vars, paths, users, groups} =
	33	let
	34	val _ = Domtool.dprint ("Reading host " ^ path ^ " for " ^ domain ^ "....")
	35
	36	val vhosts = valOf (!vhosts)
	37
	38	val hf = TextIO.openIn path
	39	val rewrite = ref false
	40
	41	val conf = TextIO.openOut (wblConfDir ^ "/" ^ domain ^ ".conf")
	42	val _ = TextIO.output (conf, "LogFile\t" ^ logDir ^ domain ^ "-access.log\n" ^
	43	"OutputDir\t" ^ wblDocDir ^ "/" ^ domain ^ "\n" ^
	44	"HostName\t" ^ domain ^ "\n" ^
	45	"HideSite\t" ^ domain ^ "\n" ^
	46	"HideReferrer\t" ^ domain ^ "\n")
	47
	48	val dir = wblDocDir ^ "/" ^ domain
	49	val _ =
	50	if Posix.FileSys.access (dir, []) then
	51	()
	52	else
	53	Posix.FileSys.mkdir (dir, Posix.FileSys.S.flags [Posix.FileSys.S.ixoth, Posix.FileSys.S.irwxu,
	54	Posix.FileSys.S.irgrp, Posix.FileSys.S.iwgrp])
	55
	56	val htac = TextIO.openOut (dir ^ "/.htaccess")
	57	val user = ref defaultUser
	58	val group = ref defaultGroup
	59
	60	fun loop (line, ()) =
	61	(case String.tokens Char.isSpace line of
	62	[] => ()
	63	\| ["User", user'] =>
	64	if StringSet.member (users, user') then
65	user := user'
66	else
67	Domtool.error (path, "not authorized to run as " ^ user')
68	\| ["Group", group'] =>
69	if StringSet.member (groups, group') then
70	group := group'
71	else
72	Domtool.error (path, "not authorized to run as group " ^ group')
73	\| ["ServerAdmin", email] => TextIO.output (vhosts, "\tServerAdmin " ^ email ^ "\n")
74	\| ["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")
75	\| ["DocumentRoot", p] =>
76	if checkPath (paths, p) then
77	TextIO.output (vhosts, "\tDocumentRoot " ^ p ^ "\n")
78	else
79	print (path ^ ": not authorized to use " ^ p ^ "\n")
80	\| "RewriteRule" :: args =>
81	(if not (!rewrite) then
82	(rewrite := true;
83	TextIO.output (vhosts, "\tRewriteEngine on\n"))
84	else
85	();
86	TextIO.output (vhosts, foldl (fn (a, s) => s ^ " " ^ a) "\tRewriteRule" args ^ "\n"))
87	\| ["Alias", from, to] =>
88	if checkPath (paths, to) then
89	TextIO.output (vhosts, "\tAlias " ^ from ^ " " ^ to ^ "\n")
90	else
91	Domtool.error (path, "not authorized to use " ^ to)
92	\| "ErrorDocument" :: code :: rest =>
93	TextIO.output (vhosts, foldl (fn (a, s) => s ^ " " ^ a) ("\tErrorDocument " ^ code) rest ^ "\n")
94	\| ["ScriptAlias", from, to] =>
95	if checkPath (paths, to) then
96	TextIO.output (vhosts, "\tScriptAlias " ^ from ^ " \"" ^ to ^ "\"\n")
97	else
98	Domtool.error (path, "not authorized to use " ^ to)
99	\| ["SSI"] =>
100	TextIO.output (vhosts, "\t<Location />\n\t\tOptions +Includes +IncludesNOEXEC\n\t</Location>\n")
101	\| ["ServerAlias", dom] =>
102	if validDomain dom then
103	let
104	val file = foldr (fn (c, s) => s ^ "/" ^ c) dataDir (String.fields (fn ch => ch = #".") dom) ^ ".aliased"
105	in
106	if Posix.FileSys.access (file, []) then
107	(TextIO.output (vhosts, "\tServerAlias " ^ dom ^ "\n");
108	TextIO.output (conf, "HideSite\t" ^ dom ^ "\n" ^
109	"HideReferrer\t" ^ dom ^ "\n"))
110	else
111	Domtool.error (path, "not authorized to ServerAlias " ^ dom)
112	end
113	else
114	Domtool.error (path, "bad host: " ^ dom)
115	\| "WebalizerUsers" :: users =>
116	TextIO.output (htac, "AuthType Basic\n" ^
117	"AuthName \"Abulafia web account\"\n" ^
118	"AuthUserFile " ^ passwdFile ^ "\n" ^
119	foldl (fn (u, s) => s ^ " " ^ u) "Require user" users ^ "\n")
120	\| ["AbuPrivate"] => TextIO.output (vhosts,
121	"\t<Location />\n" ^
122	"\t\tAuthName \"Abulafia web account\"\n" ^
123	"\t\tAuthType basic\n" ^
124	"\t\tAuthUserFile " ^ passwdFile ^ "\n" ^
125	"\t\tRequire valid-user\n" ^
126	"\t\tOrder Deny,Allow\n" ^
127	"\t\tDeny from all\n" ^
128	"\t\tAllow from 127.0.0.1\n" ^
129	"\t\tAllow from 63.246.10.45\n" ^
130	"\t\tSatisfy any\n" ^
131	"\t</Location>\n")
132	\| ["Default"] => (TextIO.output (vhosts, "\tServerAlias " ^ parent ^ "\n");
133	TextIO.output (conf, "HideSite\t" ^ parent ^ "\n" ^
134	"HideReferrer\t" ^ parent ^ "\n"))
135	\| ["CGI", p] =>
136	if checkPath (paths, p) then
137	TextIO.output (vhosts, "\t<Directory " ^ p ^ ">\n" ^
138	"\t\tOptions ExecCGI\n" ^
139	"\t\tSetHandler cgi-script\n" ^
140	"\t</Directory>\n")
141	else
142	Domtool.error (path, "not authorized to use " ^ p)
143	\| ["HTML", p] =>
144	if checkPath (paths, p) then
145	TextIO.output (vhosts, "\t<Directory " ^ p ^ ">\n" ^
146	"\t\tForceType text/html\n" ^
147	"\t</Directory>\n")
148	else
149	Domtool.error (path, "not authorized to use " ^ p)
150	\| cmd::_ => Domtool.error (path, "unknown option: " ^ cmd))
151	in
152	TextIO.output (vhosts, "<VirtualHost *>\n" ^
153	"\tServerName " ^ domain ^ "\n" ^
154	"\tErrorLog " ^ logDir ^ domain ^ "-error.log\n" ^
155	"\tCustomLog " ^ logDir ^ domain ^ "-access.log combined\n" ^
156	"\tIndexOptions FancyIndexing FoldersFirst\n");
157	ioLoop (fn () => Domtool.inputLine hf) loop ();
158	TextIO.output (vhosts, "\tUser ");
159	TextIO.output (vhosts, !user);
160	TextIO.output (vhosts, "\n\tGroup ");
161	TextIO.output (vhosts, !group);
162	TextIO.output (vhosts, "\n</VirtualHost>\n\n");
163	TextIO.closeIn hf;
164	TextIO.closeOut conf;
165	TextIO.closeOut htac
166	end handle Io => Domtool.error (path, "IO error")
167
168	fun publish () =
169	if OS.Process.isSuccess (OS.Process.system
170	(diff ^ " " ^ scratchDir ^ "/vhosts.conf " ^ dataFile)) then
171	OS.Process.success
172	else if not (OS.Process.isSuccess (OS.Process.system
173	(cp ^ " " ^ scratchDir ^ "/vhosts.conf " ^ dataFile))) then
174	(print "Error copying vhosts.conf\n";
175	OS.Process.failure)
176	else if OS.Process.isSuccess (OS.Process.system pubCommand) then
177	OS.Process.success
178	else
179	(print "Error publishing vhosts.conf\n";
180	OS.Process.failure)
181
182	fun mkdom _ = OS.Process.success
183
184	val _ = Domtool.setVhostHandler {init = init,
185	file = handler,
186	finish = finish,
187	publish = publish,
188	mkdom = mkdom}
189	end
190