(* HCoop Domtool (http://hcoop.sourceforge.net/)
- * Copyright (c) 2006, Adam Chlipala
+ * Copyright (c) 2006-2007, Adam Chlipala
*
* This program is free software; you can redistribute it and/or
* modify it under the terms of the GNU General Public License
open Ast
+val dl = ErrorMsg.dummyLoc
+
+fun webNode node =
+ List.exists (fn (x, _) => x = node) Config.Apache.webNodes_all
+ orelse (Domain.hasPriv "www"
+ andalso List.exists (fn (x, _) => x = node) Config.Apache.webNodes_admin)
+
val _ = Env.type_one "web_node"
Env.string
- (fn node =>
- List.exists (fn (x, _) => x = node) Config.Apache.webNodes_all
- orelse (Domain.hasPriv "www"
- andalso List.exists (fn (x, _) => x = node) Config.Apache.webNodes_admin))
+ webNode
val _ = Env.registerFunction ("web_node_to_node",
fn [e] => SOME e
| _ => NONE)
+fun webPlace (EApp ((EVar "web_place_default", _), (EString node, _)), _) =
+ SOME (node, Domain.nodeIp node)
+ | webPlace (EApp ((EApp ((EVar "web_place", _), (EString node, _)), _), (EString ip, _)), _) =
+ SOME (node, ip)
+ | webPlace _ = NONE
+
+fun webPlaceDefault node = (EApp ((EVar "web_place_default", dl), (EString node, dl)), dl)
+
+val _ = Env.registerFunction ("web_place_to_web_node",
+ fn [e] => Option.map (fn (node, _) => (EString node, dl)) (webPlace e)
+ | _ => NONE)
+
+val _ = Env.registerFunction ("web_place_to_node",
+ fn [e] => Option.map (fn (node, _) => (EString node, dl)) (webPlace e)
+ | _ => NONE)
+
+val _ = Env.registerFunction ("web_place_to_ip",
+ fn [e] => Option.map (fn (_, ip) => (EString ip, dl)) (webPlace e)
+ | _ => NONE)
+
val _ = Env.type_one "proxy_port"
Env.int
(fn n => n > 1024)
fun default () = List.exists (fn s' => s = s') Config.Apache.proxyTargets
in
case String.fields (fn ch => ch = #":") s of
- ["http", "//localhost", rest] =>
- (case String.fields (fn ch => ch = #"/") rest of
- port :: _ =>
- (case Int.fromString port of
- NONE => default ()
- | SOME n => n > 1024 orelse default ())
- | _ => default ())
+ "http" :: "//localhost" :: rest =>
+ let
+ val rest = String.concatWith ":" rest
+ in
+ CharVector.all (fn ch => Char.isPrint ch andalso not (Char.isSpace ch)
+ andalso ch <> #"\"" andalso ch <> #"'") rest
+ andalso case String.fields (fn ch => ch = #"/") rest of
+ port :: _ =>
+ (case Int.fromString port of
+ NONE => default ()
+ | SOME n => n > 1024 orelse default ())
+ | _ => default ()
+ end
| _ => default ()
end)
Env.bool
(fn b => b orelse Domain.hasPriv "www")
+val _ = Env.type_one "regexp"
+ Env.string
+ Pcre.validRegexp
+
fun validLocation s =
size s > 0 andalso size s < 1000 andalso CharVector.all
(fn ch => Char.isAlphaNum ch
orelse ch = #"-"
orelse ch = #"_"
orelse ch = #"."
- orelse ch = #"/") s
+ orelse ch = #"/"
+ orelse ch = #"~") s
val _ = Env.type_one "location"
Env.string
| (EApp ((EVar "use_cert", _), s), _) => Option.map SOME (Env.string s)
| _ => NONE
-val dl = ErrorMsg.dummyLoc
-
-val _ = Defaults.registerDefault ("WebNodes",
- (TList (TBase "web_node", dl), dl),
- (fn () => (EList (map (fn s => (EString s, dl)) Config.Apache.webNodes_default), dl)))
-
-val _ = Defaults.registerDefault ("SSL",
- (TBase "ssl", dl),
- (fn () => (EVar "no_ssl", dl)))
-
-val _ = Defaults.registerDefault ("User",
- (TBase "your_user", dl),
- (fn () => (EString (Domain.getUser ()), dl)))
-
-val _ = Defaults.registerDefault ("Group",
- (TBase "your_group", dl),
- (fn () => (EString (Domain.getUser ()), dl)))
-
-val _ = Defaults.registerDefault ("DocumentRoot",
- (TBase "your_path", dl),
- (fn () => (EString (Domain.homedir () ^ "/" ^ Config.Apache.public_html), dl)))
+fun validExtension s =
+ size s > 0
+ andalso size s < 20
+ andalso CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"_") s
-val _ = Defaults.registerDefault ("ServerAdmin",
- (TBase "email", dl),
- (fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl)))
-
-val _ = Defaults.registerDefault ("SuExec",
- (TBase "suexec_flag", dl),
- (fn () => (EVar "true", dl)))
+val _ = Env.type_one "file_extension"
+ Env.string
+ validExtension
+
+val defaults = [("WebPlaces",
+ (TList (TBase "web_place", dl), dl),
+ (fn () => (EList (map webPlaceDefault Config.Apache.webNodes_default), dl))),
+ ("SSL",
+ (TBase "ssl", dl),
+ (fn () => (EVar "no_ssl", dl))),
+ ("User",
+ (TBase "your_user", dl),
+ (fn () => (EString (Domain.getUser ()), dl))),
+ ("Group",
+ (TBase "your_group", dl),
+ (fn () => (EString "nogroup", dl))),
+ ("DocumentRoot",
+ (TBase "your_path", dl),
+ (fn () => (EString (Domain.homedir () ^ "/" ^ Config.Apache.public_html), dl))),
+ ("ServerAdmin",
+ (TBase "email", dl),
+ (fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl))),
+ ("SuExec",
+ (TBase "suexec_flag", dl),
+ (fn () => (EVar "true", dl))),
+ ("PhpVersion",
+ (TBase "php_version", dl),
+ (fn () => (EVar "php4", dl)))]
+
+val () = app Defaults.registerDefault defaults
val redirect_code = fn (EVar "temp", _) => SOME "temp"
| (EVar "permanent", _) => SOME "permanent"
val apache_option = fn (EVar "execCGI", _) => SOME "ExecCGI"
| (EVar "includesNOEXEC", _) => SOME "IncludesNOEXEC"
| (EVar "indexes", _) => SOME "Indexes"
+ | (EVar "followSymLinks", _) => SOME "FollowSymLinks"
| _ => NONE
val autoindex_width = fn (EVar "autofit", _) => SOME "*"
val vhostsChanged = ref false
val logDeleted = ref false
+val delayedLogMoves = ref (fn () => ())
val () = Slave.registerPreHandler
(fn () => (vhostsChanged := false;
- logDeleted := false))
+ logDeleted := false;
+ delayedLogMoves := (fn () => print "Executing delayed log moves/deletes.\n")))
fun findVhostUser fname =
let
fun down () = if imVersion1 () then Config.Apache.down1 else Config.Apache.down
fun undown () = if imVersion1 () then Config.Apache.undown1 else Config.Apache.undown
fun reload () = if imVersion1 () then Config.Apache.reload1 else Config.Apache.reload
+fun fixperms () = if imVersion1 () then Config.Apache.fixperms1 else Config.Apache.fixperms
fun logDir {user, node, vhostId} =
- String.concat [Config.Apache.logDirOf user,
+ String.concat [Config.Apache.logDirOf (isVersion1 node) user,
+ "/",
+ node,
+ "/",
+ vhostId]
+
+fun realLogDir {user, node, vhostId} =
+ String.concat [Config.Apache.realLogDirOf user,
"/",
node,
"/",
file = #file spl}
val user = findVhostUser (#file fs)
- val oldUser = findVhostUser realVhostFile
+ val oldUser = case #action fs of
+ Slave.Delete false => user
+ | _ => findVhostUser realVhostFile
in
if (oldUser = NONE andalso #action fs <> Slave.Add)
- orelse (user = NONE andalso #action fs <> Slave.Delete) then
+ orelse (user = NONE andalso not (Slave.isDelete (#action fs))) then
print ("Can't find user in " ^ #file fs ^ " or " ^ realVhostFile ^ "! Taking no action.\n")
else
let
- val vhostId = if OS.Path.ext (#file spl) = SOME ".vhost_ssl" then
+ val vhostId = if OS.Path.ext (#file spl) = SOME "vhost_ssl" then
OS.Path.base (#file spl) ^ ".ssl"
else
OS.Path.base (#file spl)
logDir {user = valOf user,
node = Slave.hostname (),
vhostId = vhostId}
+
+ fun backupLogs () =
+ OS.Path.joinDirFile
+ {dir = Config.Apache.backupLogDirOf
+ (isVersion1 (Slave.hostname ())),
+ file = vhostId}
in
vhostsChanged := true;
case #action fs of
- Slave.Delete =>
- (if !logDeleted then
- ()
- else
- (ignore (OS.Process.system (down ()));
- logDeleted := true);
- ignore (OS.Process.system (Config.rm
- ^ " -rf "
- ^ realVhostFile));
- ignore (OS.Process.system (Config.rm
- ^ " -rf "
- ^ realLogDir oldUser)))
+ Slave.Delete _ =>
+ let
+ val ldir = realLogDir oldUser
+ val dlm = !delayedLogMoves
+ in
+ if !logDeleted then
+ ()
+ else
+ ((*ignore (OS.Process.system (down ()));*)
+ ignore (OS.Process.system (fixperms ()));
+ logDeleted := true);
+ ignore (OS.Process.system (Config.rm
+ ^ " -rf "
+ ^ realVhostFile));
+ delayedLogMoves := (fn () => (dlm ();
+ Slave.moveDirCreate {from = ldir,
+ to = backupLogs ()}))
+ end
| Slave.Add =>
let
val rld = realLogDir user
if Posix.FileSys.access (rld, []) then
()
else
- Slave.mkDirAll rld
+ Slave.moveDirCreate {from = backupLogs (),
+ to = rld}
end
| _ =>
let
val old = realLogDir oldUser
val rld = realLogDir user
+
+ val dlm = !delayedLogMoves
in
if !logDeleted then
()
else
- (ignore (OS.Process.system (down ()));
+ ((*ignore (OS.Process.system (down ()));*)
logDeleted := true);
- ignore (OS.Process.system (Config.rm
- ^ " -rf "
- ^ realLogDir oldUser));
+ delayedLogMoves := (fn () => (dlm ();
+ ignore (OS.Process.system (Config.rm
+ ^ " -rf "
+ ^ realLogDir oldUser))));
if Posix.FileSys.access (rld, []) then
()
else
val () = Slave.registerPostHandler
(fn () =>
(if !vhostsChanged then
- Slave.shellF ([if !logDeleted then undown () else reload ()],
- fn cl => "Error reloading Apache with " ^ cl)
+ (Slave.shellF ([reload ()],
+ fn cl => "Error reloading Apache with " ^ cl);
+ if !logDeleted then !delayedLogMoves () else ())
else
()))
val localRewriteEnabled = ref false
val currentVhost = ref ""
val currentVhostId = ref ""
+val sslEnabled = ref false
val pre = ref (fn _ : {user : string, nodes : string list, id : string, hostname : string} => ())
fun registerPre f =
post := (fn () => (old (); f ()))
end
+fun doPre x = !pre x
+fun doPost () = !post ()
+
val aliaser = ref (fn _ : string => ())
fun registerAliaser f =
let
aliaser := (fn x => (old x; f x))
end
+fun vhostPost () = (!post ();
+ write "</VirtualHost>\n";
+ app (TextIO.closeOut o #2) (!vhostFiles))
+
+val php_version = fn (EVar "php4", _) => SOME 4
+ | (EVar "php5", _) => SOME 5
+ | _ => NONE
+
+fun vhostBody (env, makeFullHost) =
+ let
+ val places = Env.env (Env.list webPlace) (env, "WebPlaces")
+
+ val ssl = Env.env ssl (env, "SSL")
+ val user = Env.env Env.string (env, "User")
+ val group = Env.env Env.string (env, "Group")
+ val docroot = Env.env Env.string (env, "DocumentRoot")
+ val sadmin = Env.env Env.string (env, "ServerAdmin")
+ val suexec = Env.env Env.bool (env, "SuExec")
+ val php = Env.env php_version (env, "PhpVersion")
+
+ val fullHost = makeFullHost (Domain.currentDomain ())
+ val vhostId = fullHost ^ (if Option.isSome ssl then ".ssl" else "")
+ val confFile = fullHost ^ (if Option.isSome ssl then ".vhost_ssl" else ".vhost")
+ in
+ currentVhost := fullHost;
+ currentVhostId := vhostId;
+ sslEnabled := Option.isSome ssl;
+
+ rewriteEnabled := false;
+ localRewriteEnabled := false;
+ vhostFiles := map (fn (node, ip) =>
+ let
+ val file = Domain.domainFile {node = node,
+ name = confFile}
+
+ val ld = logDir {user = user, node = node, vhostId = vhostId}
+ in
+ TextIO.output (file, "# Owner: ");
+ TextIO.output (file, user);
+ TextIO.output (file, "\n<VirtualHost ");
+ TextIO.output (file, ip);
+ TextIO.output (file, ":");
+ TextIO.output (file, case ssl of
+ SOME _ => "443"
+ | NONE => "80");
+ TextIO.output (file, ">\n");
+ TextIO.output (file, "\tErrorLog ");
+ TextIO.output (file, ld);
+ TextIO.output (file, "/error.log\n\tCustomLog ");
+ TextIO.output (file, ld);
+ TextIO.output (file, "/access.log combined\n");
+ TextIO.output (file, "\tServerName ");
+ TextIO.output (file, fullHost);
+ app
+ (fn dom => (TextIO.output (file, "\n\tServerAlias ");
+ TextIO.output (file, makeFullHost dom)))
+ (Domain.currentAliasDomains ());
+
+ if suexec then
+ if isVersion1 node then
+ (TextIO.output (file, "\n\tUser ");
+ TextIO.output (file, user);
+ TextIO.output (file, "\n\tGroup ");
+ TextIO.output (file, group))
+ else
+ (TextIO.output (file, "\n\tSuexecUserGroup ");
+ TextIO.output (file, user);
+ TextIO.output (file, " ");
+ TextIO.output (file, group))
+ else
+ ();
+
+ if isWaklog node then
+ (TextIO.output (file, "\n\tWaklogEnabled on\n\tWaklogLocationPrincipal ");
+ TextIO.output (file, user);
+ TextIO.output (file, "/daemon@HCOOP.NET /etc/keytabs/user.daemon/");
+ TextIO.output (file, user))
+ else
+ ();
+
+ TextIO.output (file, "\n\tDAVLockDB /var/lock/apache2/dav/");
+ TextIO.output (file, user);
+ TextIO.output (file, "/DAVLock");
+
+ if php <> Config.Apache.defaultPhpVersion then
+ (TextIO.output (file, "\n\tAddHandler x-httpd-php");
+ TextIO.output (file, Int.toString php);
+ TextIO.output (file, " .php .phtml"))
+ else
+ ();
+
+ (ld, file)
+ end)
+ places;
+ write "\n\tDocumentRoot ";
+ write docroot;
+ write "\n\tServerAdmin ";
+ write sadmin;
+ case ssl of
+ SOME cert =>
+ (write "\n\tSSLEngine on\n\tSSLCertificateFile ";
+ write cert)
+ | NONE => ();
+ write "\n";
+ !pre {user = user, nodes = map #1 places, id = vhostId, hostname = fullHost};
+ app (fn dom => !aliaser (makeFullHost dom)) (Domain.currentAliasDomains ())
+ end
+
val () = Env.containerV_one "vhost"
("host", Env.string)
- (fn (env, host) =>
- let
- val nodes = Env.env (Env.list Env.string) (env, "WebNodes")
-
- val ssl = Env.env ssl (env, "SSL")
- val user = Env.env Env.string (env, "User")
- val group = Env.env Env.string (env, "Group")
- val docroot = Env.env Env.string (env, "DocumentRoot")
- val sadmin = Env.env Env.string (env, "ServerAdmin")
- val suexec = Env.env Env.bool (env, "SuExec")
-
- val fullHost = host ^ "." ^ Domain.currentDomain ()
- val vhostId = fullHost ^ (if Option.isSome ssl then ".ssl" else "")
- val confFile = fullHost ^ (if Option.isSome ssl then ".vhost_ssl" else ".vhost")
- in
- currentVhost := fullHost;
- currentVhostId := vhostId;
+ (fn (env, host) => vhostBody (env, fn dom => host ^ "." ^ dom),
+ vhostPost)
- rewriteEnabled := false;
- localRewriteEnabled := false;
- vhostFiles := map (fn node =>
- let
- val file = Domain.domainFile {node = node,
- name = confFile}
- in
- TextIO.output (file, "# Owner: ");
- TextIO.output (file, user);
- TextIO.output (file, "\n<VirtualHost ");
- TextIO.output (file, Domain.nodeIp node);
- TextIO.output (file, ":");
- TextIO.output (file, case ssl of
- SOME _ => "443"
- | NONE => "80");
- TextIO.output (file, ">\n");
- TextIO.output (file, "\tErrorLog ");
- TextIO.output (file, logDir {user = user, node = node, vhostId = vhostId});
- TextIO.output (file, "/error.log\n\tCustomLog ");
- TextIO.output (file, logDir {user = user, node = node, vhostId = vhostId});
- TextIO.output (file, "/access.log combined\n");
- TextIO.output (file, "\tServerName ");
- TextIO.output (file, fullHost);
- if suexec then
- if isVersion1 node then
- (TextIO.output (file, "\n\tUser ");
- TextIO.output (file, user);
- TextIO.output (file, "\n\tGroup ");
- TextIO.output (file, group))
- else
- (TextIO.output (file, "\n\tSuexecUserGroup ");
- TextIO.output (file, user);
- TextIO.output (file, " ");
- TextIO.output (file, group))
- else
- ();
- if isWaklog node then
- (TextIO.output (file, "\n\tWaklogProtected on\n\tWaklogPrincipal ");
- TextIO.output (file, user);
- TextIO.output (file, "/cgi@HCOOP.NET /etc/keytabs/cgi/");
- TextIO.output (file, user))
- else
- ();
- (logDir {user = user, node = node, vhostId = vhostId}, file)
- end)
- nodes;
- write "\n\tDocumentRoot ";
- write docroot;
- write "\n\tServerAdmin ";
- write sadmin;
- case ssl of
- SOME cert =>
- (write "\n\tSSLEngine on\n\tSSLCertificateFile ";
- write cert)
- | NONE => ();
- write "\n";
- !pre {user = user, nodes = nodes, id = vhostId, hostname = fullHost}
- end,
- fn () => (!post ();
- write "</VirtualHost>\n";
- app (TextIO.closeOut o #2) (!vhostFiles)))
+val () = Env.containerV_none "vhostDefault"
+ (fn env => vhostBody (env, fn dom => dom),
+ vhostPost)
val inLocal = ref false
inLocal := false;
localRewriteEnabled := false))
+val () = Env.container_one "filesMatch"
+ ("regexp", Env.string)
+ (fn prefix =>
+ (write "\t<FilesMatch \"";
+ write prefix;
+ write "\">\n"),
+ fn () => (write "\t</FilesMatch>\n";
+ localRewriteEnabled := false))
+
fun checkRewrite () =
if !inLocal then
- if !rewriteEnabled orelse !localRewriteEnabled then
+ if !localRewriteEnabled then
()
else
(write "\tRewriteEngine on\n";
("from", Env.string, "to", Env.string, "port", Env.int)
(fn (from, to, port) =>
(checkRewrite ();
- write "\tRewriteRule\t";
+ write "\tRewriteRule\t\"";
write from;
- write "\thttp://localhost:";
+ write "\"\thttp://localhost:";
write (Int.toString port);
write "/";
write to;
("from", Env.string, "to", Env.string, "flags", Env.list flag)
(fn (from, to, flags) =>
(checkRewrite ();
- write "\tRewriteRule\t";
+ write "\tRewriteRule\t\"";
write from;
- write "\t";
+ write "\"\t\"";
write to;
+ write "\"";
case flags of
[] => ()
| flag::rest => (write " [";
("test", Env.string, "pattern", Env.string, "flags", Env.list cond_flag)
(fn (from, to, flags) =>
(checkRewrite ();
- write "\tRewriteCond\t";
+ write "\tRewriteCond\t\"";
write from;
- write "\t";
+ write "\"\t\"";
write to;
+ write "\"";
case flags of
[] => ()
| flag::rest => (write " [";
write "]");
write "\n"))
+val () = Env.action_one "rewriteBase"
+ ("prefix", Env.string)
+ (fn prefix =>
+ (checkRewrite ();
+ write "\tRewriteBase\t\"";
+ write prefix;
+ write "\"\n"))
+
val () = Env.action_one "rewriteLogLevel"
("level", Env.int)
(fn level =>
val () = Env.action_two "errorDocument"
("code", Env.string, "handler", Env.string)
(fn (code, handler) =>
- (write "\tErrorDocument\t";
- write code;
- write " ";
- write handler;
- write "\n"))
+ let
+ val hasSpaces = CharVector.exists Char.isSpace handler
+ fun maybeQuote () =
+ if hasSpaces then
+ write "\""
+ else
+ ()
+ in
+ write "\tErrorDocument\t";
+ write code;
+ write " ";
+ maybeQuote ();
+ write handler;
+ maybeQuote ();
+ write "\n"
+ end)
+
val () = Env.action_one "options"
("options", Env.list apache_option)
(fn opts =>
app (fn opt => (write " -"; write opt)) opts;
write "\n"))
+val () = Env.action_one "cgiExtension"
+ ("extension", Env.string)
+ (fn ext => (write "\tAddHandler cgi-script ";
+ write ext;
+ write "\n"))
+
val () = Env.action_one "directoryIndex"
("filenames", Env.list Env.string)
(fn opts =>
app (fn opt => (write " "; write opt)) opts;
write "\n"))
-val () = Env.action_one "serverAlias"
+val () = Env.action_one "serverAliasHost"
("host", Env.string)
(fn host =>
(write "\tServerAlias ";
write "\n";
!aliaser host))
+val () = Env.action_one "serverAlias"
+ ("host", Env.string)
+ (fn host =>
+ (app
+ (fn dom =>
+ let
+ val full = host ^ "." ^ dom
+ in
+ write "\tServerAlias ";
+ write full;
+ write "\n";
+ !aliaser full
+ end)
+ (Domain.currentDomains ())))
+
+val () = Env.action_none "serverAliasDefault"
+ (fn () =>
+ (app
+ (fn dom =>
+ (write "\tServerAlias ";
+ write dom;
+ write "\n";
+ !aliaser dom))
+ (Domain.currentDomains ())))
+
val authType = fn (EVar "basic", _) => SOME "basic"
| (EVar "digest", _) => SOME "digest"
+ | (EVar "kerberos", _) => SOME "kerberos"
| _ => NONE
+fun allowAuthType "kerberos" = !sslEnabled
+ | allowAuthType _ = true
+
val () = Env.action_one "authType"
("type", authType)
(fn ty =>
- (write "\tAuthType ";
- write ty;
- write "\n"))
+ if allowAuthType ty then
+ (write "\tAuthType ";
+ write ty;
+ write "\n";
+ case ty of
+ "kerberos" =>
+ write "\tKrbMethodNegotiate off\n\tKrbMethodK5Passwd on\n\tKrbVerifyKDC off\n\tKrbAuthRealms HCOOP.NET\n\tKrbSaveCredentials on\n"
+ | _ => ())
+ else
+ print "WARNING: Skipped Kerberos authType because this isn't an SSL vhost.\n")
val () = Env.action_one "authName"
("name", Env.string)
write path;
write "\n"))*)
+val () = Env.action_none "davFilesystem"
+ (fn path => write "\tDAV filesystem\n")
+
val () = Env.action_two "addDescription"
("description", Env.string, "patterns", Env.list Env.string)
(fn (desc, pats) =>
app (fn pat => (write " "; write pat)) pats;
write "\n"))
+val () = Env.action_two "addIcon"
+ ("icon", Env.string, "patterns", Env.list Env.string)
+ (fn (icon, pats) =>
+ case pats of
+ [] => ()
+ | _ => (write "\tAddIcon \"";
+ write icon;
+ write "\"";
+ app (fn pat => (write " "; write pat)) pats;
+ write "\n"))
+
val () = Env.action_one "indexOptions"
("options", Env.list autoindex_option)
(fn opts =>
(write "="; write arg)) arg)) opts;
write "\n"))
+val () = Env.action_one "indexIgnore"
+ ("patterns", Env.list Env.string)
+ (fn pats =>
+ case pats of
+ [] => ()
+ | _ => (write "\tIndexIgnore";
+ app (fn pat => (write " "; write pat)) pats;
+ write "\n"))
+
val () = Env.action_one "set_indexOptions"
("options", Env.list autoindex_option)
(fn opts =>
write name;
write "\n"))
+val () = Env.action_two "setEnv"
+ ("key", Env.string, "value", Env.string)
+ (fn (key, value) => (write "\tSetEnv \"";
+ write key;
+ write "\" \"";
+ write (String.translate (fn #"\"" => "\\\""
+ | ch => str ch) value);
+ write "\"\n"))
+
+val () = Env.action_one "diskCache"
+ ("path", Env.string)
+ (fn path => (write "\tCacheEnable disk \"";
+ write path;
+ write "\"\n"))
+
+val () = Env.action_one "phpVersion"
+ ("version", php_version)
+ (fn version => (write "\tAddHandler x-httpd-php";
+ write (Int.toString version);
+ write " .php .phtml\n"))
+
+val () = Env.action_two "addType"
+ ("mime type", Env.string, "extension", Env.string)
+ (fn (mt, ext) => (write "\tAddType ";
+ write mt;
+ write " ";
+ write ext;
+ write "\n"))
+
+val filter = fn (EVar "includes", _) => SOME "INCLUDES"
+ | (EVar "deflate", _) => SOME "DEFLATE"
+ | _ => NONE
+
+val () = Env.action_two "addOutputFilter"
+ ("filters", Env.list filter, "extensions", Env.list Env.string)
+ (fn (f :: fs, exts as (_ :: _)) =>
+ (write "\tAddOutputFilter ";
+ write f;
+ app (fn f => (write ";"; write f)) fs;
+ app (fn ext => (write " "; write ext)) exts;
+ write "\n")
+ | _ => ())
+
val () = Domain.registerResetLocal (fn () =>
ignore (OS.Process.system (Config.rm ^ " -rf /var/domtool/vhosts/*")))
+val () = Domain.registerDescriber (Domain.considerAll
+ [Domain.Extension {extension = "vhost",
+ heading = fn host => "Web vhost " ^ host ^ ":"},
+ Domain.Extension {extension = "vhost_ssl",
+ heading = fn host => "SSL web vhost " ^ host ^ ":"}])
+
+val () = Env.action_none "testNoHtaccess"
+ (fn path => write "\tAllowOverride None\n")
+
end