Support for Kerberos auth

diff --git a/config.sig b/config.sig
index 1fe37f8..d3ca805 100644 (file)
--- a/config.sig
+++ b/config.sig
@@ -5,5 +5,6 @@ val urlPrefix : string
 val emailSuffix : string
 val boardEmail : string
 val dbstring : string
+val kerberosSuffix : string
 
 end

diff --git a/config.sml b/config.sml
index 25a4cdb..ab7cfec 100644 (file)
--- a/config.sml
+++ b/config.sml
@@ -7,4 +7,6 @@ val boardEmail = "board" ^ emailSuffix
 
 val dbstring = "dbname='hcoop_hcoop' user='www-data'"
 
+val kerberosSuffix = "@HCOOP.NET"
+
 end

diff --git a/init.sml b/init.sml
index d6aae9c..9352b3e 100644 (file)
--- a/init.sml
+++ b/init.sml
@@ -43,32 +43,40 @@ fun init () =
        case Web.getCgi "REMOTE_USER" of
            NONE => raise Fail "Not logged in"
          | SOME name =>
-           (case C.oneOrNoRows c ($`SELECT id, name, rname, bal, joined, app, shares
-                                    FROM WebUserActive
-                                    WHERE name=^(C.stringToSql name)`) of
-                NONE => raise Fail "User not found"
-              | SOME r =>
-                let
-                    val r = mkUserRow r
-                in
-                    user := SOME r;
-                    case C.oneOrNoRows c ($`SELECT ipaddr
+           let
+               val name =
+                   if String.isSuffix kerberosSuffix name then
+                       String.substring (name, 0, size name - size kerberosSuffix)
+                   else
+                       name
+           in
+               case C.oneOrNoRows c ($`SELECT id, name, rname, bal, joined, app, shares
+                                       FROM WebUserActive
+                                       WHERE name=^(C.stringToSql name)`) of
+                   NONE => raise Fail "User not found"
+                 | SOME r =>
+                   let
+                       val r = mkUserRow r
+                   in
+                       user := SOME r;
+                       case C.oneOrNoRows c ($`SELECT ipaddr
                                                FROM MemberApp
                                                WHERE id = ^(C.intToSql (#app r))
-                                                  AND ipaddr IS NOT NULL`) of
-                        NONE =>
-                        if Web.getParam "agree" = "on" then
-                            (case Web.getCgi "REMOTE_ADDR" of
-                                 NONE => raise Fail "REMOTE_ADDR not set"
-                               | SOME ra =>
-                                 ignore (C.dml c ($`UPDATE MemberApp
+                                                               AND ipaddr IS NOT NULL`) of
+                           NONE =>
+                           if Web.getParam "agree" = "on" then
+                               (case Web.getCgi "REMOTE_ADDR" of
+                                    NONE => raise Fail "REMOTE_ADDR not set"
+                                  | SOME ra =>
+                                    ignore (C.dml c ($`UPDATE MemberApp
                                                        SET ipaddr = ^(C.stringToSql ra),
-                                                           applied = CURRENT_TIMESTAMP
-                                                       WHERE id = ^(C.intToSql (#app r))`)))
-                        else
-                            raise NeedTos
-                      | _ => ()
-                end)
+                                                         applied = CURRENT_TIMESTAMP
+                                                       WHERE id = ^(C.intToSql (#app r))`)))
+                           else
+                               raise NeedTos
+                         | _ => ()
+                   end
+           end
     end
 
 fun done () =