apache: relax rewrite_arg syntax
[hcoop/domtool2.git] / src / plugins / apache.sml
index 35bd070..9d180ab 100644 (file)
@@ -39,59 +39,65 @@ val _ = Env.registerFunction ("web_node_to_node",
                               | _ => NONE)
 
 fun webPlace (EApp ((EVar "web_place_default", _), (EString node, _)), _) =
-    SOME (node, Domain.nodeIp node)
-  | webPlace (EApp ((EApp ((EVar "web_place", _), (EString node, _)), _), (EString ip, _)), _) =
-    SOME (node, ip)
+    SOME (node, Domain.nodeIp node, Domain.nodeIpv6 node)
+  | webPlace (EApp ((EApp ((EApp ((EVar "web_place", _), (EString node, _)), _), (EString ip, _)), _), (EString ipv6, _)), _) =
+    SOME (node, ip, ipv6)
   | webPlace _ = NONE
 
 fun webPlaceDefault node = (EApp ((EVar "web_place_default", dl), (EString node, dl)), dl)
 
 val _ = Env.registerFunction ("web_place_to_web_node",
-                             fn [e] => Option.map (fn (node, _) => (EString node, dl)) (webPlace e)
+                             fn [e] => Option.map (fn (node, _, _) => (EString node, dl)) (webPlace e)
                               | _ => NONE)
 
 val _ = Env.registerFunction ("web_place_to_node",
-                             fn [e] => Option.map (fn (node, _) => (EString node, dl)) (webPlace e)
+                             fn [e] => Option.map (fn (node, _, _) => (EString node, dl)) (webPlace e)
                               | _ => NONE)
 
 val _ = Env.registerFunction ("web_place_to_ip",
-                             fn [e] => Option.map (fn (_, ip) => (EString ip, dl)) (webPlace e)
-                              | _ => NONE)
+                             fn [e] => Option.map (fn (_, ip, _) => (EString ip, dl)) (webPlace e)
+                             | _ => NONE)
+
+val _ = Env.registerFunction ("web_place_to_ipv6",
+                             fn [e] => Option.map (fn (_, _, ipv6) => (EString ipv6, dl)) (webPlace e)
+                             | _ => NONE)
 
 val _ = Env.type_one "proxy_port"
        Env.int
        (fn n => n > 1024)
 
