Group : your_group,
DocumentRoot : your_path,
ServerAdmin : email};
+{{Add a new named Apache virtual host, specifying which nodes' Apache servers
+ should answer requests for this host, whether it should use SSL, what UNIX
+ user and group dynamic content generators should be run as, the filesystem
+ path to the static content root, and the e-mail address to which error pages
+ should direct visitors.}}
{{Configuring shared daemons with respect to a particular Internet domain name}}
+extern type no_spaces;
+{{Any string with no space characters}}
+
extern type ip;
{{An IP address}}
--- /dev/null
+{{Support for Apache's mod_rewrite, which allows fancy mappings from URLs to
+ resources}}
+
+extern type redirect_code;
+{{An HTTP code to return as part of a redirection}}
+extern val temp : redirect_code;
+extern val permanent : redirect_code;
+extern val seeother : redirect_code;
+extern val redir300 : redirect_code;
+extern val redir301 : redirect_code;
+extern val redir302 : redirect_code;
+extern val redir303 : redirect_code;
+extern val redir304 : redirect_code;
+extern val redir305 : redirect_code;
+extern val redir307 : redirect_code;
+
+extern type rewrite_arg;
+{{Some mod_rewrite flags take arguments.
+ This type stands for values that may validly be given for one of those
+ arguments, which excludes commas and some other characters.}}
+
+extern type mod_rewrite_flag;
+{{See <a href="http://httpd.apache.org/docs/2.0/mod/mod_rewrite.html#rewriterule">the
+ Apache documentation</a> for information on what these flags mean.}}
+
+extern val redirect : mod_rewrite_flag;
+extern val forbidden : mod_rewrite_flag;
+extern val gone : mod_rewrite_flag;
+extern val last : mod_rewrite_flag;
+extern val chain : mod_rewrite_flag;
+extern val nosubreq : mod_rewrite_flag;
+extern val nocase : mod_rewrite_flag;
+extern val qsappend : mod_rewrite_flag;
+extern val noescape : mod_rewrite_flag;
+extern val passthrough : mod_rewrite_flag;
+
+extern val mimeType : rewrite_arg -> mod_rewrite_flag;
+extern val redirectWith : redirect_code -> mod_rewrite_flag;
+extern val skip : int -> mod_rewrite_flag;
+extern val env : rewrite_arg -> rewrite_arg -> mod_rewrite_flag;
+
+extern val rewriteRule : no_spaces -> no_spaces -> [mod_rewrite_flag] -> [Vhost];
+{{See <a href="http://httpd.apache.org/docs/2.0/mod/mod_rewrite.html#rewriterule">Apache
+ documentation for <tt>RewriteRule</tt></a>.}}
+
+extern val localProxyRewrite : no_spaces -> no_spaces -> proxy_port -> [Vhost];
+{{All requests matching the regular expression in the first argument are
+ redirected to another HTTPD running on localhost at the given port, generating
+ the new URI by substituting variables in the second argument as per Apache
+ mod_rewrite.}}
+
--- /dev/null
+extern type proxy_port;
+{{A port number above 1024}}
+
+extern val localProxyPass : no_spaces -> no_spaces -> proxy_port -> [Vhost];
+extern val localProxyPassReverse : no_spaces -> no_spaces -> proxy_port -> [Vhost];
+{{Interface to Apache <tt>ProxyPass</tt> and <tt>LocalProxyPass</tt> for
+ proxying to localhost only. The arguments give:
+ <li> The URL prefix to treat as proxied</li>
+ <li> The corresponding URL prefix on the other local server</li>
+ <li> The port number of the local server</li>}}
orelse ch = #"-" orelse ch = #"_") path
andalso SS.exists (fn s' => path = s' orelse String.isPrefix (s' ^ "/") path) (your_paths ())
+val _ = Env.type_one "no_spaces"
+ Env.string
+ (CharVector.all (fn ch => not (Char.isSpace ch)))
+
val _ = Env.type_one "ip"
Env.string
validIp
val none : string -> (unit -> unit) -> action
val one : string -> string * 'a arg -> ('a -> unit) -> action
val two : string -> string * 'a arg * string * 'b arg -> ('a * 'b -> unit) -> action
+ val three : string
+ -> string * 'a arg * string * 'b arg * string * 'c arg
+ -> ('a * 'b * 'c -> unit) -> action
val oneV : string -> string * 'a arg -> (env_vars * 'a -> unit) -> action
val twoV : string -> string * 'a arg * string * 'b arg -> (env_vars * 'a * 'b -> unit) -> action
val action_none : string -> (unit -> unit) -> unit
val action_one : string -> string * 'a arg -> ('a -> unit) -> unit
val action_two : string -> string * 'a arg * string * 'b arg -> ('a * 'b -> unit) -> unit
+ val action_three : string
+ -> string * 'a arg * string * 'b arg * string * 'c arg
+ -> ('a * 'b * 'c -> unit) -> unit
val actionV_none : string -> (env_vars -> unit) -> unit
val actionV_one : string -> string * 'a arg -> (env_vars * 'a -> unit) -> unit
SM.empty))
| two func _ _ (_, es) = badArgs (func, es)
+fun three func (name1, arg1, name2, arg2, name3, arg3) f (_, [e1, e2, e3]) =
+ (case (arg1 e1, arg2 e2, arg3 e3) of
+ (NONE, _, _) => badArg (func, name1, e1)
+ | (_, NONE, _) => badArg (func, name2, e2)
+ | (_, _, NONE) => badArg (func, name3, e3)
+ | (SOME v1, SOME v2, SOME v3) => (f (v1, v2, v3);
+ SM.empty))
+ | three func _ _ (_, es) = badArgs (func, es)
fun oneV func (name, arg) f (evs, [e]) =
(case arg e of
fun action_none name f = registerAction (name, none name f)
fun action_one name args f = registerAction (name, one name args f)
fun action_two name args f = registerAction (name, two name args f)
+fun action_three name args f = registerAction (name, three name args f)
fun actionV_none name f = registerAction (name, fn (env, _) => (f env; env))
fun actionV_one name args f = registerAction (name, oneV name args f)
open Ast
+val _ = Env.type_one "proxy_port"
+ Env.int
+ (fn n => n >= 1024)
+
+val _ = Env.type_one "rewrite_arg"
+ Env.string
+ (CharVector.all Char.isAlphaNum)
+
val dl = ErrorMsg.dummyLoc
val _ = Main.registerDefault ("WebNodes",
(TBase "email", dl),
(fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl)))
+
+val redirect_code = fn (EVar "temp", _) => SOME "temp"
+ | (EVar "permanent", _) => SOME "permanent"
+ | (EVar "seeother", _) => SOME "seeother"
+ | (EVar "redir300", _) => SOME "300"
+ | (EVar "redir301", _) => SOME "301"
+ | (EVar "redir302", _) => SOME "302"
+ | (EVar "redir303", _) => SOME "303"
+ | (EVar "redir304", _) => SOME "304"
+ | (EVar "redir305", _) => SOME "305"
+ | (EVar "redir307", _) => SOME "307"
+ | _ => NONE
+
+val flag = fn (EVar "redirect", _) => SOME "R"
+ | (EVar "forbidden", _) => SOME "F"
+ | (EVar "gone", _) => SOME "G"
+ | (EVar "last", _) => SOME "L"
+ | (EVar "chain", _) => SOME "C"
+ | (EVar "nosubreq", _) => SOME "NS"
+ | (EVar "nocase", _) => SOME "NC"
+ | (EVar "qsappend", _) => SOME "QSA"
+ | (EVar "noescape", _) => SOME "NE"
+ | (EVar "passthrough", _) => SOME "PT"
+ | (EApp ((EVar "mimeType", _), e), _) =>
+ Option.map (fn s => "T=" ^ s) (Env.string e)
+ | (EApp ((EVar "redirectWith", _), e), _) =>
+ Option.map (fn s => "R=" ^ s) (redirect_code e)
+ | (EApp ((EVar "skip", _), e), _) =>
+ Option.map (fn n => "S=" ^ Int.toString n) (Env.int e)
+ | (EApp ((EApp ((EVar "env", _), e1), _), e2), _) =>
+ (case Env.string e1 of
+ NONE => NONE
+ | SOME s1 => Option.map (fn s2 => "E=" ^ s1 ^ ":" ^ s2)
+ (Env.string e2))
+
+ | _ => NONE
+
+
val vhostsChanged = ref false
val () = Slave.registerPreHandler
val vhostFiles : TextIO.outstream list ref = ref []
fun write s = app (fn file => TextIO.output (file, s)) (!vhostFiles)
+val rewriteEnabled = ref false
+
val () = Env.containerV_one "vhost"
("host", Env.string)
(fn (env, host) =>
val fullHost = host ^ "." ^ Domain.currentDomain ()
val confFile = fullHost ^ (if ssl then ".vhost_ssl" else ".vhost")
in
+ rewriteEnabled := false;
vhostFiles := map (fn node =>
let
val file = Domain.domainFile {node = node,
fn () => (write "</VirtualHost>\n";
app TextIO.closeOut (!vhostFiles)))
+fun checkRewrite () =
+ if !rewriteEnabled then
+ ()
+ else
+ (write "\tRewriteEngine on\n";
+ rewriteEnabled := true)
+
+val () = Env.action_three "localProxyRewrite"
+ ("from", Env.string, "to", Env.string, "port", Env.int)
+ (fn (from, to, port) =>
+ (checkRewrite ();
+ write "\tRewriteRule\t";
+ write from;
+ write "\thttp://localhost:";
+ write (Int.toString port);
+ write "/";
+ 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_three "rewriteRule"
+ ("from", Env.string, "to", Env.string, "flags", Env.list flag)
+ (fn (from, to, flags) =>
+ (checkRewrite ();
+ write "\tRewriteRule\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"))
+
end
vhost "members" where
SSL = true
with
+ localProxyRewrite "^/(.*)$" "$1" 6666;
+ rewriteRule "^/foo.html" "/bar.html" [redirectWith redir300, nosubreq]
+ end;
+ vhost "proxy" with
+ localProxyPass "/proxyLand" "/otherProxyLand" 1234;
+ localProxyPassReverse "/proxyLand" "/otherProxyLand" 1234
end
end
-
-
HCoop / hcoop / domtool2.git / commitdiff