Support ! as a ProxyPass target

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

diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml
index d53d687..e160745 100644 (file)
--- a/src/plugins/apache.sml
+++ b/src/plugins/apache.sml
@@ -62,32 +62,34 @@ 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
@@ -144,32 +146,9 @@ val _ = Env.type_one "file_extension"
        Env.string
        validExtension
 
-val defaults = [("WebPlaces",
-                (TList (TBase "web_place", dl), dl),
-                (fn () => (EList (map webPlaceDefault Config.Apache.webNodes_default), dl))),
-               ("SSL",
-                (TBase "ssl", dl),
-                (fn () => (EVar "no_ssl", dl))),
-               ("User",
-                (TBase "your_user", dl),
-                (fn () => (EString (Domain.getUser ()), dl))),
-               ("Group",
-                (TBase "your_group", dl),
-                (fn () => (EString "nogroup", dl))),
-               ("DocumentRoot",
-                (TBase "your_path", dl),
-                (fn () => (EString (Domain.homedir () ^ "/" ^ Config.Apache.public_html), dl))),
-               ("ServerAdmin",
-                (TBase "email", dl),
-                (fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl))),
-               ("SuExec",
-                (TBase "suexec_flag", dl),
-                (fn () => (EVar "true", dl))),
-               ("PhpVersion",
-                (TBase "php_version", dl),
-                (fn () => (EVar "php4", dl)))]
-
-val () = app Defaults.registerDefault defaults
+val _ = Env.registerFunction ("defaultServerAdmin",
+                             fn [] => SOME (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl)
+                             | _ => NONE)
 
 val redirect_code = fn (EVar "temp", _) => SOME "temp"
                     | (EVar "permanent", _) => SOME "permanent"
@@ -486,8 +465,7 @@ fun vhostPost () = (!post ();
                    write "</VirtualHost>\n";
                    app (TextIO.closeOut o #2) (!vhostFiles))
 
-val php_version = fn (EVar "php4", _) => SOME 4
-                  | (EVar "php5", _) => SOME 5
+val php_version = fn (EVar "php5", _) => SOME 5
                   | _ => NONE
 
 fun vhostBody (env, makeFullHost) =
@@ -898,7 +876,7 @@ val () = Env.action_one "authType"
                  write "\n";
                  case ty of
                      "kerberos" => 
-                     write "\tKrbMethodNegotiate off\n\tKrbMethodK5Passwd on\n\tKrbVerifyKDC off\n\tKrbAuthRealms HCOOP.NET\n\tKrbSaveCredentials on\n"
+                     write "\tKrbServiceName apache2\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")
@@ -917,6 +895,13 @@ val () = Env.action_one "authUserFile"
              write name;
              write "\n"))
 
+val () = Env.action_one "authGroupFile"
+        ("file", Env.string)
+        (fn name =>
+            (write "\tAuthGroupFile ";
+             write name;
+             write "\n"))
+
 val () = Env.action_none "requireValidUser"
         (fn () => write "\tRequire valid-user\n")
 
@@ -1146,7 +1131,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",