+val () = Env.action_none "requireValidUser"
+ (fn () => write "\tRequire valid-user\n")
+
+val () = Env.action_one "requireUser"
+ ("users", Env.list Env.string)
+ (fn names =>
+ case names of
+ [] => ()
+ | _ => (write "\tRequire user";
+ app (fn name => (write " "; write name)) names;
+ write "\n"))
+
+val () = Env.action_one "requireGroup"
+ ("groups", Env.list Env.string)
+ (fn names =>
+ case names of
+ [] => ()
+ | _ => (write "\tRequire group";
+ app (fn name => (write " "; write name)) names;
+ write "\n"))
+
+val () = Env.action_none "orderAllowDeny"
+ (fn () => write "\tOrder allow,deny\n")
+
+val () = Env.action_none "orderDenyAllow"
+ (fn () => write "\tOrder deny,allow\n")
+
+val () = Env.action_none "allowFromAll"
+ (fn () => write "\tAllow from all\n")
+
+val () = Env.action_one "allowFrom"
+ ("entries", Env.list Env.string)
+ (fn names =>
+ case names of
+ [] => ()
+ | _ => (write "\tAllow from";
+ app (fn name => (write " "; write name)) names;
+ write "\n"))
+
+val () = Env.action_none "denyFromAll"
+ (fn () => write "\tDeny from all\n")
+
+val () = Env.action_one "denyFrom"
+ ("entries", Env.list Env.string)
+ (fn names =>
+ case names of
+ [] => ()
+ | _ => (write "\tDeny from";
+ app (fn name => (write " "; write name)) names;
+ write "\n"))
+
+val () = Env.action_none "satisfyAll"
+ (fn () => write "\tSatisfy all\n")
+
+val () = Env.action_none "satisfyAny"
+ (fn () => write "\tSatisfy any\n")
+
+val () = Env.action_one "forceType"
+ ("type", Env.string)
+ (fn ty => (write "\tForceType ";
+ write ty;
+ write "\n"))
+
+val () = Env.action_none "forceTypeOff"
+ (fn () => write "\tForceType None\n")
+
+val () = Env.action_two "action"
+ ("what", Env.string, "how", Env.string)
+ (fn (what, how) => (write "\tAction ";
+ write what;
+ write " ";
+ write how;
+ write "\n"))
+
+val () = Env.action_one "addDefaultCharset"
+ ("charset", Env.string)
+ (fn ty => (write "\tAddDefaultCharset ";
+ write ty;
+ write "\n"))
+
+(*val () = Env.action_one "davSvn"
+ ("path", Env.string)
+ (fn path => (write "\tDAV svn\n\tSVNPath ";
+ write path;
+ write "\n"))
+
+val () = Env.action_one "authzSvnAccessFile"
+ ("path", Env.string)
+ (fn path => (write "\tAuthzSVNAccessFile ";
+ 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) =>
+ case pats of
+ [] => ()
+ | _ => (write "\tAddDescription \"";
+ write (String.toString desc);
+ write "\"";
+ 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 =>
+ case opts of
+ [] => ()
+ | _ => (write "\tIndexOptions";
+ app (fn (opt, arg) =>
+ (write " ";
+ write opt;
+ Option.app (fn arg =>
+ (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 =>
+ case opts of
+ [] => ()
+ | _ => (write "\tIndexOptions";
+ app (fn (opt, arg) =>
+ (write " +";
+ write opt;
+ Option.app (fn arg =>
+ (write "="; write arg)) arg)) opts;
+ write "\n"))
+
+val () = Env.action_one "unset_indexOptions"
+ ("options", Env.list autoindex_option)
+ (fn opts =>
+ case opts of
+ [] => ()
+ | _ => (write "\tIndexOptions";
+ app (fn (opt, _) =>
+ (write " -";
+ write opt)) opts;
+ write "\n"))
+
+val () = Env.action_one "headerName"
+ ("name", Env.string)
+ (fn name => (write "\tHeaderName ";
+ write name;
+ write "\n"))
+
+val () = Env.action_one "readmeName"
+ ("name", Env.string)
+ (fn name => (write "\tReadmeName ";
+ 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 () = Env.action_one "sslCertificateChainFile"
+ ("ssl_cacert_path", Env.string)
+ (fn cacert =>
+ if !sslEnabled then
+ (write "\tSSLCertificateChainFile \"";
+ write cacert;
+ write "\"\n")
+ else
+ print "WARNING: Skipped sslCertificateChainFile because this isn't an SSL vhost.\n")
+
+val () = Domain.registerResetLocal (fn () =>
+ ignore (OS.Process.system (Config.rm ^ " -rf " ^ Config.Apache.confDir ^ "/*")))
+
+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_one "allowEncodedSlashes"
+ ("enable", Env.bool)
+ (fn enable => (write "\tAllowEncodedSlashes ";
+ write (if enable then "NoDecode" else "Off");
+ write "\n"))
+val () = Env.action_none "testNoHtaccess"
+ (fn path => write "\tAllowOverride None\n")
+
+fun writeWaklogUserFile () =
+ let
+ val users = Acl.users ()
+ val outf = TextIO.openOut Config.Apache.waklogUserFile
+ in
+ app (fn user => if String.isSuffix "_admin" user then
+ ()
+ else
+ (TextIO.output (outf, "<Location /~");
+ TextIO.output (outf, user);
+ TextIO.output (outf, ">\n\tWaklogEnabled on\n\tWaklogLocationPrincipal ");
+ TextIO.output (outf, user);
+ TextIO.output (outf, "/daemon@HCOOP.NET /etc/keytabs/user.daemon/");
+ TextIO.output (outf, user);
+ TextIO.output (outf, "\n</Location>\n\n"))) users;
+ TextIO.closeOut outf
+ end
+
+val () = Domain.registerOnUsersChange writeWaklogUserFile