+fun validProxyTarget default s =
+    case String.fields (fn ch => ch = #":") s of
+       "http" :: host :: rest =>
+       let
+           val rest = String.concatWith ":" rest
+       in
+           if List.exists (fn h' => host = h') (map (fn h => String.concat ["//", h]) Config.Apache.proxyHosts)
+           then
+               CharVector.all (fn ch => Char.isPrint ch andalso not (Char.isSpace ch)
+                                        andalso ch <> #"\"" andalso ch <> #"'") rest
+               andalso case String.fields (fn ch => ch = #"/") rest of
+                           port :: _ =>
+                           (case Int.fromString port of
+                                NONE => default s
+                              | SOME n => n > 1024 orelse default s)
+                         | _ => default s
+           else
+               default s
+       end
+      | _ => default s
+
 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" :: host :: rest =>
-                   let
-                       val rest = String.concatWith ":" rest
-                   in
-                       if List.exists (fn h' => host = h') (map (fn h => String.concat ["//", h]) Config.Apache.proxyHosts)
-                       then
-                           CharVector.all (fn ch => Char.isPrint ch andalso not (Char.isSpace ch)
-                                                    andalso ch <> #"\"" andalso ch <> #"'") rest
-                           andalso case String.fields (fn ch => ch = #"/") rest of
-                                       port :: _ =>
-                                       (case Int.fromString port of
-                                            NONE => default ()
-                                          | SOME n => n > 1024 orelse default ())
-                                     | _ => default ()
-                       else
-                           default ()
-                   end
-                 | _ => default ()
-           end)
+       (validProxyTarget (fn s => List.exists (fn s' => s = s') (Config.Apache.proxyTargets @ ["!"])))
+
+val _ = Env.type_one "proxy_reverse_target"
+       Env.string
+       (validProxyTarget (fn s => List.exists (fn s' => s = s') Config.Apache.proxyTargets))
 
 val _ = Env.type_one "rewrite_arg"
        Env.string
-       (CharVector.all Char.isAlphaNum)
+       (CharVector.all (fn ch => (Char.isGraph ch) andalso not (List.exists (fn c => ch = c) [ #"[", #"]", #",", #"\"", #"'", #"=", #":" ])))
 
 val _ = Env.type_one "suexec_flag"
        Env.bool
@@ -158,6 +164,7 @@ val redirect_code = fn (EVar "temp", _) => SOME "temp"
                     | (EVar "redir304", _) => SOME "304"
                     | (EVar "redir305", _) => SOME "305"
                     | (EVar "redir307", _) => SOME "307"
+                    | (EVar "notfound", _) => SOME "404"
                     | _ => NONE
 
 val flag = fn (EVar "redirect", _) => SOME "R"
@@ -375,7 +382,7 @@ val () = Slave.registerFileHandler (fn fs =>
                                                                       Slave.moveDirCreate {from = backupLogs (),
                                                                                            to = rld}
                                                               end
-                                                              
+
                                                             | _ =>
                                                               (ignore (OS.Process.system (Config.cp
                                                                                           ^ " "
@@ -463,8 +470,9 @@ fun vhostPost () = (!post ();
                    write "</VirtualHost>\n";
                    app (TextIO.closeOut o #2) (!vhostFiles))
 
-val php_version = fn (EVar "php5", _) => SOME 5
-                  | _ => NONE
+val php_version = fn (EVar "php56", _) => SOME 56
+                   | (EVar "php72", _) => SOME 72
+                   | _ => NONE
 
 fun vhostBody (env, makeFullHost) =
     let
@@ -490,7 +498,7 @@ fun vhostBody (env, makeFullHost) =
        localRewriteEnabled := false;
        expiresEnabled := false;
        localExpiresEnabled := false;
-       vhostFiles := map (fn (node, ip) =>
+       vhostFiles := map (fn (node, ip, ipv6) =>
                              let
                                  val file = Domain.domainFile {node = node,
                                                                name = confFile}
@@ -500,11 +508,21 @@ fun vhostBody (env, makeFullHost) =
                                  TextIO.output (file, "# Owner: ");
                                  TextIO.output (file, user);
                                  TextIO.output (file, "\n<VirtualHost ");
+
                                  TextIO.output (file, ip);
                                  TextIO.output (file, ":");
                                  TextIO.output (file, case ssl of
                                                           SOME _ => "443"
                                                         | NONE => "80");
+
+                                 TextIO.output (file, " [");
+                                 TextIO.output (file, ipv6);
+                                 TextIO.output (file, "]");
+                                 TextIO.output (file, ":");
+                                 TextIO.output (file, case ssl of
+                                                          SOME _ => "443"
+                                                        | NONE => "80");
+
                                  TextIO.output (file, ">\n");
                                  TextIO.output (file, "\tErrorLog ");
                                  TextIO.output (file, ld);
@@ -526,10 +544,6 @@ fun vhostBody (env, makeFullHost) =
                                           TextIO.output (file, group))
                                      else
                                          (TextIO.output (file, "\n\tSuexecUserGroup ");
-                                          TextIO.output (file, user);
-                                          TextIO.output (file, " ");
-                                          TextIO.output (file, group);
-                                          TextIO.output (file, "\n\tsuPHP_UserGroup ");
                                           TextIO.output (file, user);
                                           TextIO.output (file, " ");
                                           TextIO.output (file, group))
@@ -548,14 +562,19 @@ fun vhostBody (env, makeFullHost) =
                                  TextIO.output (file, user);
                                  TextIO.output (file, "/DAVLock");
 
-                                 if php <> Config.Apache.defaultPhpVersion then
-                                     (TextIO.output (file, "\n\tAddHandler x-httpd-php");
-                                      TextIO.output (file, Int.toString php);
-                                      TextIO.output (file, " .php .phtml"))
-                                 else
-                                     ();
-
-                                 (ld, file)
+                                 TextIO.output (file, "\n\tAddHandler fcgid-script .php .phtml");
+                                 map (fn ext => (TextIO.output (file, "\n\tFcgidWrapper \"");
+                                                 (* kerberos wrapper, simulates waklog+mod_cgi *)
+                                                 if isWaklog node then
+                                                     (TextIO.output (file, Config.Apache.fastCgiWrapperOf user);
+                                                      TextIO.output (file, " "))
+                                                 else
+                                                     ();
+                                                 TextIO.output (file, Config.Apache.phpFastCgiWrapper php);
+                                                 TextIO.output (file, "\" ");
+                                                 TextIO.output (file, ext)))
+                                     [".php", ".phtml"];
+                         (ld, file)
                              end)
                          places;
        write "\n\tDocumentRoot ";
@@ -570,7 +589,7 @@ fun vhostBody (env, makeFullHost) =
        write "\n";
        !pre {user = user, nodes = map #1 places, id = vhostId, hostname = fullHost};
        app (fn dom => !aliaser (makeFullHost dom)) (Domain.currentAliasDomains ())
-    end    
+    end
 
 val () = Env.containerV_one "vhost"
         ("host", Env.string)
@@ -680,7 +699,7 @@ val () = Env.action_two "proxyPass"
                  write from;
                  write "\t";
                  write to;
-                 write "\n"))
+                 write "\tretry=0\n"))
 
 val () = Env.action_two "proxyPassReverse"
         ("from", Env.string, "to", Env.string)
@@ -691,6 +710,13 @@ val () = Env.action_two "proxyPassReverse"
                  write to;
                  write "\n"))
 
+val () = Env.action_one "proxyPreserveHost"
+        ("enable", Env.bool)
+        (fn (enable) =>
+            (write "\tProxyPreserveHost\t";
+             if enable then write "On" else write "Off";
+             write "\n"))
+
 val () = Env.action_three "rewriteRule"
         ("from", Env.string, "to", Env.string, "flags", Env.list flag)
         (fn (from, to, flags) =>
@@ -763,6 +789,42 @@ val () = Env.action_two "scriptAlias"
              write to;
              write "\n"))
 
+val () = Env.action_two "fastScriptAlias"
+        ("from", Env.string, "to", Env.string)
+        (fn (from, to) =>
+            let
+                (* mod_fcgid + kerberos limit this to working with
+                individual fcgi programs. assume the target path is a
+                file and any trailing `/' is just aliasing
+                syntax. Directory+File on the script is used to
+                activate fcgid instead of Location on the alias to
+                limit effects (alias+location also match in inverse
+                order causing pernicious side-effects *)
+                val fcgi_path = if String.sub (to, size to - 1) = #"/"
+                                then
+                                    String.substring (to, 0, size to - 1)
+                                else
+                                    to
+                val fcgi_dir = OS.Path.dir fcgi_path
+                val fcgi_file = OS.Path.file fcgi_path
+            in
+                write "\tAlias\t"; write from; write " "; write to;  write "\n";
+
+                write "\t<Directory "; write fcgi_dir;  write ">\n";
+                write "\t<Files "; write fcgi_file;  write ">\n";
+                write "\tSetHandler fcgid-script\n";
+
+                (* FIXME: only set kerberos wrapper of waklog is on *)
+                (* won't be trivial, since we don't have access to node here *)
+                write "\tFcgidWrapper \"";
+                write (Config.Apache.fastCgiWrapperOf (Domain.getUser ()));
+                write " ";
+                write fcgi_path;
+                write "\"\n";
+
+                write "\t</Files>\n\t</Directory>\n"
+            end)
+
 val () = Env.action_two "errorDocument"
         ("code", Env.string, "handler", Env.string)
         (fn (code, handler) =>
@@ -783,7 +845,7 @@ val () = Env.action_two "errorDocument"
                 maybeQuote ();
                 write "\n"
             end)
-                         
+
 val () = Env.action_one "options"
         ("options", Env.list apache_option)
         (fn opts =>
@@ -873,8 +935,8 @@ val () = Env.action_one "authType"
                  write ty;
                  write "\n";
                  case ty of
-                     "kerberos" => 
-                     write "\tKrbMethodNegotiate off\n\tKrbMethodK5Passwd on\n\tKrbVerifyKDC off\n\tKrbAuthRealms HCOOP.NET\n\tKrbSaveCredentials on\n"
+                     "kerberos" =>
+                     write "\tKrbServiceName HTTP\n\tKrb5Keytab /etc/keytabs/service/apache\n\tKrbMethodNegotiate on\n\tKrbMethodK5Passwd on\n\tKrbVerifyKDC on\n\tKrbAuthRealms HCOOP.NET\n\tKrbSaveCredentials on\n"
                    | _ => ())
             else
                 print "WARNING: Skipped Kerberos authType because this isn't an SSL vhost.\n")
@@ -1092,9 +1154,14 @@ val () = Env.action_one "diskCache"
 
 val () = Env.action_one "phpVersion"
         ("version", php_version)
-        (fn version => (write "\tAddHandler x-httpd-php";
-                        write (Int.toString version);
-                        write " .php .phtml\n"))
+        (fn version => (write "\tAddHandler fcgid-script .php .phtml\n";
+                             (* FIXME: only set kerberos wrapper of waklog is on *)
+                             (* won't be trivial, since we don't have access to node here *)
+                             write "\n\tFcgidWrapper \"";
+                             write (Config.Apache.fastCgiWrapperOf (Domain.getUser ()));
+                             write " ";
+                             write (Config.Apache.phpFastCgiWrapper version);
+                             write "\" .php .phtml\n"))
 
 val () = Env.action_two "addType"
         ("mime type", Env.string, "extension", Env.string)
@@ -1129,7 +1196,7 @@ val () = Env.action_one "sslCertificateChainFile"
                 print "WARNING: Skipped sslCertificateChainFile because this isn't an SSL vhost.\n")
 
 val () = Domain.registerResetLocal (fn () =>
-                                      ignore (OS.Process.system (Config.rm ^ " -rf /var/domtool/vhosts/*")))
+                                      ignore (OS.Process.system (Config.rm ^ " -rf " ^ Config.Apache.confDir ^ "/*")))
 
 val () = Domain.registerDescriber (Domain.considerAll
                                   [Domain.Extension {extension = "vhost",
@@ -1137,6 +1204,11 @@ val () = Domain.registerDescriber (Domain.considerAll
                                    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")