Disallow authType kerberos in non-SSL vhosts
authorAdam Chlipala <adamc@hcoop.net>
Thu, 11 Oct 2007 09:45:27 +0000 (09:45 +0000)
committerAdam Chlipala <adamc@hcoop.net>
Thu, 11 Oct 2007 09:45:27 +0000 (09:45 +0000)
src/plugins/apache.sml

index e4e96ea..4cd9e82 100644 (file)
@@ -1,5 +1,5 @@
 (* HCoop Domtool (http://hcoop.sourceforge.net/)
 (* 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
  *
  * This program is free software; you can redistribute it and/or
  * modify it under the terms of the GNU General Public License
@@ -353,6 +353,7 @@ val rewriteEnabled = ref false
 val localRewriteEnabled = ref false
 val currentVhost = ref ""
 val currentVhostId = ref ""
 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 =
 
 val pre = ref (fn _ : {user : string, nodes : string list, id : string, hostname : string} => ())
 fun registerPre f =
@@ -397,6 +398,7 @@ val () = Env.containerV_one "vhost"
             in
                 currentVhost := fullHost;
                 currentVhostId := vhostId;
             in
                 currentVhost := fullHost;
                 currentVhostId := vhostId;
+                sslEnabled := Option.isSome ssl;
 
                 rewriteEnabled := false;
                 localRewriteEnabled := false;
 
                 rewriteEnabled := false;
                 localRewriteEnabled := false;
@@ -687,16 +689,22 @@ val authType = fn (EVar "basic", _) => SOME "basic"
                | (EVar "kerberos", _) => SOME "kerberos"
                | _ => NONE
 
                | (EVar "kerberos", _) => SOME "kerberos"
                | _ => NONE
 
+fun allowAuthType "kerberos" = !sslEnabled
+  | allowAuthType _ = true
+
 val () = Env.action_one "authType"
         ("type", authType)
         (fn ty =>
 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)
 
 val () = Env.action_one "authName"
         ("name", Env.string)