mod_rewrite and ProxyPass

[hcoop/domtool2.git] / src / plugins / apache.sml

diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml
index 27641ab..faa2c65 100644 (file)
--- a/src/plugins/apache.sml
+++ b/src/plugins/apache.sml
@@ -22,6 +22,14 @@ structure Apache :> APACHE = struct
 
 open Ast
 
 
 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",
 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)))
 
                              (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 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 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 () = 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
                 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,
                 vhostFiles := map (fn node =>
                                       let
                                           val file = Domain.domainFile {node = node,


@@ -134,4 +183,80 @@ val () = Env.containerV_one "vhost"
          fn () => (write "</VirtualHost>\n";
                    app TextIO.closeOut (!vhostFiles)))
 
          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
 end