From f8dfbbcc29a40de94580697e610db6254b85f0fb Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 6 Aug 2006 21:08:33 +0000 Subject: [PATCH] mod_rewrite and ProxyPass --- lib/apache.dtl | 5 ++ lib/domain.dtl | 3 + lib/mod_rewrite.dtl | 51 +++++++++++++++++ lib/proxy.dtl | 10 ++++ src/domain.sml | 4 ++ src/env.sig | 6 ++ src/env.sml | 9 +++ src/plugins/apache.sml | 125 +++++++++++++++++++++++++++++++++++++++++ tests/testApache.dtl | 8 ++- 9 files changed, 219 insertions(+), 2 deletions(-) create mode 100644 lib/mod_rewrite.dtl create mode 100644 lib/proxy.dtl diff --git a/lib/apache.dtl b/lib/apache.dtl index 3b41927..43dd928 100644 --- a/lib/apache.dtl +++ b/lib/apache.dtl @@ -10,3 +10,8 @@ extern val vhost : host -> Vhost => [Domain] 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.}} diff --git a/lib/domain.dtl b/lib/domain.dtl index ac0345c..62256ed 100644 --- a/lib/domain.dtl +++ b/lib/domain.dtl @@ -1,5 +1,8 @@ {{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}} diff --git a/lib/mod_rewrite.dtl b/lib/mod_rewrite.dtl new file mode 100644 index 0000000..7097ec5 --- /dev/null +++ b/lib/mod_rewrite.dtl @@ -0,0 +1,51 @@ +{{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 the + Apache documentation 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 Apache + documentation for RewriteRule.}} + +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.}} + diff --git a/lib/proxy.dtl b/lib/proxy.dtl new file mode 100644 index 0000000..bc487a5 --- /dev/null +++ b/lib/proxy.dtl @@ -0,0 +1,10 @@ +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 ProxyPass and LocalProxyPass for + proxying to localhost only. The arguments give: +
  • The URL prefix to treat as proxied
    • +
  • The corresponding URL prefix on the other local server
    • +
  • The port number of the local server
    • }} diff --git a/src/domain.sml b/src/domain.sml index aa392bc..91d8005 100644 --- a/src/domain.sml +++ b/src/domain.sml @@ -71,6 +71,10 @@ fun yourPath path = 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 diff --git a/src/env.sig b/src/env.sig index adb03ea..31e6691 100644 --- a/src/env.sig +++ b/src/env.sig @@ -55,6 +55,9 @@ signature ENV = sig 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 @@ -66,6 +69,9 @@ signature ENV = sig 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 diff --git a/src/env.sml b/src/env.sml index d9905dd..1a93a38 100644 --- a/src/env.sml +++ b/src/env.sml @@ -135,6 +135,14 @@ fun two func (name1, arg1, name2, arg2) f (_, [e1, e2]) = 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 @@ -169,6 +177,7 @@ fun type_one func arg f = 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) diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml index 27641ab..faa2c65 100644 --- a/src/plugins/apache.sml +++ b/src/plugins/apache.sml @@ -22,6 +22,14 @@ structure Apache :> APACHE = struct 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", @@ -48,6 +56,44 @@ val _ = Main.registerDefault ("ServerAdmin", (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 @@ -90,6 +136,8 @@ val () = Slave.registerPostHandler 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) => @@ -105,6 +153,7 @@ val () = Env.containerV_one "vhost" 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, @@ -134,4 +183,80 @@ val () = Env.containerV_one "vhost" fn () => (write "\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 diff --git a/tests/testApache.dtl b/tests/testApache.dtl index 1c7ed54..3cee61d 100644 --- a/tests/testApache.dtl +++ b/tests/testApache.dtl @@ -12,9 +12,13 @@ domain "hcoop.net" with 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 - - -- 2.20.1