HCoop / hcoop / zz_old / domtool.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Better checking of Block arguments
[hcoop/zz_old/domtool.git] / src / apache / apache.sml
CommitLineData
182a2654
AC		 1(*
2Domtool (http://hcoop.sf.net/)
a73d8039 3Copyright (C) 2004-2006 Adam Chlipala
182a2654
AC		 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 36 val noargs = ["redirect", "R", "forbidden", "F", "gone", "G", "last", "L", "chain", "C", "nosubeq", "NS", "nocase", "NC", "qsappend", "QSA", "noescape", "NE", "passthrough", "PT"]
5958a619
AC		 37
38 val redirect_codes = ["temp", "permanent", "seeother", "300", "301", "302", "303", "304", "305", "307"]
227cff0f
AC		 39
40 val index_options = ["FoldersFirst", "SuppressColumnSorting"]
0e2e70f2
AC		 41
42 fun checkRewriteCondArgs (path, args) =
43 if size args < 2 orelse String.sub (args, 0) <> #"[" orelse String.sub (args, size args - 1) <> #"]" then
44 (Domtool.error (path, "Not in brackets: " ^ args);
45 false)
46 else let
47 val args = String.substring (args, 1, size args - 2)
48 val fields = String.fields (fn ch => ch = #",") args
49
50 fun checkOne f =
51 case f of
52 "nocase" => true
53 | "NC" => true
54 | "ornext" => true
55 | "OR" => true
56 | _ => false
57 in
58 List.all checkOne fields
59 end
60
61
05060d16
AC		 62 fun checkRewriteArgs (path, args) =
63 if size args < 2 orelse String.sub (args, 0) <> #"[" orelse String.sub (args, size args - 1) <> #"]" then
64 (Domtool.error (path, "Not in brackets: " ^ args);
65 false)
66 else let
67 val args = String.substring (args, 1, size args - 2)
68 val fields = String.fields (fn ch => ch = #",") args
69
70 fun checkField f =
71 case String.fields (fn ch => ch = #"=") f of
72 [flag] => List.exists (fn x => x = flag) noargs orelse (Domtool.error (path, "Unknown argument-free flag " ^ flag);
73 false)
05060d16
AC		 74 | ["type", _] => true
75 | ["T", _] => true
5958a619
AC		 76 | ["rewrite", num] => List.exists (fn s => s = num) redirect_codes
77 orelse (Domtool.error (path, "Bad redirect response code " ^ num); false)
78 | ["R", num] => List.exists (fn s => s = num) redirect_codes
79 orelse (Domtool.error (path, "Bad redirect response code " ^ num); false)
05060d16
AC		 80 | ["skip", num] => isNat num orelse (Domtool.error (path, "Bad skip number " ^ num); false)
81 | ["S", num] => isNat num orelse (Domtool.error (path, "Bad skip number " ^ num); false)
82 | ["env", varval] =>
83 (case String.fields (fn ch => ch = #":") varval of
84 [_, _] => true
85 | _ => (Domtool.error (path, "Bad env setting " ^ varval);
86 false))
87 | ["E", varval] =>
88 (case String.fields (fn ch => ch = #":") varval of
89 [_, _] => true
90 | _ => (Domtool.error (path, "Bad env setting " ^ varval);
91 false))
92 | _ => (Domtool.error (path, "Unknown or disallowed mod_rewrite flag " ^ f);
93 false)
94 in
95 List.all checkField fields
96 end
97
c6544086
AC		 98 fun validDenyMask s =
99 let
100 val fs = String.fields (fn ch => ch = #".") s
101 in
102 (length fs <= 4 andalso List.all (fn s => case Int.fromString s of
103 SOME n => n >= 0 andalso n < 256
104 | NONE => false) fs)
105 orelse validDomain s
106 end
107
c79bcdbc 108 fun handler (data : Domtool.handlerData) =
182a2654 109 let
c79bcdbc
AC		 110 val path = #path data
111 val domain = #domain data
112 val users = #users data
113 val groups = #groups data
114 val paths = #paths data
115 val parent = #parent data
116 val certs = #certs data
117
182a2654
AC		 118 val _ = Domtool.dprint ("Reading host " ^ path ^ " for " ^ domain ^ "....")
119
4d3abed7
AC		 120 val (ssl, port, path', domainId, domain', prefix) =
121 if size path >= 4 andalso String.extract (path, size path - 4, NONE) = ".ssl" then
122 let
123 val (domain', domain) =
124 case String.tokens (fn ch => ch = #".") domain of
125 d::_::rest => (String.concatWith "." (d::rest),
126 String.concatWith "." ((d ^ "_ssl")::rest))
127 | _ => (domain, domain)
128 in
129 (true, httpsPort, String.substring (path, 0, size path - 4),
130 domain, domain', "https")
131 end
132 else
133 (false, httpPort, path, domain, domain, "http")
134
182a2654 135 val vhosts = valOf (!vhosts)
1e2e348e 136 val loggroups = valOf (!loggroups)
182a2654 137
4d3abed7 138 val domfile = path
874b616a
AC		 139 val stat = Posix.FileSys.stat domfile
140 val group' = Posix.SysDB.Group.name (Posix.SysDB.getgrgid (Posix.FileSys.ST.gid stat))
141
1dd685ff
AC		 142 val _ = TextIO.output (loggroups, domainId ^ "\t" ^ group' ^ "\n")
143
144 val domLogDir = logDir ^ domainId
145 val _ =
146 if Posix.FileSys.access (domLogDir, []) then
147 ()
148 else
149 ignore (OS.Process.system (sudo ^ " " ^ mklogdir ^ " " ^ domainId))
874b616a 150
182a2654
AC		 151 val hf = TextIO.openIn path
152 val rewrite = ref false
a73d8039 153 val rewriteLocal = ref false
182a2654 154
4d3abed7 155 val conf = TextIO.openOut (wblConfDir ^ "/" ^ domainId ^ ".conf")
1dd685ff 156 val _ = TextIO.output (conf, "LogFile\t" ^ domLogDir ^ "/access.log\n" ^
4d3abed7
AC		 157 "OutputDir\t" ^ wblDocDir ^ "/" ^ domainId ^ "\n" ^
158 "HostName\t" ^ domain' ^ "\n" ^
159 "HideSite\t" ^ domain' ^ "\n" ^
160 "HideReferrer\t" ^ domain' ^ "\n")
182a2654 161
4d3abed7 162 val dir = wblDocDir ^ "/" ^ domainId
182a2654
AC		 163 val _ =
164 if Posix.FileSys.access (dir, []) then
165 ()
166 else
db5910c4
AC		 167 Posix.FileSys.mkdir (dir, Posix.FileSys.S.flags [Posix.FileSys.S.iroth, Posix.FileSys.S.ixoth,
168 Posix.FileSys.S.irwxu,
182a2654
AC		 169 Posix.FileSys.S.irgrp, Posix.FileSys.S.iwgrp])
170
171 val htac = TextIO.openOut (dir ^ "/.htaccess")
db5910c4
AC		 172 val user = ref (getOpt (StringSet.find (fn _ => true) users, defaultUser))
173 val group = ref (getOpt (StringSet.find (fn _ => true) groups, defaultGroup))
6ebfb304 174 val scripts = ref false
4d3abed7 175 val cert = ref false
182a2654 176
30ac0378 177 val blocked = ref []
db5910c4 178 val docroot = ref NONE
368cc49c
AC		 179 val openLocation = ref false
180 val openDirectory = ref false
30ac0378 181
29d1e9fe
AC		 182 local
183 val fixup = ref false
184 in
185 fun checkFixup () =
186 if !fixup then
187 ()
188 else
189 (fixup := true;
190 TextIO.output (vhosts, "\tPerlFixupHandler Apache::PerlVINC\n");
191 TextIO.output (vhosts, "\tPerlCleanupHandler Apache::PerlVINC\n"))
192 end
193
6ebfb304 194 fun checkRewrite () =
a73d8039
AC		 195 if !openLocation orelse !openDirectory then
196 if not (!rewrite) andalso not (!rewriteLocal) then
197 (rewriteLocal := true;
198 TextIO.output (vhosts, "\tRewriteEngine on\n"))
199 else
200 ()
201 else if not (!rewrite) then
6ebfb304
AC		 202 (rewrite := true;
203 TextIO.output (vhosts, "\tRewriteEngine on\n"))
204 else
205 ()
206
182a2654
AC		 207 fun loop (line, ()) =
208 (case String.tokens Char.isSpace line of
209 [] => ()
210 | ["User", user'] =>
211 if StringSet.member (users, user') then
212 user := user'
213 else
214 Domtool.error (path, "not authorized to run as " ^ user')
215 | ["Group", group'] =>
216 if StringSet.member (groups, group') then
874b616a 217 group := group'
182a2654 218 else
874b616a 219 Domtool.error (path, "not authorized to run as group " ^ group')
182a2654 220 | ["ServerAdmin", email] => TextIO.output (vhosts, "\tServerAdmin " ^ email ^ "\n")
6ebfb304 221 (*| ["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")*)
182a2654
AC		 222 | ["DocumentRoot", p] =>
223 if checkPath (paths, p) then
db5910c4
AC		 224 (docroot := SOME p;
225 TextIO.output (vhosts, "\tDocumentRoot " ^ p ^ "\n"))
182a2654
AC		 226 else
227 print (path ^ ": not authorized to use " ^ p ^ "\n")
05060d16
AC		 228 | "RewriteRule" :: src :: dst :: rest =>
229 let
230 val flags =
231 case rest of
232 [] => SOME ""
233 | [flags] => if checkRewriteArgs (path, flags) then SOME flags else NONE
234 | _ => (Domtool.error (path, "Invalid mod_rewrite flags in " ^ chop line); NONE)
235 in
236 case flags of
237 SOME flags =>
6ebfb304 238 (checkRewrite ();
05060d16
AC		 239 TextIO.output (vhosts, "\tRewriteRule\t" ^ src ^ " " ^ dst ^ " " ^ flags ^ "\n"))
240 | _ => ()
241 end
0e2e70f2
AC		 242 | "RewriteCond" :: thing :: pat :: rest =>
243 let
244 val flags =
245 case rest of
246 [] => SOME ""
247 | [flags] => if checkRewriteCondArgs (path, flags) then SOME flags else NONE
248 | _ => (Domtool.error (path, "Invalid mod_rewrite flags in " ^ chop line); NONE)
249 in
250 case flags of
251 SOME flags =>
6ebfb304 252 (checkRewrite ();
0e2e70f2
AC		 253 TextIO.output (vhosts, "\tRewriteCond\t" ^ thing ^ " " ^ pat ^ " " ^ flags ^ "\n"))
254 | _ => ()
255 end
75e3f04c 256 | ["RewriteBase", url] =>
2d869189
AC		 257 if !openDirectory then
258 (checkRewrite ();
259 TextIO.output (vhosts, "\tRewriteBase\t" ^ url ^ "\n"))
260 else
261 Domtool.error (path, "RewriteBase is only allowed inside a Directory block")
05060d16
AC		 262 | ["LocalProxy", src, dst, port] =>
263 (case Int.fromString port of
264 NONE => Domtool.error (path, "Invalid port number " ^ port)
265 | SOME n =>
368cc49c 266 if n = 80 orelse n = 443 then
05060d16
AC		 267 Domtool.error (path, "No proxying back to Apache itself allowed")
268 else if n <= 0 then
269 Domtool.error (path, "Port number must be positive: " ^ port)
270 else
6ebfb304
AC		 271 (checkRewrite ();
272 TextIO.output (vhosts, "\tRewriteRule\t" ^ src ^ " http://localhost:" ^ port ^ "/" ^ dst ^ " [P]\n")))
368cc49c
AC		 273 | ["LocalProxyPass", src, dst, port] =>
274 (case Int.fromString port of
275 NONE => Domtool.error (path, "Invalid port number " ^ port)
276 | SOME n =>
277 if n = 80 orelse n = 443 then
278 Domtool.error (path, "No proxying back to Apache itself allowed")
279 else if n <= 0 then
280 Domtool.error (path, "Port number must be positive: " ^ port)
281 else if String.sub (dst, 0) <> #"/" then
282 Domtool.error (path, "Destination must start with /")
283 else
284 (TextIO.output (vhosts, "\tProxyPass\t" ^ src ^ " http://localhost:" ^ port ^ dst ^ "\n");
285 TextIO.output (vhosts, "\tProxyPassReverse\t" ^ src ^ " http://localhost:" ^ port ^ dst ^ "\n")))
29d1e9fe 286 | ["Mailman"] =>
6ebfb304 287 (checkRewrite ();
4d3abed7 288 TextIO.output (vhosts, "\tRewriteRule\t^/cgi-bin/mailman/(.*)$ " ^ mailmanPrefix ^ "/$1 [P]\n");
db5910c4
AC		 289 TextIO.output (vhosts, "\tRewriteRule\t^/pipermail/(.*)$ " ^ pipermailPrefix ^ "/$1 [P]\n");
290 TextIO.output (vhosts, "\nAlias\t/doc/mailman\t/usr/share/doc/mailman\n"))
182a2654
AC		 291 | ["Alias", from, to] =>
292 if checkPath (paths, to) then
293 TextIO.output (vhosts, "\tAlias " ^ from ^ " " ^ to ^ "\n")
294 else
295 Domtool.error (path, "not authorized to use " ^ to)
296 | "ErrorDocument" :: code :: rest =>
297 TextIO.output (vhosts, foldl (fn (a, s) => s ^ " " ^ a) ("\tErrorDocument " ^ code) rest ^ "\n")
db5910c4 298 (*| ["Script", from, to] =>
6ebfb304
AC		 299 (if !scripts then
300 ()
301 else
302 (scripts := true;
303 TextIO.output (vhosts, "\tUserDir disabled\n");
304 TextIO.output (vhosts, "\tUserDir enabled " ^ !user ^ "\n");
305 TextIO.output (vhosts, "\t<Directory /home/" ^ !user ^ "/public_html/cgi-bin/>\n\t\tOptions ExecCGI\n\t\tSetHandler cgi-script\n\t</Directory>\n"));
306 checkRewrite ();
db5910c4 307 TextIO.output (vhosts, "\tRewriteRule\t^/" ^ from ^ "(.* )$ " ^ prefix ^ "://" ^ domain' ^ "/~" ^ !user ^ "/cgi-bin/" ^ to ^ "$1 [P]\n"))*)
6ebfb304 308 | ["MoinMoin", from, to] =>
db5910c4
AC		 309 if checkPath (paths, to) then
310 (TextIO.output (vhosts, "\tScriptAlias /" ^ from ^ " " ^ to ^ "\n");
311 TextIO.output (vhosts, "\tAlias /moin /usr/share/moin/htdocs\n"))
312 else
313 Domtool.error (path, "not authorized to use " ^ to)
314 | ["ScriptAlias", from, to] =>
182a2654
AC		 315 if checkPath (paths, to) then
316 TextIO.output (vhosts, "\tScriptAlias " ^ from ^ " \"" ^ to ^ "\"\n")
317 else
db5910c4 318 Domtool.error (path, "not authorized to use " ^ to)
182a2654 319 | ["SSI"] =>
368cc49c 320 TextIO.output (vhosts, "\tOptions +Includes +IncludesNOEXEC\n\tDirectoryIndex index.shtml index.html index.cgi index.pl index.php index.xhtml\n")
c6bb71af
AC		 321 | ["XBitHack", mode] =>
322 if mode = "on" orelse mode = "off" orelse mode = "full" then
323 TextIO.output (vhosts, "\tXBitHack " ^ mode ^ "\n")
324 else
325 Domtool.error (path, "invalid XBitHack argument")
182a2654
AC		 326 | ["ServerAlias", dom] =>
327 if validDomain dom then
328 let
329 val file = foldr (fn (c, s) => s ^ "/" ^ c) dataDir (String.fields (fn ch => ch = #".") dom) ^ ".aliased"
330 in
331 if Posix.FileSys.access (file, []) then
332 (TextIO.output (vhosts, "\tServerAlias " ^ dom ^ "\n");
333 TextIO.output (conf, "HideSite\t" ^ dom ^ "\n" ^
334 "HideReferrer\t" ^ dom ^ "\n"))
335 else
336 Domtool.error (path, "not authorized to ServerAlias " ^ dom)
337 end
338 else
339 Domtool.error (path, "bad host: " ^ dom)
340 | "WebalizerUsers" :: users =>
341 TextIO.output (htac, "AuthType Basic\n" ^
342 "AuthName \"Abulafia web account\"\n" ^
343 "AuthUserFile " ^ passwdFile ^ "\n" ^
344 foldl (fn (u, s) => s ^ " " ^ u) "Require user" users ^ "\n")
368cc49c
AC		 345 | ["Location", url] =>
346 if !openLocation orelse !openDirectory then
347 TextIO.output (vhosts, "you must end the last Location/Directory before starting a new one")
348 else if validLocation url then
349 (openLocation := true;
350 TextIO.output (vhosts, "\t<Location " ^ url ^ ">\n"))
351 else
352 Domtool.error (path, "bad URL: " ^ url)
353 | ["/Location"] =>
354 if !openLocation then
355 (openLocation := false;
a73d8039 356 rewriteLocal := false;
368cc49c
AC		 357 TextIO.output (vhosts, "\t</Location>\n"))
358 else
359 Domtool.error (path, "there is no open Location to end")
360 | ["Directory", p] =>
361 if !openLocation orelse !openDirectory then
362 TextIO.output (vhosts, "you must end the last Location/Directory before starting a new one")
363 else if checkPath (paths, p) then
364 (openDirectory := true;
365 TextIO.output (vhosts, "\t<Directory " ^ p ^ ">\n"))
374cfc56 366 else
0d70f328 367 Domtool.error (path, "not authorized to use " ^ p)
368cc49c
AC		 368 | ["/Directory"] =>
369 if !openDirectory then
370 (openDirectory := false;
a73d8039 371 rewriteLocal := false;
368cc49c
AC		 372 TextIO.output (vhosts, "\t</Directory>\n"))
373 else
374 Domtool.error (path, "there is no open Directry to end")
375 | ("BasicAuth" :: userFile :: name) =>
376 if not (!openLocation orelse !openDirectory) then
377 Domtool.error (path, "can only use BasicAuth inside Location/Directory")
378 else if not (checkPath (paths, userFile)) then
379 Domtool.error (path, "not authorized to use " ^ userFile)
380 else
381 TextIO.output (vhosts,
382 String.concat ["\tAuthType basic\n",
383 "\tAuthName \"", String.toString (String.concatWith " " name), "\"\n",
384 "\tAuthUserFile ", userFile, "\n"])
385
386 | ["Require", "valid-user"] =>
387 if not (!openLocation orelse !openDirectory) then
388 Domtool.error (path, "can only use Require inside Location/Directory")
389 else
390 TextIO.output (vhosts, "\tRequire valid-user\n")
391 | ("Require" :: "user" :: (users as (_::_))) =>
392 if not (!openLocation orelse !openDirectory) then
393 Domtool.error (path, "can only use Require inside Location/Directory")
394 else if List.exists (fn u => not (validUser u)) users then
395 Domtool.error (path, "invalid username")
396 else
397 TextIO.output (vhosts, "\tRequire user " ^ String.concatWith " " users ^ "\n")
398 | ("Require" :: "group" :: (users as (_::_))) =>
399 if not (!openLocation orelse !openDirectory) then
400 Domtool.error (path, "can only use Require inside Location/Directory")
401 else if List.exists (fn u => not (validUser u)) users then
402 Domtool.error (path, "invalid group name")
403 else
404 TextIO.output (vhosts, "\tRequire group " ^ String.concatWith " " users ^ "\n")
405
406 | ["HcoopPrivate"] =>
407 if not (!openLocation orelse !openDirectory) then
408 Domtool.error (path, "can only use HcoopPrivate inside Location/Directory")
0d70f328
AC		 409 else if ssl then
410 TextIO.output (vhosts,
368cc49c
AC		 411 "\tAuthName \"hcoop web account\"\n" ^
412 "\tAuthType basic\n" ^
413 "\tAuthUserFile " ^ passwdFile ^ "\n" ^
414 "\tRequire valid-user\n" ^
415 "\tOrder Deny,Allow\n" ^
416 "\tDeny from all\n" ^
417 "\tAllow from 127.0.0.1\n" ^
418 "\tSatisfy any\n")
0d70f328
AC		 419 else
420 Domtool.error (path, "HcoopPrivate only allowed for SSL vhosts")
c6544086
AC		 421 | ["Block", pat] =>
422 if validDenyMask pat then
423 blocked := pat :: (!blocked)
424 else
425 Domtool.error (path, "Invalid block mask")
182a2654
AC		 426 | ["Default"] => (TextIO.output (vhosts, "\tServerAlias " ^ parent ^ "\n");
427 TextIO.output (conf, "HideSite\t" ^ parent ^ "\n" ^
428 "HideReferrer\t" ^ parent ^ "\n"))
db5910c4 429 | ["CGI", p] =>
182a2654
AC		 430 if checkPath (paths, p) then
431 TextIO.output (vhosts, "\t<Directory " ^ p ^ ">\n" ^
432 "\t\tOptions ExecCGI\n" ^
433 "\t\tSetHandler cgi-script\n" ^
434 "\t</Directory>\n")
435 else
db5910c4 436 Domtool.error (path, "not authorized to use " ^ p)
368cc49c 437 (*| ["Mod", lang, p, file] =>
874b616a
AC		 438 (case List.find (fn (lang', _) => lang = lang') langHandlers of
439 NONE => Domtool.error (p, "unknown Mod language " ^ lang)
440 | SOME (_, f) =>
441 (TextIO.output (vhosts, "\t<Location " ^ p ^ ">\n");
442 TextIO.output (vhosts, f file);
368cc49c 443 TextIO.output (vhosts, "\t</Location>\n")))*)
182a2654
AC		 444 | ["HTML", p] =>
445 if checkPath (paths, p) then
446 TextIO.output (vhosts, "\t<Directory " ^ p ^ ">\n" ^
447 "\t\tForceType text/html\n" ^
448 "\t</Directory>\n")
449 else
450 Domtool.error (path, "not authorized to use " ^ p)
368cc49c
AC		 451 | ["Action", kind, script] =>
452 if validLocation kind andalso validLocation script then
453 TextIO.output (vhosts, "\tAction " ^ kind ^ " " ^ script ^ "\n")
454 else
455 Domtool.error (path, "invalid action type or script URL")
874b616a
AC		 456 | ["PerlSetVar", n, v] =>
457 TextIO.output (vhosts, "\tPerlSetVar " ^ n ^ " " ^ v ^ "\n")
458 | ["AddDefaultCharset", cs] =>
459 TextIO.output (vhosts, "\tAddDefaultCharSet " ^ cs ^ "\n")
29d1e9fe
AC		 460 | ["PerlINC", p] =>
461 if checkPath (paths, p) then
462 (checkFixup ();
463 TextIO.output (vhosts, "\tPerlINC " ^ p ^ "\n"))
464 else
465 Domtool.error (path, "not authorized to use " ^ p)
466 | ["PerlVersion", p] =>
467 (checkFixup ();
468 TextIO.output (vhosts, "\tPerlVersion " ^ p ^ "\n"))
4d3abed7
AC		 469 | ["SSLCertificateFile", p] =>
470 if not ssl then
471 Domtool.error (path, "certificate specification not allowed for non-SSL vhost")
472 else if !cert then
473 Domtool.error (path, "duplicate SSL certificate specification")
474 else if checkPath (certs, p) then
475 (TextIO.output (vhosts, "\tSSLEngine on\n\tSSLCertificateFile " ^ p ^ "\n");
476 cert := true)
477 else
478 Domtool.error (path, "not authorized to use " ^ p)
479 (*| ["SSLCertificateKeyFile", p] =>
480 if checkPath (paths, p) then
481 TextIO.output (vhosts, "\tSSLCertificateKeyFile " ^ p ^ "\n")
482 else
483 Domtool.error (path, "not authorized to use " ^ p)*)
db5910c4
AC		 484 | ["Mason", p] =>
485 (case !docroot of
486 NONE => Domtool.error (path, "you must set the DocumentRoot before using Mason")
487 | SOME root =>
488 if checkPath (paths, root ^ p) then
489 TextIO.output (vhosts, String.concat
490 ["\tScriptAlias /cgi-bin/ ", root, p, "\n",
491 "\t<LocationMatch \"\\.html$\">\n",
492 "\t\tAction html-mason ", p, "\n",
493 "\t\tAddHandler html-mason .html\n",
494 "\t</LocationMatch>\n",
495 "\t<LocationMatch \"^/cgi-bin/\">\n",
496 "\t\tRemoveHandler .html\n",
497 "\t</LocationMatch>\n",
498 "\t<FilesMatch \"(autohandler|dhandler)$\">\n",
499 "\t\tOrder allow,deny\n",
500 "\t\tDeny from all\n",
501 "\t</FilesMatch>\n\n"])
502 else
503 Domtool.error (path, "not authorized to use " ^ p))
504 | ["RewriteLogLevel", n] =>
505 (case Int.fromString n of
506 NONE => Domtool.error (path, "invalid log level " ^ n)
507 | SOME n =>
508 if n < 0 then
509 Domtool.error (path, "negative log levels are not allowed")
510 else if !user = defaultUser orelse !group = defaultGroup then
511 Domtool.error (path, "set User and Group before using RewriteLogLevel")
512 else
513 TextIO.output (vhosts, String.concat
514 ["\tRewriteLog ", domLogDir, "/rewrite.log\n",
515 "\tRewriteLogLevel ", Int.toString n, "\n"]))
b644a661 516 (*| ["DavSvn", p] =>
502a9148
AC		 517 if checkPath (paths, p) then
518 TextIO.output (vhosts, String.concat
519 ["\tDAV svn\n\tSVNPath ", p, "\n"])
520 else
521 Domtool.error (path, "not authorized to use " ^ p)
2d9cd6fb
AC		 522 | ["AuthzSvnAccessFile", authzFile] =>
523 if not (!openLocation orelse !openDirectory) then
524 Domtool.error (path, "can only use AuthzSvnAccessFile inside Location/Directory")
525 else if not (checkPath (paths, authzFile)) then
526 Domtool.error (path, "not authorized to use " ^ authzFile)
527 else
528 TextIO.output (vhosts, String.concat
b644a661 529 ["\tAuthzSVNAccessFile ", authzFile, "\n"])*)
227cff0f
AC		 530
531 | "AddDescription" :: file :: rest =>
532 if List.exists (CharVector.exists (fn ch => ch = #"\"" orelse ch = #"\\")) rest then
533 Domtool.error (path, "AddDescription description can't contain double-quote or backslash characters")
534 else
535 TextIO.output (vhosts, String.concat
536 ["\tAddDescription\t\"", String.concatWith " " rest, "\" ", file, "\n"])
537 | "IndexOptions" :: (rest as (_ :: _)) =>
538 let
539 fun isOption item = List.exists (fn item' => item' = item) index_options
540
541 fun isValid s =
542 if size s >= 1 then
543 case String.sub (s, 0) of
544 #"+" => isOption (String.extract (s, 1, NONE))
545 | #"-" => isOption (String.extract (s, 1, NONE))
546 | _ => isOption s
547 else
548 isOption s
549 in
550 if List.all isValid rest then
551 TextIO.output (vhosts, String.concat
552 ["\tIndexOptions\t", String.concatWith " " rest, "\n"])
553 else
554 Domtool.error (path, "invalid or disallowed IndexOption")
555 end
556 | ["HeaderName", name] =>
557 TextIO.output (vhosts, String.concat
558 ["\tHeaderName\t", name, "\n"])
559 | ["ReadmeName", name] =>
560 TextIO.output (vhosts, String.concat
561 ["\tReadmeName\t", name, "\n"])
562
06f0e7f5
AC		 563 | ["NoAutoindex"] =>
564 TextIO.output (vhosts, "\tOptions -Indexes\n")
565
e9120fa1
AC		 566 | ["LimitRequestBody", n] =>
567 (case Int.fromString n of
568 NONE => Domtool.error (path, "Invalid LimitRequestBody amount")
569 | SOME n' =>
570 if n' < 0 then
571 Domtool.error (path, "Invalid LimitRequestBody amount")
572 else
573 TextIO.output (vhosts, String.concat ["\tLimitRequestBody ", n, "\n"]))
574
182a2654
AC		 575 | cmd::_ => Domtool.error (path, "unknown option: " ^ cmd))
576 in
4d3abed7
AC		 577 TextIO.output (vhosts, "<VirtualHost *" ^ (if apache2 then ":" ^ Int.toString port else "") ^ ">\n" ^
578 "\tServerName " ^ domain' ^ "\n" ^
1dd685ff
AC		 579 "\tErrorLog " ^ domLogDir ^ "/error.log\n" ^
580 "\tCustomLog " ^ domLogDir ^ "/access.log combined\n" ^
182a2654 581 "\tIndexOptions FancyIndexing FoldersFirst\n");
05060d16 582 ioOptLoop (fn () => Domtool.inputLine hf) loop ();
30ac0378 583
368cc49c
AC		 584 if !openLocation then
585 (Domtool.error (path, "unclosed Location");
586 TextIO.output (vhosts, "\t</Location>\n"))
587 else
588 ();
589
590 if !openDirectory then
591 (Domtool.error (path, "unclosed Directory");
592 TextIO.output (vhosts, "\t</Directory>\n"))
593 else
594 ();
595
30ac0378
AC		 596 (case !blocked of
597 [] => ()
598 | _ =>
599 (TextIO.output (vhosts,
600 "\t<Location />\n" ^
601 "\t\tOrder Allow,Deny\n" ^
602 "\t\tAllow from all\n");
603 app (fn pat => TextIO.output (vhosts, "\t\tDeny from " ^ pat ^ "\n")) (!blocked);
604 TextIO.output (vhosts, "\t</Location>\n")));
605
4d3abed7
AC		 606 if ssl andalso not (!cert) then
607 Domtool.error (path, "no SSL certificate specified; defaulting to HTTP on HTTPS port")
608 else
609 ();
610
6ebfb304
AC		 611 if apache2 then
612 (TextIO.output (vhosts, "\tSuexecUserGroup ");
613 TextIO.output (vhosts, !user);
614 TextIO.output (vhosts, " ");
615 TextIO.output (vhosts, !group);
616 if !scripts then
617 ()
618 else
4d3abed7 619 TextIO.output (vhosts, "\n\tUserDir disabled"))
6ebfb304
AC		 620 else
621 (TextIO.output (vhosts, "\tUser ");
622 TextIO.output (vhosts, !user);
623 TextIO.output (vhosts, "\n\tGroup ");
624 TextIO.output (vhosts, !group));
625
182a2654
AC		 626 TextIO.output (vhosts, "\n</VirtualHost>\n\n");
627 TextIO.closeIn hf;
628 TextIO.closeOut conf;
629 TextIO.closeOut htac
c79bcdbc 630 end handle ex => Domtool.handleException (#path data, ex)
182a2654
AC		 631
632 fun publish () =
633 if OS.Process.isSuccess (OS.Process.system
634 (diff ^ " " ^ scratchDir ^ "/vhosts.conf " ^ dataFile)) then
635 OS.Process.success
636 else if not (OS.Process.isSuccess (OS.Process.system
637 (cp ^ " " ^ scratchDir ^ "/vhosts.conf " ^ dataFile))) then
638 (print "Error copying vhosts.conf\n";
639 OS.Process.failure)
1e2e348e
AC		 640 else if not (OS.Process.isSuccess (OS.Process.system pubCommand)) then
641 (print "Error publishing vhosts.conf\n";
642 OS.Process.failure)
643 else if OS.Process.isSuccess (OS.Process.system logpermsCommand) then
182a2654
AC		 644 OS.Process.success
645 else
1e2e348e 646 (print "Error updating log permissions\n";
182a2654
AC		 647 OS.Process.failure)
648
649 fun mkdom _ = OS.Process.success
650
651 val _ = Domtool.setVhostHandler {init = init,
652 file = handler,
653 finish = finish,
654 publish = publish,
655 mkdom = mkdom}
656end
657
Unnamed repository; edit this file to name it for gitweb.