(*
Domtool (http://hcoop.sf.net/)
-Copyright (C) 2004 Adam Chlipala
+Copyright (C) 2004-2006 Adam Chlipala
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
loggroups := NONE)
val noargs = ["redirect", "R", "forbidden", "F", "gone", "G", "last", "L", "chain", "C", "nosubeq", "NS", "nocase", "NC", "qsappend", "QSA", "noescape", "NE", "passthrough", "PT"]
+
+ val redirect_codes = ["temp", "permanent", "seeother", "300", "301", "302", "303", "304", "305", "307"]
+
+ val index_options = ["FoldersFirst", "SuppressColumnSorting"]
fun checkRewriteCondArgs (path, args) =
if size args < 2 orelse String.sub (args, 0) <> #"[" orelse String.sub (args, size args - 1) <> #"]" then
false)
| ["type", _] => true
| ["T", _] => true
+ | ["rewrite", num] => List.exists (fn s => s = num) redirect_codes
+ orelse (Domtool.error (path, "Bad redirect response code " ^ num); false)
+ | ["R", num] => List.exists (fn s => s = num) redirect_codes
+ orelse (Domtool.error (path, "Bad redirect response code " ^ num); false)
| ["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] =>
List.all checkField fields
end
- fun handler {path, domain, parent, vars, paths, users, groups, mxs, certs} =
+ fun validDenyMask s =
let
+ val fs = String.fields (fn ch => ch = #".") s
+ in
+ (length fs <= 4 andalso List.all (fn s => case Int.fromString s of
+ SOME n => n >= 0 andalso n < 256
+ | NONE => false) fs)
+ orelse validDomain s
+ end
+
+ fun handler (data : Domtool.handlerData) =
+ let
+ val path = #path data
+ val domain = #domain data
+ val users = #users data
+ val groups = #groups data
+ val paths = #paths data
+ val parent = #parent data
+ val certs = #certs data
+
val _ = Domtool.dprint ("Reading host " ^ path ^ " for " ^ domain ^ "....")
val (ssl, port, path', domainId, domain', prefix) =
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 _ = TextIO.output (loggroups, domainId ^ "\t" ^ group' ^ "\n")
+
+ val domLogDir = logDir ^ domainId
+ val _ =
+ if Posix.FileSys.access (domLogDir, []) then
+ ()
+ else
+ ignore (OS.Process.system (sudo ^ " " ^ mklogdir ^ " " ^ domainId))
val hf = TextIO.openIn path
val rewrite = ref false
+ val rewriteLocal = ref false
val conf = TextIO.openOut (wblConfDir ^ "/" ^ domainId ^ ".conf")
- val _ = TextIO.output (conf, "LogFile\t" ^ logDir ^ domainId ^ "-access.log\n" ^
+ val _ = TextIO.output (conf, "LogFile\t" ^ domLogDir ^ "/access.log\n" ^
"OutputDir\t" ^ wblDocDir ^ "/" ^ domainId ^ "\n" ^
"HostName\t" ^ domain' ^ "\n" ^
"HideSite\t" ^ domain' ^ "\n" ^
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.mkdir (dir, Posix.FileSys.S.flags [Posix.FileSys.S.iroth, 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 user = ref (getOpt (StringSet.find (fn _ => true) users, defaultUser))
+ val group = ref (getOpt (StringSet.find (fn _ => true) groups, defaultGroup))
val scripts = ref false
val cert = ref false
val blocked = ref []
+ val docroot = ref NONE
+ val openLocation = ref false
+ val openDirectory = ref false
local
val fixup = ref false
end
fun checkRewrite () =
- if not (!rewrite) then
+ if !openLocation orelse !openDirectory then
+ if not (!rewrite) andalso not (!rewriteLocal) then
+ (rewriteLocal := true;
+ TextIO.output (vhosts, "\tRewriteEngine on\n"))
+ else
+ ()
+ else if not (!rewrite) then
(rewrite := true;
TextIO.output (vhosts, "\tRewriteEngine on\n"))
else
(*| ["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")
+ (docroot := SOME p;
+ TextIO.output (vhosts, "\tDocumentRoot " ^ p ^ "\n"))
else
print (path ^ ": not authorized to use " ^ p ^ "\n")
| "RewriteRule" :: src :: dst :: rest =>
TextIO.output (vhosts, "\tRewriteCond\t" ^ thing ^ " " ^ pat ^ " " ^ flags ^ "\n"))
| _ => ()
end
+ | ["RewriteBase", url] =>
+ if !openDirectory then
+ (checkRewrite ();
+ TextIO.output (vhosts, "\tRewriteBase\t" ^ url ^ "\n"))
+ else
+ Domtool.error (path, "RewriteBase is only allowed inside a Directory block")
| ["LocalProxy", src, dst, port] =>
(case Int.fromString port of
NONE => Domtool.error (path, "Invalid port number " ^ port)
| SOME n =>
- if n = 80 then
+ if n = 80 orelse n = 443 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
(checkRewrite ();
TextIO.output (vhosts, "\tRewriteRule\t" ^ src ^ " http://localhost:" ^ port ^ "/" ^ dst ^ " [P]\n")))
+ | ["LocalProxyPass", src, dst, port] =>
+ (case Int.fromString port of
+ NONE => Domtool.error (path, "Invalid port number " ^ port)
+ | SOME n =>
+ if n = 80 orelse n = 443 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 String.sub (dst, 0) <> #"/" then
+ Domtool.error (path, "Destination must start with /")
+ else
+ (TextIO.output (vhosts, "\tProxyPass\t" ^ src ^ " http://localhost:" ^ port ^ dst ^ "\n");
+ TextIO.output (vhosts, "\tProxyPassReverse\t" ^ src ^ " http://localhost:" ^ port ^ dst ^ "\n")))
| ["Mailman"] =>
(checkRewrite ();
TextIO.output (vhosts, "\tRewriteRule\t^/cgi-bin/mailman/(.*)$ " ^ mailmanPrefix ^ "/$1 [P]\n");
- TextIO.output (vhosts, "\tRewriteRule\t^/pipermail/(.*)$ " ^ pipermailPrefix ^ "/$1 [P]\n"))
+ TextIO.output (vhosts, "\tRewriteRule\t^/pipermail/(.*)$ " ^ pipermailPrefix ^ "/$1 [P]\n");
+ TextIO.output (vhosts, "\nAlias\t/doc/mailman\t/usr/share/doc/mailman\n"))
| ["Alias", from, to] =>
if checkPath (paths, to) then
TextIO.output (vhosts, "\tAlias " ^ from ^ " " ^ to ^ "\n")
Domtool.error (path, "not authorized to use " ^ to)
| "ErrorDocument" :: code :: rest =>
TextIO.output (vhosts, foldl (fn (a, s) => s ^ " " ^ a) ("\tErrorDocument " ^ code) rest ^ "\n")
- | ["Script", from, to] =>
+ (*| ["Script", from, to] =>
(if !scripts then
()
else
TextIO.output (vhosts, "\tUserDir enabled " ^ !user ^ "\n");
TextIO.output (vhosts, "\t<Directory /home/" ^ !user ^ "/public_html/cgi-bin/>\n\t\tOptions ExecCGI\n\t\tSetHandler cgi-script\n\t</Directory>\n"));
checkRewrite ();
- TextIO.output (vhosts, "\tRewriteRule\t^/" ^ from ^ "(.*)$ " ^ prefix ^ "://" ^ domain' ^ "/~" ^ !user ^ "/cgi-bin/" ^ to ^ "$1 [P]\n"))
+ TextIO.output (vhosts, "\tRewriteRule\t^/" ^ from ^ "(.* )$ " ^ prefix ^ "://" ^ domain' ^ "/~" ^ !user ^ "/cgi-bin/" ^ to ^ "$1 [P]\n"))*)
| ["MoinMoin", from, to] =>
- (if !scripts then
- ()
- else
- (scripts := true;
- TextIO.output (vhosts, "\tUserDir disabled\n");
- TextIO.output (vhosts, "\tUserDir enabled " ^ !user ^ "\n");
- TextIO.output (vhosts, "\t<Directory /home/" ^ !user ^ "/public_html/cgi-bin/>\n\t\tOptions ExecCGI\n\t\tSetHandler cgi-script\n\t</Directory>\n"));
- checkRewrite ();
- TextIO.output (vhosts, "\tRewriteRule\t^/" ^ from ^ "(.*)$ " ^ prefix ^ "://" ^ domain' ^ "/~" ^ !user ^ "/cgi-bin/" ^ to ^ "$1 [P]\n");
- TextIO.output (vhosts, "\tAlias /moin /usr/share/moin/htdocs\n"))
-
- (*| ["ScriptAlias", from, to] =>
+ if checkPath (paths, to) then
+ (TextIO.output (vhosts, "\tScriptAlias /" ^ from ^ " " ^ to ^ "\n");
+ TextIO.output (vhosts, "\tAlias /moin /usr/share/moin/htdocs\n"))
+ else
+ Domtool.error (path, "not authorized to use " ^ to)
+ | ["ScriptAlias", from, to] =>
if checkPath (paths, to) then
TextIO.output (vhosts, "\tScriptAlias " ^ from ^ " \"" ^ to ^ "\"\n")
else
- Domtool.error (path, "not authorized to use " ^ to)*)
+ Domtool.error (path, "not authorized to use " ^ to)
| ["SSI"] =>
- TextIO.output (vhosts, "\t<Location />\n\t\tOptions +Includes +IncludesNOEXEC\n\t</Location>\n")
+ TextIO.output (vhosts, "\tOptions +Includes +IncludesNOEXEC\n\tDirectoryIndex index.shtml index.html index.cgi index.pl index.php index.xhtml\n")
+ | ["XBitHack", mode] =>
+ if mode = "on" orelse mode = "off" orelse mode = "full" then
+ TextIO.output (vhosts, "\tXBitHack " ^ mode ^ "\n")
+ else
+ Domtool.error (path, "invalid XBitHack argument")
| ["ServerAlias", dom] =>
if validDomain dom then
let
"AuthName \"Abulafia web account\"\n" ^
"AuthUserFile " ^ passwdFile ^ "\n" ^
foldl (fn (u, s) => s ^ " " ^ u) "Require user" users ^ "\n")
+ | ["Location", url] =>
+ if !openLocation orelse !openDirectory then
+ TextIO.output (vhosts, "you must end the last Location/Directory before starting a new one")
+ else if validLocation url then
+ (openLocation := true;
+ TextIO.output (vhosts, "\t<Location " ^ url ^ ">\n"))
+ else
+ Domtool.error (path, "bad URL: " ^ url)
+ | ["/Location"] =>
+ if !openLocation then
+ (openLocation := false;
+ rewriteLocal := false;
+ TextIO.output (vhosts, "\t</Location>\n"))
+ else
+ Domtool.error (path, "there is no open Location to end")
+ | ["Directory", p] =>
+ if !openLocation orelse !openDirectory then
+ TextIO.output (vhosts, "you must end the last Location/Directory before starting a new one")
+ else if checkPath (paths, p) then
+ (openDirectory := true;
+ TextIO.output (vhosts, "\t<Directory " ^ p ^ ">\n"))
+ else
+ Domtool.error (path, "not authorized to use " ^ p)
+ | ["/Directory"] =>
+ if !openDirectory then
+ (openDirectory := false;
+ rewriteLocal := false;
+ TextIO.output (vhosts, "\t</Directory>\n"))
+ else
+ Domtool.error (path, "there is no open Directry to end")
+ | ("BasicAuth" :: userFile :: name) =>
+ if not (!openLocation orelse !openDirectory) then
+ Domtool.error (path, "can only use BasicAuth inside Location/Directory")
+ else if not (checkPath (paths, userFile)) then
+ Domtool.error (path, "not authorized to use " ^ userFile)
+ else
+ TextIO.output (vhosts,
+ String.concat ["\tAuthType basic\n",
+ "\tAuthName \"", String.toString (String.concatWith " " name), "\"\n",
+ "\tAuthUserFile ", userFile, "\n"])
+
+ | ["Require", "valid-user"] =>
+ if not (!openLocation orelse !openDirectory) then
+ Domtool.error (path, "can only use Require inside Location/Directory")
+ else
+ TextIO.output (vhosts, "\tRequire valid-user\n")
+ | ("Require" :: "user" :: (users as (_::_))) =>
+ if not (!openLocation orelse !openDirectory) then
+ Domtool.error (path, "can only use Require inside Location/Directory")
+ else if List.exists (fn u => not (validUser u)) users then
+ Domtool.error (path, "invalid username")
+ else
+ TextIO.output (vhosts, "\tRequire user " ^ String.concatWith " " users ^ "\n")
+ | ("Require" :: "group" :: (users as (_::_))) =>
+ if not (!openLocation orelse !openDirectory) then
+ Domtool.error (path, "can only use Require inside Location/Directory")
+ else if List.exists (fn u => not (validUser u)) users then
+ Domtool.error (path, "invalid group name")
+ else
+ TextIO.output (vhosts, "\tRequire group " ^ String.concatWith " " users ^ "\n")
+
| ["HcoopPrivate"] =>
- if ssl then
+ if not (!openLocation orelse !openDirectory) then
+ Domtool.error (path, "can only use HcoopPrivate inside Location/Directory")
+ else if ssl then
TextIO.output (vhosts,
- "\t<Location />\n" ^
- "\t\tAuthName \"hcoop 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")
+ "\tAuthName \"hcoop web account\"\n" ^
+ "\tAuthType basic\n" ^
+ "\tAuthUserFile " ^ passwdFile ^ "\n" ^
+ "\tRequire valid-user\n" ^
+ "\tOrder Deny,Allow\n" ^
+ "\tDeny from all\n" ^
+ "\tAllow from 127.0.0.1\n" ^
+ "\tSatisfy any\n")
else
Domtool.error (path, "HcoopPrivate only allowed for SSL vhosts")
- | ["Block", pat] => blocked := pat :: (!blocked)
+ | ["Block", pat] =>
+ if validDenyMask pat then
+ blocked := pat :: (!blocked)
+ else
+ Domtool.error (path, "Invalid block mask")
| ["Default"] => (TextIO.output (vhosts, "\tServerAlias " ^ parent ^ "\n");
TextIO.output (conf, "HideSite\t" ^ parent ^ "\n" ^
"HideReferrer\t" ^ parent ^ "\n"))
- (*| ["CGI", p] =>
+ | ["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] =>
+ 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")))
+ TextIO.output (vhosts, "\t</Location>\n")))*)
| ["HTML", p] =>
if checkPath (paths, p) then
TextIO.output (vhosts, "\t<Directory " ^ p ^ ">\n" ^
"\t</Directory>\n")
else
Domtool.error (path, "not authorized to use " ^ p)
+ | ["Action", kind, script] =>
+ if validLocation kind andalso validLocation script then
+ TextIO.output (vhosts, "\tAction " ^ kind ^ " " ^ script ^ "\n")
+ else
+ Domtool.error (path, "invalid action type or script URL")
| ["PerlSetVar", n, v] =>
TextIO.output (vhosts, "\tPerlSetVar " ^ n ^ " " ^ v ^ "\n")
| ["AddDefaultCharset", cs] =>
TextIO.output (vhosts, "\tSSLCertificateKeyFile " ^ p ^ "\n")
else
Domtool.error (path, "not authorized to use " ^ p)*)
+ | ["Mason", p] =>
+ (case !docroot of
+ NONE => Domtool.error (path, "you must set the DocumentRoot before using Mason")
+ | SOME root =>
+ if checkPath (paths, root ^ p) then
+ TextIO.output (vhosts, String.concat
+ ["\tScriptAlias /cgi-bin/ ", root, p, "\n",
+ "\t<LocationMatch \"\\.html$\">\n",
+ "\t\tAction html-mason ", p, "\n",
+ "\t\tAddHandler html-mason .html\n",
+ "\t</LocationMatch>\n",
+ "\t<LocationMatch \"^/cgi-bin/\">\n",
+ "\t\tRemoveHandler .html\n",
+ "\t</LocationMatch>\n",
+ "\t<FilesMatch \"(autohandler|dhandler)$\">\n",
+ "\t\tOrder allow,deny\n",
+ "\t\tDeny from all\n",
+ "\t</FilesMatch>\n\n"])
+ else
+ Domtool.error (path, "not authorized to use " ^ p))
+ | ["RewriteLogLevel", n] =>
+ (case Int.fromString n of
+ NONE => Domtool.error (path, "invalid log level " ^ n)
+ | SOME n =>
+ if n < 0 then
+ Domtool.error (path, "negative log levels are not allowed")
+ else if !user = defaultUser orelse !group = defaultGroup then
+ Domtool.error (path, "set User and Group before using RewriteLogLevel")
+ else
+ TextIO.output (vhosts, String.concat
+ ["\tRewriteLog ", domLogDir, "/rewrite.log\n",
+ "\tRewriteLogLevel ", Int.toString n, "\n"]))
+ (*| ["DavSvn", p] =>
+ if checkPath (paths, p) then
+ TextIO.output (vhosts, String.concat
+ ["\tDAV svn\n\tSVNPath ", p, "\n"])
+ else
+ Domtool.error (path, "not authorized to use " ^ p)
+ | ["AuthzSvnAccessFile", authzFile] =>
+ if not (!openLocation orelse !openDirectory) then
+ Domtool.error (path, "can only use AuthzSvnAccessFile inside Location/Directory")
+ else if not (checkPath (paths, authzFile)) then
+ Domtool.error (path, "not authorized to use " ^ authzFile)
+ else
+ TextIO.output (vhosts, String.concat
+ ["\tAuthzSVNAccessFile ", authzFile, "\n"])*)
+
+ | "AddDescription" :: file :: rest =>
+ if List.exists (CharVector.exists (fn ch => ch = #"\"" orelse ch = #"\\")) rest then
+ Domtool.error (path, "AddDescription description can't contain double-quote or backslash characters")
+ else
+ TextIO.output (vhosts, String.concat
+ ["\tAddDescription\t\"", String.concatWith " " rest, "\" ", file, "\n"])
+ | "IndexOptions" :: (rest as (_ :: _)) =>
+ let
+ fun isOption item = List.exists (fn item' => item' = item) index_options
+
+ fun isValid s =
+ if size s >= 1 then
+ case String.sub (s, 0) of
+ #"+" => isOption (String.extract (s, 1, NONE))
+ | #"-" => isOption (String.extract (s, 1, NONE))
+ | _ => isOption s
+ else
+ isOption s
+ in
+ if List.all isValid rest then
+ TextIO.output (vhosts, String.concat
+ ["\tIndexOptions\t", String.concatWith " " rest, "\n"])
+ else
+ Domtool.error (path, "invalid or disallowed IndexOption")
+ end
+ | ["HeaderName", name] =>
+ TextIO.output (vhosts, String.concat
+ ["\tHeaderName\t", name, "\n"])
+ | ["ReadmeName", name] =>
+ TextIO.output (vhosts, String.concat
+ ["\tReadmeName\t", name, "\n"])
+
+ | ["NoAutoindex"] =>
+ TextIO.output (vhosts, "\tOptions -Indexes\n")
+
+ | ["LimitRequestBody", n] =>
+ (case Int.fromString n of
+ NONE => Domtool.error (path, "Invalid LimitRequestBody amount")
+ | SOME n' =>
+ if n' < 0 then
+ Domtool.error (path, "Invalid LimitRequestBody amount")
+ else
+ TextIO.output (vhosts, String.concat ["\tLimitRequestBody ", n, "\n"]))
+
| cmd::_ => Domtool.error (path, "unknown option: " ^ cmd))
in
TextIO.output (vhosts, "<VirtualHost *" ^ (if apache2 then ":" ^ Int.toString port else "") ^ ">\n" ^
"\tServerName " ^ domain' ^ "\n" ^
- "\tErrorLog " ^ logDir ^ domainId ^ "-error.log\n" ^
- "\tCustomLog " ^ logDir ^ domainId ^ "-access.log combined\n" ^
+ "\tErrorLog " ^ domLogDir ^ "/error.log\n" ^
+ "\tCustomLog " ^ domLogDir ^ "/access.log combined\n" ^
"\tIndexOptions FancyIndexing FoldersFirst\n");
ioOptLoop (fn () => Domtool.inputLine hf) loop ();
+ if !openLocation then
+ (Domtool.error (path, "unclosed Location");
+ TextIO.output (vhosts, "\t</Location>\n"))
+ else
+ ();
+
+ if !openDirectory then
+ (Domtool.error (path, "unclosed Directory");
+ TextIO.output (vhosts, "\t</Directory>\n"))
+ else
+ ();
+
(case !blocked of
[] => ()
| _ =>
TextIO.closeIn hf;
TextIO.closeOut conf;
TextIO.closeOut htac
- end handle ex => Domtool.handleException (path, ex)
+ end handle ex => Domtool.handleException (#path data, ex)
fun publish () =
if OS.Process.isSuccess (OS.Process.system
HCoop / hcoop / zz_old / domtool.git / blobdiff