Type annotations on environment variable reads

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

diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml
index 4c60d7a..64ebc7b 100644 (file)
--- a/src/plugins/apache.sml
+++ b/src/plugins/apache.sml
@@ -1,5 +1,5 @@
 (* HCoop Domtool (http://hcoop.sourceforge.net/)
- * Copyright (c) 2006, Adam Chlipala
+ * Copyright (c) 2006-2007, Adam Chlipala
  *
  * This program is free software; you can redistribute it and/or
  * modify it under the terms of the GNU General Public License
@@ -89,33 +89,29 @@ fun ssl e = case e of
 
 val dl = ErrorMsg.dummyLoc
 
-val _ = Defaults.registerDefault ("WebNodes",
-                                 (TList (TBase "web_node", dl), dl),
-                                 (fn () => (EList (map (fn s => (EString s, dl)) Config.Apache.webNodes_default), dl)))
-
-val _ = Defaults.registerDefault ("SSL",
-                                 (TBase "ssl", dl),
-                                 (fn () => (EVar "no_ssl", dl)))
-
-val _ = Defaults.registerDefault ("User",
-                                 (TBase "your_user", dl),
-                                 (fn () => (EString (Domain.getUser ()), dl)))
-
-val _ = Defaults.registerDefault ("Group",
-                                 (TBase "your_group", dl),
-                                 (fn () => (EString "nogroup", dl)))
-
-val _ = Defaults.registerDefault ("DocumentRoot",
-                                 (TBase "your_path", dl),
-                                 (fn () => (EString (Domain.homedir () ^ "/" ^ Config.Apache.public_html), dl)))
-
-val _ = Defaults.registerDefault ("ServerAdmin",
-                                 (TBase "email", dl),
-                                 (fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl)))
-
-val _ = Defaults.registerDefault ("SuExec",
-                                 (TBase "suexec_flag", dl),
-                                 (fn () => (EVar "true", dl)))
+val defaults = [("WebNodes",
+                (TList (TBase "web_node", dl), dl),
+                (fn () => (EList (map (fn s => (EString s, dl)) 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)))]
+
+val () = app Defaults.registerDefault defaults
 
 val redirect_code = fn (EVar "temp", _) => SOME "temp"
                     | (EVar "permanent", _) => SOME "permanent"
@@ -353,6 +349,7 @@ val rewriteEnabled = ref false
 val localRewriteEnabled = ref false
 val currentVhost = ref ""
 val currentVhostId = ref ""
+val sslEnabled = ref false
 
 val pre = ref (fn _ : {user : string, nodes : string list, id : string, hostname : string} => ())
 fun registerPre f =
@@ -397,6 +394,7 @@ val () = Env.containerV_one "vhost"
             in
                 currentVhost := fullHost;
                 currentVhostId := vhostId;
+                sslEnabled := Option.isSome ssl;
 
                 rewriteEnabled := false;
                 localRewriteEnabled := false;
@@ -429,6 +427,7 @@ val () = Env.containerV_one "vhost"
                                                           TextIO.output (file, ".");
                                                           TextIO.output (file, dom)))
                                               (Domain.currentAliasDomains ());
+
                                           if suexec then
                                               if isVersion1 node then
                                                   (TextIO.output (file, "\n\tUser ");
@@ -442,13 +441,19 @@ val () = Env.containerV_one "vhost"
                                                    TextIO.output (file, group))
                                           else
                                               ();
+
                                           if isWaklog node then
-                                              (TextIO.output (file, "\n\tWaklogProtected on\n\tWaklogPrincipal ");
+                                              (TextIO.output (file, "\n\tWaklogEnabled on\n\tWaklogLocationPrincipal ");
                                                TextIO.output (file, user);
-                                               TextIO.output (file, "/cgi@HCOOP.NET /etc/keytabs/cgi/");
+                                               TextIO.output (file, "/daemon@HCOOP.NET /etc/keytabs/user.daemon/");
                                                TextIO.output (file, user))
                                           else
                                               ();
+
+                                          TextIO.output (file, "\n\tDAVLockDB /var/lock/apache2/dav/");
+                                          TextIO.output (file, user);
+                                          TextIO.output (file, "/DAVLock");
+
                                           (ld, file)
                                       end)
                                   nodes;
@@ -570,6 +575,14 @@ val () = Env.action_three "rewriteCond"
                                 write "]");
              write "\n"))
 
+val () = Env.action_one "rewriteBase"
+        ("prefix", Env.string)
+        (fn prefix =>
+            (checkRewrite ();
+             write "\tRewriteBase\t";
+             write prefix;
+             write "\n"))
+
 val () = Env.action_one "rewriteLogLevel"
         ("level", Env.int)
         (fn level =>
@@ -679,16 +692,22 @@ val authType = fn (EVar "basic", _) => SOME "basic"
                | (EVar "kerberos", _) => SOME "kerberos"
                | _ => NONE
 
+fun allowAuthType "kerberos" = !sslEnabled
+  | allowAuthType _ = true
+
 val () = Env.action_one "authType"
         ("type", authType)
         (fn ty =>
-            (write "\tAuthType ";
-             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"
-               | _ => ()))
+            if allowAuthType ty then
+                (write "\tAuthType ";
+                 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"
+                   | _ => ())
+            else
+                print "WARNING: Skipped Kerberos authType because this isn't an SSL vhost.\n")
 
 val () = Env.action_one "authName"
         ("name", Env.string)
@@ -796,6 +815,9 @@ val () = Env.action_one "authzSvnAccessFile"
                      write path;
                      write "\n"))*)
 
+val () = Env.action_none "davFilesystem"
+        (fn path => write "\tDAV filesystem\n")
+
 val () = Env.action_two "addDescription"
         ("description", Env.string, "patterns", Env.list Env.string)
         (fn (desc, pats) =>
@@ -856,6 +878,15 @@ val () = Env.action_one "readmeName"
                      write name;
                      write "\n"))
 
+val () = Env.action_two "setEnv"
+        ("key", Env.string, "value", Env.string)
+        (fn (key, value) => (write "\tSetEnv \"";
+                             write key;
+                             write "\" \"";
+                             write (String.translate (fn #"\"" => "\\\""
+                                                       | ch => str ch) value);
+                             write "\"\n"))
+
 val () = Domain.registerResetLocal (fn () =>
                                       ignore (OS.Process.system (Config.rm ^ " -rf /var/domtool/vhosts/*")))