Multiple targets for e-mail aliases
[hcoop/zz_old/domtool.git] / src / apache / apache.sml
CommitLineData
182a2654
AC
1(*
2Domtool (http://hcoop.sf.net/)
3Copyright (C) 2004 Adam Chlipala
4
5This program is free software; you can redistribute it and/or
6modify it under the terms of the GNU General Public License
7as published by the Free Software Foundation; either version 2
8of the License, or (at your option) any later version.
9
10This program is distributed in the hope that it will be useful,
11but WITHOUT ANY WARRANTY; without even the implied warranty of
12MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13GNU General Public License for more details.
14
15You should have received a copy of the GNU General Public License
16along with this program; if not, write to the Free Software
17Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
18*)
19
20(* Apache vhost management module, with Webalizer support *)
21
22structure Apache :> APACHE =
23struct
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"));
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
AC
36 val noargs = ["redirect", "R", "forbidden", "F", "gone", "G", "last", "L", "chain", "C", "nosubeq", "NS", "nocase", "NC", "qsappend", "QSA", "noescape", "NE", "passthrough", "PT"]
37
38 fun checkRewriteArgs (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 checkField f =
47 case String.fields (fn ch => ch = #"=") f of
48 [flag] => List.exists (fn x => x = flag) noargs orelse (Domtool.error (path, "Unknown argument-free flag " ^ flag);
49 false)
05060d16
AC
50 | ["type", _] => true
51 | ["T", _] => true
52 | ["skip", num] => isNat num orelse (Domtool.error (path, "Bad skip number " ^ num); false)
53 | ["S", num] => isNat num orelse (Domtool.error (path, "Bad skip number " ^ num); false)
54 | ["env", varval] =>
55 (case String.fields (fn ch => ch = #":") varval of
56 [_, _] => true
57 | _ => (Domtool.error (path, "Bad env setting " ^ varval);
58 false))
59 | ["E", varval] =>
60 (case String.fields (fn ch => ch = #":") varval of
61 [_, _] => true
62 | _ => (Domtool.error (path, "Bad env setting " ^ varval);
63 false))
64 | _ => (Domtool.error (path, "Unknown or disallowed mod_rewrite flag " ^ f);
65 false)
66 in
67 List.all checkField fields
68 end
69
182a2654
AC
70 fun handler {path, domain, parent, vars, paths, users, groups} =
71 let
72 val _ = Domtool.dprint ("Reading host " ^ path ^ " for " ^ domain ^ "....")
73
74 val vhosts = valOf (!vhosts)
1e2e348e 75 val loggroups = valOf (!loggroups)
182a2654
AC
76
77 val hf = TextIO.openIn path
78 val rewrite = ref false
79
80 val conf = TextIO.openOut (wblConfDir ^ "/" ^ domain ^ ".conf")
81 val _ = TextIO.output (conf, "LogFile\t" ^ logDir ^ domain ^ "-access.log\n" ^
82 "OutputDir\t" ^ wblDocDir ^ "/" ^ domain ^ "\n" ^
83 "HostName\t" ^ domain ^ "\n" ^
84 "HideSite\t" ^ domain ^ "\n" ^
85 "HideReferrer\t" ^ domain ^ "\n")
86
87 val dir = wblDocDir ^ "/" ^ domain
88 val _ =
89 if Posix.FileSys.access (dir, []) then
90 ()
91 else
92 Posix.FileSys.mkdir (dir, Posix.FileSys.S.flags [Posix.FileSys.S.ixoth, Posix.FileSys.S.irwxu,
93 Posix.FileSys.S.irgrp, Posix.FileSys.S.iwgrp])
94
95 val htac = TextIO.openOut (dir ^ "/.htaccess")
96 val user = ref defaultUser
97 val group = ref defaultGroup
98
99 fun loop (line, ()) =
100 (case String.tokens Char.isSpace line of
101 [] => ()
102 | ["User", user'] =>
103 if StringSet.member (users, user') then
104 user := user'
105 else
106 Domtool.error (path, "not authorized to run as " ^ user')
107 | ["Group", group'] =>
108 if StringSet.member (groups, group') then
1e2e348e
AC
109 (group := group';
110 TextIO.output (loggroups, domain ^ "\t" ^ group' ^ "\n"))
182a2654
AC
111 else
112 Domtool.error (path, "not authorized to run as group " ^ group')
113 | ["ServerAdmin", email] => TextIO.output (vhosts, "\tServerAdmin " ^ email ^ "\n")
114 | ["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")
115 | ["DocumentRoot", p] =>
116 if checkPath (paths, p) then
117 TextIO.output (vhosts, "\tDocumentRoot " ^ p ^ "\n")
118 else
119 print (path ^ ": not authorized to use " ^ p ^ "\n")
05060d16
AC
120 | "RewriteRule" :: src :: dst :: rest =>
121 let
122 val flags =
123 case rest of
124 [] => SOME ""
125 | [flags] => if checkRewriteArgs (path, flags) then SOME flags else NONE
126 | _ => (Domtool.error (path, "Invalid mod_rewrite flags in " ^ chop line); NONE)
127 in
128 case flags of
129 SOME flags =>
130 (if not (!rewrite) then
131 (rewrite := true;
132 TextIO.output (vhosts, "\tRewriteEngine on\n"))
133 else
134 ();
135 TextIO.output (vhosts, "\tRewriteRule\t" ^ src ^ " " ^ dst ^ " " ^ flags ^ "\n"))
136 | _ => ()
137 end
138 | ["LocalProxy", src, dst, port] =>
139 (case Int.fromString port of
140 NONE => Domtool.error (path, "Invalid port number " ^ port)
141 | SOME n =>
142 if n = 80 then
143 Domtool.error (path, "No proxying back to Apache itself allowed")
144 else if n <= 0 then
145 Domtool.error (path, "Port number must be positive: " ^ port)
146 else
1e2e348e
AC
147 (if not (!rewrite) then
148 (rewrite := true;
149 TextIO.output (vhosts, "\tRewriteEngine on\n"))
150 else
151 ();
152 TextIO.output (vhosts, "\tRewriteRule\t" ^ src ^ " http://localhost:" ^ port ^ "/" ^ dst ^ " [P]\n")))
182a2654
AC
153 | ["Alias", from, to] =>
154 if checkPath (paths, to) then
155 TextIO.output (vhosts, "\tAlias " ^ from ^ " " ^ to ^ "\n")
156 else
157 Domtool.error (path, "not authorized to use " ^ to)
158 | "ErrorDocument" :: code :: rest =>
159 TextIO.output (vhosts, foldl (fn (a, s) => s ^ " " ^ a) ("\tErrorDocument " ^ code) rest ^ "\n")
160 | ["ScriptAlias", from, to] =>
161 if checkPath (paths, to) then
162 TextIO.output (vhosts, "\tScriptAlias " ^ from ^ " \"" ^ to ^ "\"\n")
163 else
164 Domtool.error (path, "not authorized to use " ^ to)
165 | ["SSI"] =>
166 TextIO.output (vhosts, "\t<Location />\n\t\tOptions +Includes +IncludesNOEXEC\n\t</Location>\n")
167 | ["ServerAlias", dom] =>
168 if validDomain dom then
169 let
170 val file = foldr (fn (c, s) => s ^ "/" ^ c) dataDir (String.fields (fn ch => ch = #".") dom) ^ ".aliased"
171 in
172 if Posix.FileSys.access (file, []) then
173 (TextIO.output (vhosts, "\tServerAlias " ^ dom ^ "\n");
174 TextIO.output (conf, "HideSite\t" ^ dom ^ "\n" ^
175 "HideReferrer\t" ^ dom ^ "\n"))
176 else
177 Domtool.error (path, "not authorized to ServerAlias " ^ dom)
178 end
179 else
180 Domtool.error (path, "bad host: " ^ dom)
181 | "WebalizerUsers" :: users =>
182 TextIO.output (htac, "AuthType Basic\n" ^
183 "AuthName \"Abulafia web account\"\n" ^
184 "AuthUserFile " ^ passwdFile ^ "\n" ^
185 foldl (fn (u, s) => s ^ " " ^ u) "Require user" users ^ "\n")
186 | ["AbuPrivate"] => TextIO.output (vhosts,
187 "\t<Location />\n" ^
188 "\t\tAuthName \"Abulafia web account\"\n" ^
189 "\t\tAuthType basic\n" ^
190 "\t\tAuthUserFile " ^ passwdFile ^ "\n" ^
191 "\t\tRequire valid-user\n" ^
192 "\t\tOrder Deny,Allow\n" ^
193 "\t\tDeny from all\n" ^
194 "\t\tAllow from 127.0.0.1\n" ^
195 "\t\tAllow from 63.246.10.45\n" ^
196 "\t\tSatisfy any\n" ^
197 "\t</Location>\n")
198 | ["Default"] => (TextIO.output (vhosts, "\tServerAlias " ^ parent ^ "\n");
199 TextIO.output (conf, "HideSite\t" ^ parent ^ "\n" ^
200 "HideReferrer\t" ^ parent ^ "\n"))
201 | ["CGI", p] =>
202 if checkPath (paths, p) then
203 TextIO.output (vhosts, "\t<Directory " ^ p ^ ">\n" ^
204 "\t\tOptions ExecCGI\n" ^
205 "\t\tSetHandler cgi-script\n" ^
206 "\t</Directory>\n")
207 else
208 Domtool.error (path, "not authorized to use " ^ p)
209 | ["HTML", p] =>
210 if checkPath (paths, p) then
211 TextIO.output (vhosts, "\t<Directory " ^ p ^ ">\n" ^
212 "\t\tForceType text/html\n" ^
213 "\t</Directory>\n")
214 else
215 Domtool.error (path, "not authorized to use " ^ p)
216 | cmd::_ => Domtool.error (path, "unknown option: " ^ cmd))
217 in
218 TextIO.output (vhosts, "<VirtualHost *>\n" ^
219 "\tServerName " ^ domain ^ "\n" ^
220 "\tErrorLog " ^ logDir ^ domain ^ "-error.log\n" ^
221 "\tCustomLog " ^ logDir ^ domain ^ "-access.log combined\n" ^
222 "\tIndexOptions FancyIndexing FoldersFirst\n");
05060d16 223 ioOptLoop (fn () => Domtool.inputLine hf) loop ();
182a2654
AC
224 TextIO.output (vhosts, "\tUser ");
225 TextIO.output (vhosts, !user);
226 TextIO.output (vhosts, "\n\tGroup ");
227 TextIO.output (vhosts, !group);
228 TextIO.output (vhosts, "\n</VirtualHost>\n\n");
229 TextIO.closeIn hf;
230 TextIO.closeOut conf;
231 TextIO.closeOut htac
232 end handle Io => Domtool.error (path, "IO error")
233
234 fun publish () =
235 if OS.Process.isSuccess (OS.Process.system
236 (diff ^ " " ^ scratchDir ^ "/vhosts.conf " ^ dataFile)) then
237 OS.Process.success
238 else if not (OS.Process.isSuccess (OS.Process.system
239 (cp ^ " " ^ scratchDir ^ "/vhosts.conf " ^ dataFile))) then
240 (print "Error copying vhosts.conf\n";
241 OS.Process.failure)
1e2e348e
AC
242 else if not (OS.Process.isSuccess (OS.Process.system pubCommand)) then
243 (print "Error publishing vhosts.conf\n";
244 OS.Process.failure)
245 else if OS.Process.isSuccess (OS.Process.system logpermsCommand) then
182a2654
AC
246 OS.Process.success
247 else
1e2e348e 248 (print "Error updating log permissions\n";
182a2654
AC
249 OS.Process.failure)
250
251 fun mkdom _ = OS.Process.success
252
253 val _ = Domtool.setVhostHandler {init = init,
254 file = handler,
255 finish = finish,
256 publish = publish,
257 mkdom = mkdom}
258end
259