apache: fix phpVersion action

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

diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml
index 524321c..59e96b3 100644 (file)
--- a/src/plugins/apache.sml
+++ b/src/plugins/apache.sml
@@ -1,6 +1,6 @@
 (* HCoop Domtool (http://hcoop.sourceforge.net/)
  * Copyright (c) 2006-2009, Adam Chlipala
- * Copyright (c) 2013 Clinton Ebadi
+ * Copyright (c) 2013,2014,2015,2017,2018,2019 Clinton Ebadi
  *
  * This program is free software; you can redistribute it and/or
  * modify it under the terms of the GNU General Public License
@@ -97,7 +97,8 @@ val _ = Env.type_one "proxy_reverse_target"
 
 val _ = Env.type_one "rewrite_arg"
        Env.string
-       (CharVector.all (fn ch => (Char.isGraph ch) andalso not (List.exists (fn c => ch = c) [ #"[", #"]", #",", #"\"", #"'", #"=", #":", #"\\" ])))
+       (* #":" is permitted here, but really ought to be disallowed or escaped for E=VAR:VAL *)
+       (CharVector.all (fn ch => (Char.isGraph ch) andalso not (List.exists (fn c => ch = c) [ #"[", #"]", #",", #"\"", #"'", #"=", #"\\" ])))
 
 val _ = Env.type_one "suexec_flag"
        Env.bool
@@ -472,7 +473,10 @@ fun vhostPost () = (!post ();
 
 val php_version = fn (EVar "php56", _) => SOME 56
                    | (EVar "php72", _) => SOME 72
-                   | _ => NONE
+                  | (EVar "php73", _) => SOME 73
+                  | (EVar "php74", _) => SOME 74
+                  | (EVar "php80", _) => SOME 80
+                  | _ => NONE
 
 fun vhostBody (env, makeFullHost) =
     let
@@ -558,7 +562,7 @@ fun vhostBody (env, makeFullHost) =
                                  else
                                      ();
 
-                                 TextIO.output (file, "\n\tDAVLockDB /var/lock/apache2/dav/");
+                                 TextIO.output (file, "\n\tDAVLockDB /var/local/domtool/apache2/dav/");
                                  TextIO.output (file, user);
                                  TextIO.output (file, "/DAVLock");
 
@@ -662,17 +666,26 @@ fun checkExpires () =
        (write "\tExpiresActive on\n";
         expiresEnabled := true)
 
-val () = Env.action_three "localProxyRewrite"
-        ("from", Env.string, "to", Env.string, "port", Env.int)
-        (fn (from, to, port) =>
+val () = Env.action_four "proxyRewrite"
+        ("from", Env.string, "to", Env.string, "tohost", Env.string, "flags", Env.list flag)
+        (fn (from, to, tohost, flags) =>
             (checkRewrite ();
              write "\tRewriteRule\t\"";
              write from;
-             write "\"\thttp://localhost:";
-             write (Int.toString port);
-             write "/";
+             write "\"\t\"";
+             write tohost;
+             write "/"; (* ensure rewrite rule can't change port *)
              write to;
-             write " [P]\n"))
+             write "\"";
+             write " [P";
+             case flags of
+                 [] => ()
+               | flag::rest => (write ",";
+                                write flag;
+                                app (fn flag => (write ",";
+                                                 write flag)) rest);
+
+             write "]\n"))
 
 val () = Env.action_four "expiresByType"
         ("mime", Env.string, "base", interval_base, "num", Env.int, "inter", interval)
@@ -761,15 +774,20 @@ val () = Env.action_one "rewriteBase"
              write prefix;
              write "\"\n"))
 
+val _ = Env.type_one "mod_rewrite_trace_level"
+       Env.int
+       (fn n => n > 0 andalso n <= 8)
+
 val () = Env.action_one "rewriteLogLevel"
         ("level", Env.int)
-        (fn level =>
+        (fn 0 =>
             (checkRewrite ();
-             write "\tRewriteLog ";
-             write' (fn x => x);
-             write "/rewrite.log\n\tRewriteLogLevel ";
-             write (Int.toString level);
-             write "\n"))
+             write "\tLogLevel rewrite:warn\n")
+        | level =>
+          (checkRewrite ();
+           write "\tLogLevel rewrite:trace";
+           write (Int.toString level);
+           write "\n"))
 
 val () = Env.action_two "alias"
         ("from", Env.string, "to", Env.string)
@@ -886,6 +904,13 @@ val () = Env.action_one "directoryIndex"
              app (fn opt => (write " "; write opt)) opts;
              write "\n"))
 
+val () = Env.action_one "directorySlash"
+       ("enable", Env.bool)
+       (fn enable =>
+           (write "\tDirectorySlash ";
+            if enable then write "On" else write "Off";
+            write "\n"))
+
 val () = Env.action_one "serverAliasHost"
         ("host", Env.string)
         (fn host =>
@@ -1146,6 +1171,34 @@ val () = Env.action_two "setEnv"
                                                        | ch => str ch) value);
                              write "\"\n"))
 
+val () = Env.action_three "setEnvIf"
+        ("attribute", Env.string, "match", Env.string, "env_variables", Env.list Env.string)
+        (fn (attribute, match, envs) =>
+            case envs of
+                [] => (print "WARNING: Skipped setEnvIf, no environment variables provided.\n")
+             | envs =>
+               (write "\tSetEnvIf\t\"";
+                write attribute;
+                write "\"\t\"";
+                write match;
+                write "\"";
+                app (fn env => (write "\t"; write env)) envs;
+                write "\n"))
+
+val () = Env.action_three "setEnvIfNoCase"
+        ("attribute", Env.string, "match", Env.string, "env_variables", Env.list Env.string)
+        (fn (attribute, match, envs) =>
+            case envs of
+                [] => (print "WARNING: Skipped setEnvIfNoCase, no environment variables provided.\n")
+             | envs =>
+               (write "\tSetEnvIfNoCase\t\"";
+                write attribute;
+                write "\"\t\"";
+                write match;
+                write "\"";
+                app (fn env => (write "\t"; write env)) envs;
+                write "\n"))
+
 val () = Env.action_one "diskCache"
         ("path", Env.string)
         (fn path => (write "\tCacheEnable disk \"";
@@ -1155,13 +1208,16 @@ val () = Env.action_one "diskCache"
 val () = Env.action_one "phpVersion"
         ("version", php_version)
         (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"))
+                        (* FIXME: only set kerberos wrapper of waklog is on *)
+                        (* won't be trivial, since we don't have access to node here *)
+                        app (fn ext => (write "\n\tFcgidWrapper \"";
+                                        write (Config.Apache.fastCgiWrapperOf (Domain.getUser ()));
+                                        write " ";
+                                        write (Config.Apache.phpFastCgiWrapper version);
+                                        write "\" ";
+                                        write ext;
+                                        write "\n"))
+                            [".php", ".phtml"]))
 
 val () = Env.action_two "addType"
         ("mime type", Env.string, "extension", Env.string)