2 Domtool (http
://hcoop
.sf
.net
/)
3 Copyright (C
) 2004-2006 Adam Chlipala
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
.
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
.
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
.
20 (* Apache vhost management module
, with Webalizer support
*)
22 structure Apache
:> APACHE
=
24 open Config ApacheConfig Util
26 val vhosts
= ref (NONE
: TextIO.outstream option
)
27 val loggroups
= ref (NONE
: TextIO.outstream option
)
29 fun init () = (vhosts
:= SOME (TextIO.openOut (scratchDir ^
"/vhosts.conf"));
30 loggroups
:= SOME (TextIO.openOut (scratchDir ^
"/loggroups")))
31 fun finish () = (TextIO.closeOut (valOf (!vhosts
));
33 TextIO.closeOut (valOf (!loggroups
));
36 val noargs
= ["redirect", "R", "forbidden", "F", "gone", "G", "last", "L", "chain", "C", "nosubeq", "NS", "nocase", "NC", "qsappend", "QSA", "noescape", "NE", "passthrough", "PT"]
38 val redirect_codes
= ["temp", "permanent", "seeother", "300", "301", "302", "303", "304", "305", "307"]
40 val index_options
= ["FoldersFirst", "SuppressColumnSorting"]
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
);
47 val args
= String.substring (args
, 1, size args
- 2)
48 val fields
= String.fields (fn ch
=> ch
= #
",") args
58 List.all checkOne fields
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
);
67 val args
= String.substring (args
, 1, size args
- 2)
68 val fields
= String.fields (fn ch
=> ch
= #
",") args
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
);
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)
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)
83 (case String.fields (fn ch
=> ch
= #
":") varval
of
85 | _
=> (Domtool
.error (path
, "Bad env setting " ^ varval
);
88 (case String.fields (fn ch
=> ch
= #
":") varval
of
90 | _
=> (Domtool
.error (path
, "Bad env setting " ^ varval
);
92 | _
=> (Domtool
.error (path
, "Unknown or disallowed mod_rewrite flag " ^ f
);
95 List.all checkField fields
100 val fs
= String.fields (fn ch
=> ch
= #
".") s
102 (length fs
<= 4 andalso List.all (fn s
=> case Int.fromString s
of
103 SOME n
=> n
>= 0 andalso n
< 256
108 fun handler (data
: Domtool
.handlerData
) =
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
118 val _
= Domtool
.dprint ("Reading host " ^ path ^
" for " ^ domain ^
"....")
120 val (ssl
, port
, path
', domainId
, domain
', prefix
) =
121 if size path
>= 4 andalso String.extract (path
, size path
- 4, NONE
) = ".ssl" then
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
)
129 (true, httpsPort
, String.substring (path
, 0, size path
- 4),
130 domain
, domain
', "https")
133 (false, httpPort
, path
, domain
, domain
, "http")
135 val vhosts
= valOf (!vhosts
)
136 val loggroups
= valOf (!loggroups
)
139 val stat
= Posix
.FileSys
.stat domfile
140 val group
' = Posix
.SysDB
.Group
.name (Posix
.SysDB
.getgrgid (Posix
.FileSys
.ST
.gid stat
))
142 val _
= TextIO.output (loggroups
, domainId ^
"\t" ^ group
' ^
"\n")
144 val domLogDir
= logDir ^ domainId
146 if Posix
.FileSys
.access (domLogDir
, []) then
149 ignore (OS
.Process
.system (sudo ^
" " ^ mklogdir ^
" " ^ domainId
))
151 val hf
= TextIO.openIn path
152 val rewrite
= ref
false
153 val rewriteLocal
= ref
false
155 val conf
= TextIO.openOut (wblConfDir ^
"/" ^ domainId ^
".conf")
156 val _
= TextIO.output (conf
, "LogFile\t" ^ domLogDir ^
"/access.log\n" ^
157 "OutputDir\t" ^ wblDocDir ^
"/" ^ domainId ^
"\n" ^
158 "HostName\t" ^ domain
' ^
"\n" ^
159 "HideSite\t" ^ domain
' ^
"\n" ^
160 "HideReferrer\t" ^ domain
' ^
"\n")
162 val dir
= wblDocDir ^
"/" ^ domainId
164 if Posix
.FileSys
.access (dir
, []) then
167 Posix
.FileSys
.mkdir (dir
, Posix
.FileSys
.S
.flags
[Posix
.FileSys
.S
.iroth
, Posix
.FileSys
.S
.ixoth
,
168 Posix
.FileSys
.S
.irwxu
,
169 Posix
.FileSys
.S
.irgrp
, Posix
.FileSys
.S
.iwgrp
])
171 val htac
= TextIO.openOut (dir ^
"/.htaccess")
172 val user
= ref (getOpt (StringSet
.find (fn _
=> true) users
, defaultUser
))
173 val group
= ref (getOpt (StringSet
.find (fn _
=> true) groups
, defaultGroup
))
174 val scripts
= ref
false
178 val docroot
= ref NONE
179 val openLocation
= ref
false
180 val openDirectory
= ref
false
183 val fixup
= ref
false
190 TextIO.output (vhosts
, "\tPerlFixupHandler Apache::PerlVINC\n");
191 TextIO.output (vhosts
, "\tPerlCleanupHandler Apache::PerlVINC\n"))
194 fun checkRewrite () =
195 if !openLocation
orelse !openDirectory
then
196 if not (!rewrite
) andalso not (!rewriteLocal
) then
197 (rewriteLocal
:= true;
198 TextIO.output (vhosts
, "\tRewriteEngine on\n"))
201 else if not (!rewrite
) then
203 TextIO.output (vhosts
, "\tRewriteEngine on\n"))
207 fun loop (line
, ()) =
208 (case String.tokens
Char.isSpace line
of
211 if StringSet
.member (users
, user
') then
214 Domtool
.error (path
, "not authorized to run as " ^ user
')
215 |
["Group", group
'] =>
216 if StringSet
.member (groups
, group
') then
219 Domtool
.error (path
, "not authorized to run as group " ^ group
')
220 |
["ServerAdmin", email
] => TextIO.output (vhosts
, "\tServerAdmin " ^ email ^
"\n")
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")*)
222 |
["DocumentRoot", p
] =>
223 if checkPath (paths
, p
) then
225 TextIO.output (vhosts
, "\tDocumentRoot " ^ p ^
"\n"))
227 print (path ^
": not authorized to use " ^ p ^
"\n")
228 |
"RewriteRule" :: src
:: dst
:: rest
=>
233 |
[flags
] => if checkRewriteArgs (path
, flags
) then SOME flags
else NONE
234 | _
=> (Domtool
.error (path
, "Invalid mod_rewrite flags in " ^ chop line
); NONE
)
239 TextIO.output (vhosts
, "\tRewriteRule\t" ^ src ^
" " ^ dst ^
" " ^ flags ^
"\n"))
242 |
"RewriteCond" :: thing
:: pat
:: rest
=>
247 |
[flags
] => if checkRewriteCondArgs (path
, flags
) then SOME flags
else NONE
248 | _
=> (Domtool
.error (path
, "Invalid mod_rewrite flags in " ^ chop line
); NONE
)
253 TextIO.output (vhosts
, "\tRewriteCond\t" ^ thing ^
" " ^ pat ^
" " ^ flags ^
"\n"))
256 |
["RewriteBase", url
] =>
257 if !openDirectory
then
259 TextIO.output (vhosts
, "\tRewriteBase\t" ^ url ^
"\n"))
261 Domtool
.error (path
, "RewriteBase is only allowed inside a Directory block")
262 |
["LocalProxy", src
, dst
, port
] =>
263 (case Int.fromString port
of
264 NONE
=> Domtool
.error (path
, "Invalid port number " ^ port
)
266 if n
= 80 orelse n
= 443 then
267 Domtool
.error (path
, "No proxying back to Apache itself allowed")
269 Domtool
.error (path
, "Port number must be positive: " ^ port
)
272 TextIO.output (vhosts
, "\tRewriteRule\t" ^ src ^
" http://localhost:" ^ port ^
"/" ^ dst ^
" [P]\n")))
273 |
["LocalProxyPass", src
, dst
, port
] =>
274 (case Int.fromString port
of
275 NONE
=> Domtool
.error (path
, "Invalid port number " ^ port
)
277 if n
= 80 orelse n
= 443 then
278 Domtool
.error (path
, "No proxying back to Apache itself allowed")
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 /")
284 (TextIO.output (vhosts
, "\tProxyPass\t" ^ src ^
" http://localhost:" ^ port ^ dst ^
"\n");
285 TextIO.output (vhosts
, "\tProxyPassReverse\t" ^ src ^
" http://localhost:" ^ port ^ dst ^
"\n")))
288 TextIO.output (vhosts
, "\tRewriteRule\t^/cgi-bin/mailman/(.*)$ " ^ mailmanPrefix ^
"/$1 [P]\n");
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"))
291 |
["Alias", from
, to
] =>
292 if checkPath (paths
, to
) then
293 TextIO.output (vhosts
, "\tAlias " ^ from ^
" " ^ to ^
"\n")
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")
298 (*|
["Script", from
, to
] =>
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"));
307 TextIO.output (vhosts
, "\tRewriteRule\t^/" ^ from ^
"(.* )$ " ^ prefix ^
"://" ^ domain
' ^
"/~" ^
!user ^
"/cgi-bin/" ^ to ^
"$1 [P]\n"))*)
308 |
["MoinMoin", from
, to
] =>
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"))
313 Domtool
.error (path
, "not authorized to use " ^ to
)
314 |
["ScriptAlias", from
, to
] =>
315 if checkPath (paths
, to
) then
316 TextIO.output (vhosts
, "\tScriptAlias " ^ from ^
" \"" ^ to ^
"\"\n")
318 Domtool
.error (path
, "not authorized to use " ^ to
)
320 TextIO.output (vhosts
, "\tOptions +Includes +IncludesNOEXEC\n\tDirectoryIndex index.shtml index.html index.cgi index.pl index.php index.xhtml\n")
321 |
["XBitHack", mode
] =>
322 if mode
= "on" orelse mode
= "off" orelse mode
= "full" then
323 TextIO.output (vhosts
, "\tXBitHack " ^ mode ^
"\n")
325 Domtool
.error (path
, "invalid XBitHack argument")
326 |
["ServerAlias", dom
] =>
327 if validDomain dom
then
329 val file
= foldr (fn (c
, s
) => s ^
"/" ^ c
) dataDir (String.fields (fn ch
=> ch
= #
".") dom
) ^
".aliased"
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"))
336 Domtool
.error (path
, "not authorized to ServerAlias " ^ dom
)
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")
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"))
352 Domtool
.error (path
, "bad URL: " ^ url
)
354 if !openLocation
then
355 (openLocation
:= false;
356 rewriteLocal
:= false;
357 TextIO.output (vhosts
, "\t</Location>\n"))
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"))
367 Domtool
.error (path
, "not authorized to use " ^ p
)
369 if !openDirectory
then
370 (openDirectory
:= false;
371 rewriteLocal
:= false;
372 TextIO.output (vhosts
, "\t</Directory>\n"))
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
)
381 TextIO.output (vhosts
,
382 String.concat
["\tAuthType basic\n",
383 "\tAuthName \"", String.toString (String.concatWith
" " name
), "\"\n",
384 "\tAuthUserFile ", userFile
, "\n"])
386 |
["Require", "valid-user"] =>
387 if not (!openLocation
orelse !openDirectory
) then
388 Domtool
.error (path
, "can only use Require inside Location/Directory")
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")
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")
404 TextIO.output (vhosts
, "\tRequire group " ^
String.concatWith
" " users ^
"\n")
406 |
["HcoopPrivate"] =>
407 if not (!openLocation
orelse !openDirectory
) then
408 Domtool
.error (path
, "can only use HcoopPrivate inside Location/Directory")
410 TextIO.output (vhosts
,
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" ^
420 Domtool
.error (path
, "HcoopPrivate only allowed for SSL vhosts")
422 if validDenyMask pat
then
423 blocked
:= pat
:: (!blocked
)
425 Domtool
.error (path
, "Invalid block mask")
426 |
["Default"] => (TextIO.output (vhosts
, "\tServerAlias " ^ parent ^
"\n");
427 TextIO.output (conf
, "HideSite\t" ^ parent ^
"\n" ^
428 "HideReferrer\t" ^ parent ^
"\n"))
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" ^
436 Domtool
.error (path
, "not authorized to use " ^ p
)
437 (*|
["Mod", lang
, p
, file
] =>
438 (case List.find (fn (lang
', _
) => lang
= lang
') langHandlers
of
439 NONE
=> Domtool
.error (p
, "unknown Mod language " ^ lang
)
441 (TextIO.output (vhosts
, "\t<Location " ^ p ^
">\n");
442 TextIO.output (vhosts
, f file
);
443 TextIO.output (vhosts
, "\t</Location>\n")))*)
445 if checkPath (paths
, p
) then
446 TextIO.output (vhosts
, "\t<Directory " ^ p ^
">\n" ^
447 "\t\tForceType text/html\n" ^
450 Domtool
.error (path
, "not authorized to use " ^ p
)
451 |
["Action", kind
, script
] =>
452 if validLocation kind
andalso validLocation script
then
453 TextIO.output (vhosts
, "\tAction " ^ kind ^
" " ^ script ^
"\n")
455 Domtool
.error (path
, "invalid action type or script URL")
456 |
["PerlSetVar", n
, v
] =>
457 TextIO.output (vhosts
, "\tPerlSetVar " ^ n ^
" " ^ v ^
"\n")
458 |
["AddDefaultCharset", cs
] =>
459 TextIO.output (vhosts
, "\tAddDefaultCharSet " ^ cs ^
"\n")
461 if checkPath (paths
, p
) then
463 TextIO.output (vhosts
, "\tPerlINC " ^ p ^
"\n"))
465 Domtool
.error (path
, "not authorized to use " ^ p
)
466 |
["PerlVersion", p
] =>
468 TextIO.output (vhosts
, "\tPerlVersion " ^ p ^
"\n"))
469 |
["SSLCertificateFile", p
] =>
471 Domtool
.error (path
, "certificate specification not allowed for non-SSL vhost")
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");
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")
483 Domtool
.error (path
, "not authorized to use " ^ p
)*)
486 NONE
=> Domtool
.error (path
, "you must set the DocumentRoot before using Mason")
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"])
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
)
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")
513 TextIO.output (vhosts
, String.concat
514 ["\tRewriteLog ", domLogDir
, "/rewrite.log\n",
515 "\tRewriteLogLevel ", Int.toString n
, "\n"]))
517 if checkPath (paths
, p
) then
518 TextIO.output (vhosts
, String.concat
519 ["\tDAV svn\n\tSVNPath ", p
, "\n"])
521 Domtool
.error (path
, "not authorized to use " ^ p
)
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
)
528 TextIO.output (vhosts
, String.concat
529 ["\tAuthzSVNAccessFile ", authzFile
, "\n"])*)
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")
535 TextIO.output (vhosts
, String.concat
536 ["\tAddDescription\t\"", String.concatWith
" " rest
, "\" ", file
, "\n"])
537 |
"IndexOptions" :: (rest
as (_
:: _
)) =>
539 fun isOption item
= List.exists (fn item
' => item
' = item
) index_options
543 case String.sub (s
, 0) of
544 #
"+" => isOption (String.extract (s
, 1, NONE
))
545 | #
"-" => isOption (String.extract (s
, 1, NONE
))
550 if List.all isValid rest
then
551 TextIO.output (vhosts
, String.concat
552 ["\tIndexOptions\t", String.concatWith
" " rest
, "\n"])
554 Domtool
.error (path
, "invalid or disallowed IndexOption")
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"])
564 TextIO.output (vhosts
, "\tOptions -Indexes\n")
566 |
["LimitRequestBody", n
] =>
567 (case Int.fromString n
of
568 NONE
=> Domtool
.error (path
, "Invalid LimitRequestBody amount")
571 Domtool
.error (path
, "Invalid LimitRequestBody amount")
573 TextIO.output (vhosts
, String.concat
["\tLimitRequestBody ", n
, "\n"]))
575 | cmd
::_
=> Domtool
.error (path
, "unknown option: " ^ cmd
))
577 TextIO.output (vhosts
, "<VirtualHost *" ^
(if apache2
then ":" ^
Int.toString port
else "") ^
">\n" ^
578 "\tServerName " ^ domain
' ^
"\n" ^
579 "\tErrorLog " ^ domLogDir ^
"/error.log\n" ^
580 "\tCustomLog " ^ domLogDir ^
"/access.log combined\n" ^
581 "\tIndexOptions FancyIndexing FoldersFirst\n");
582 ioOptLoop (fn () => Domtool
.inputLine hf
) loop ();
584 if !openLocation
then
585 (Domtool
.error (path
, "unclosed Location");
586 TextIO.output (vhosts
, "\t</Location>\n"))
590 if !openDirectory
then
591 (Domtool
.error (path
, "unclosed Directory");
592 TextIO.output (vhosts
, "\t</Directory>\n"))
599 (TextIO.output (vhosts
,
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")));
606 if ssl
andalso not (!cert
) then
607 Domtool
.error (path
, "no SSL certificate specified; defaulting to HTTP on HTTPS port")
612 (TextIO.output (vhosts
, "\tSuexecUserGroup ");
613 TextIO.output (vhosts
, !user
);
614 TextIO.output (vhosts
, " ");
615 TextIO.output (vhosts
, !group
);
619 TextIO.output (vhosts
, "\n\tUserDir disabled"))
621 (TextIO.output (vhosts
, "\tUser ");
622 TextIO.output (vhosts
, !user
);
623 TextIO.output (vhosts
, "\n\tGroup ");
624 TextIO.output (vhosts
, !group
));
626 TextIO.output (vhosts
, "\n</VirtualHost>\n\n");
628 TextIO.closeOut conf
;
630 end handle ex
=> Domtool
.handleException (#path data
, ex
)
633 if OS
.Process
.isSuccess (OS
.Process
.system
634 (diff ^
" " ^ scratchDir ^
"/vhosts.conf " ^ dataFile
)) then
636 else if not (OS
.Process
.isSuccess (OS
.Process
.system
637 (cp ^
" " ^ scratchDir ^
"/vhosts.conf " ^ dataFile
))) then
638 (print
"Error copying vhosts.conf\n";
640 else if not (OS
.Process
.isSuccess (OS
.Process
.system pubCommand
)) then
641 (print
"Error publishing vhosts.conf\n";
643 else if OS
.Process
.isSuccess (OS
.Process
.system logpermsCommand
) then
646 (print
"Error updating log permissions\n";
649 fun mkdom _
= OS
.Process
.success
651 val _
= Domtool
.setVhostHandler
{init
= init
,