diff src/ur/openid.ur @ 7:976121190b2d

Authentication verification almost working: signatures not computing correctly
author Adam Chlipala <adam@chlipala.net>
date Tue, 28 Dec 2010 19:57:25 -0500
parents 99496175078b
children 870d99055dd1
line wrap: on
line diff
--- a/src/ur/openid.ur	Mon Dec 27 13:18:02 2010 -0500
+++ b/src/ur/openid.ur	Tue Dec 28 19:57:25 2010 -0500
@@ -34,8 +34,8 @@
 
 fun association url =
     secret <- oneOrNoRows1 (SELECT associations.Handle, associations.Key
-                             FROM associations
-                             WHERE associations.Endpoint = {[url]});
+                            FROM associations
+                            WHERE associations.Endpoint = {[url]});
     case secret of
         Some r => return (Association r)
       | None =>
@@ -44,6 +44,8 @@
         OpenidFfi.addInput is "openid.assoc_type" "HMAC-SHA256";
         OpenidFfi.addInput is "openid.session_type" "no-encryption";
 
+        debug ("Contacting " ^ url);
+
         os <- OpenidFfi.direct url is;
         case OpenidFfi.getOutput os "error" of
             Some v => return (AssError v)
@@ -57,6 +59,8 @@
                      dml (INSERT INTO associations (Endpoint, Handle, Key, Expires)
                           VALUES ({[url]}, {[handle]}, {[key]}, {[addSeconds tm expires]}));
                      return (Association {Handle = handle, Key = key}))
+              | (None, _, _) => return (AssError "Missing assoc_handle")
+              | (_, None, _) => return (AssError "Missing mac_key")
               | _ => return (AssError "Missing fields in response from OP")
 
 fun eatFragment s =
@@ -64,7 +68,7 @@
         Some (_, s') => s'
       | _ => s
 
-datatype handle_result = HandleOk of string | HandleError of string
+datatype handle_result = HandleOk of {Endpoint : string, Key : string} | HandleError of string
 
 fun verifyHandle os id =
     ep <- discover (eatFragment id);
@@ -81,7 +85,7 @@
                 if assoc.Handle <> handle then
                     return (HandleError "Association handles don't match")
                 else
-                    return (HandleOk ep)
+                    return (HandleOk {Endpoint = ep, Key = assoc.Key})
 
 table nonces : { Endpoint : string, Nonce : string, Expires : time }
   PRIMARY KEY (Endpoint, Nonce)
@@ -92,7 +96,7 @@
       | Some (date, s) =>
         case String.split s #"Z" of
             None => None
-          | Some (time, _) => read (date ^ " " ^ time)
+          | Some (time, _) => readUtc (date ^ " " ^ time)
 
 fun verifyNonce os ep =
     case OpenidFfi.getOutput os "openid.response_nonce" of
@@ -114,11 +118,12 @@
                 if b then
                     return (Some "Duplicate nonce")
                 else
+                    debug ("Nonce expires: " ^ show exp);
                     dml (INSERT INTO nonces (Endpoint, Nonce, Expires)
                          VALUES ({[ep]}, {[nonce]}, {[exp]}));
                     return None
 
-fun verifySig os =
+fun verifySig os key =
     case OpenidFfi.getOutput os "openid.signed" of
         None => return (Some "Missing openid.signed in OP response")
       | Some signed =>
@@ -148,10 +153,11 @@
                     None => return (Some "openid.signed mentions missing field")
                   | Some nvps =>
                     let
-                        val sign' = OpenidFfi.sha256 nvps
+                        val sign' = OpenidFfi.sha256 key nvps
                     in
                         debug ("Fields: " ^ signed);
                         debug ("Nvps: " ^ nvps);
+                        debug ("Key: " ^ key);
                         debug ("His: " ^ sign);
                         debug ("Mine: " ^ sign');
                         if sign' = sign then
@@ -181,7 +187,7 @@
                          errO <- verifyHandle os id;
                          case errO of
                              HandleError s => error <xml>{[s]}</xml>
-                           | HandleOk ep =>
+                           | HandleOk {Endpoint = ep, Key = key} =>
                              errO <- verifyReturnTo os;
                              case errO of
                                  Some s => error <xml>{[s]}</xml>
@@ -190,7 +196,7 @@
                                  case errO of
                                      Some s => error <xml>{[s]}</xml>
                                    | None =>
-                                     errO <- verifySig os;
+                                     errO <- verifySig os key;
                                      case errO of
                                          Some s => error <xml>{[s]}</xml>
                                        | None => return <xml>Identity: {[id]}</xml>)