val _ = Env.type_one "proxy_port"
Env.int
- (fn n => n >= 1024)
+ (fn n => n > 1024)
+
+val _ = Env.type_one "proxy_target"
+ Env.string
+ (fn s =>
+ let
+ 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 ())
+ | _ => default ()
+ end)
val _ = Env.type_one "rewrite_arg"
Env.string
(CharVector.all Char.isAlphaNum)
+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
+
+val _ = Env.type_one "location"
+ Env.string
+ validLocation
+
val dl = ErrorMsg.dummyLoc
val _ = Main.registerDefault ("WebNodes",
| _ => NONE
+val cond_flag = fn (EVar "cond_nocase", _) => SOME "NC"
+ | (EVar "ornext", _) => SOME "OR"
+ | _ => NONE
+
+val apache_option = fn (EVar "execCGI", _) => SOME "ExecCGI"
+ | (EVar "includesNOEXEC", _) => SOME "IncludesNOEXEC"
+ | (EVar "indexes", _) => SOME "Indexes"
+ | _ => NONE
+
val vhostsChanged = ref false
file
end)
nodes;
- write "\tSuexecUserGroup ";
+ write "\tServerName ";
+ write fullHost;
+ write "\n\tSuexecUserGroup ";
write user;
write " ";
write group;
fn () => (write "</VirtualHost>\n";
app TextIO.closeOut (!vhostFiles)))
+val () = Env.container_one "location"
+ ("prefix", Env.string)
+ (fn prefix =>
+ (write "\t<Location ";
+ write prefix;
+ write ">\n"),
+ fn () => write "\t</Location>\n")
+
+val () = Env.container_one "directory"
+ ("directory", Env.string)
+ (fn directory =>
+ (write "\t<Directory ";
+ write directory;
+ write ">\n"),
+ fn () => write "\t</Directory>\n")
+
fun checkRewrite () =
if !rewriteEnabled then
()
write to;
write " [P]\n"))
-val () = Env.action_three "localProxyPass"
- ("from", Env.string, "to", Env.string, "port", Env.int)
- (fn (from, to, port) =>
- let
- val to =
- case to of
- "" => "/"
- | _ => if String.sub (to, 0) = #"/" then
- to
- else
- "/" ^ to
- in
- write "\tProxyPass\t";
- write from;
- write "\thttp://localhost:";
- write (Int.toString port);
- write to;
- write "\n"
- end)
-
-val () = Env.action_three "localProxyPassReverse"
- ("from", Env.string, "to", Env.string, "port", Env.int)
- (fn (from, to, port) =>
- let
- val to =
- case to of
- "" => "/"
- | _ => if String.sub (to, 0) = #"/" then
- to
- else
- "/" ^ to
- in
- write "\tProxyPassReverse\t";
- write from;
- write "\thttp://localhost:";
- write (Int.toString port);
- write to;
- write "\n"
- end)
+val () = Env.action_two "proxyPass"
+ ("from", Env.string, "to", Env.string)
+ (fn (from, to) =>
+ (write "\tProxyPass\t";
+ write from;
+ write "\t";
+ write to;
+ write "\n"))
+
+val () = Env.action_two "proxyPassReverse"
+ ("from", Env.string, "to", Env.string)
+ (fn (from, to) =>
+ (write "\tProxyPassReverse\t";
+ write from;
+ write "\t";
+ write to;
+ write "\n"))
val () = Env.action_three "rewriteRule"
("from", Env.string, "to", Env.string, "flags", Env.list flag)
write "]");
write "\n"))
+val () = Env.action_three "rewriteCond"
+ ("test", Env.string, "pattern", Env.string, "flags", Env.list cond_flag)
+ (fn (from, to, flags) =>
+ (checkRewrite ();
+ write "\tRewriteCond\t";
+ write from;
+ write "\t";
+ write to;
+ case flags of
+ [] => ()
+ | flag::rest => (write " [";
+ write flag;
+ app (fn flag => (write ",";
+ write flag)) rest;
+ write "]");
+ write "\n"))
+
+val () = Env.action_two "alias"
+ ("from", Env.string, "to", Env.string)
+ (fn (from, to) =>
+ (write "\tAlias\t";
+ write from;
+ write " ";
+ write to;
+ write "\n"))
+
+val () = Env.action_two "scriptAlias"
+ ("from", Env.string, "to", Env.string)
+ (fn (from, to) =>
+ (write "\tScriptAlias\t";
+ write from;
+ write " ";
+ write to;
+ write "\n"))
+
+val () = Env.action_two "errorDocument"
+ ("code", Env.string, "handler", Env.string)
+ (fn (code, handler) =>
+ (write "\tErrorDocument\t";
+ write code;
+ write " ";
+ write handler;
+ write "\n"))
+
+val () = Env.action_one "options"
+ ("options", Env.list apache_option)
+ (fn opts =>
+ case opts of
+ [] => ()
+ | _ => (write "\tOptions";
+ app (fn opt => (write " "; write opt)) opts;
+ write "\n"))
+
+val () = Env.action_one "set_options"
+ ("options", Env.list apache_option)
+ (fn opts =>
+ case opts of
+ [] => ()
+ | _ => (write "\tOptions";
+ app (fn opt => (write " +"; write opt)) opts;
+ write "\n"))
+
+val () = Env.action_one "unset_options"
+ ("options", Env.list apache_option)
+ (fn opts =>
+ case opts of
+ [] => ()
+ | _ => (write "\tOptions";
+ app (fn opt => (write " -"; write opt)) opts;
+ write "\n"))
+
+val () = Env.action_one "directoryIndex"
+ ("filenames", Env.list Env.string)
+ (fn opts =>
+ (write "\tDirectoryIndex";
+ app (fn opt => (write " "; write opt)) opts;
+ write "\n"))
+
+val () = Env.action_one "serverAlias"
+ ("host", Env.string)
+ (fn host =>
+ (write "\tServerAlias ";
+ write host;
+ write "\n"))
+
+val authType = fn (EVar "basic", _) => SOME "basic"
+ | (EVar "digest", _) => SOME "digest"
+ | _ => NONE
+
+val () = Env.action_one "authType"
+ ("type", authType)
+ (fn ty =>
+ (write "\tAuthType ";
+ write ty;
+ write "\n"))
+
+val () = Env.action_one "authName"
+ ("name", Env.string)
+ (fn name =>
+ (write "\tAuthName \"";
+ write name;
+ write "\"\n"))
+
+val () = Env.action_one "authUserFile"
+ ("file", Env.string)
+ (fn name =>
+ (write "\tAuthUserFile ";
+ write name;
+ write "\n"))
+
+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"))
+
end
HCoop / hcoop / domtool2.git / blobdiff