Mercurial > openid

changeset 13:de04a3fc6b72

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Stateless verification worked
author Adam Chlipala <adam@chlipala.net>
date Sun, 02 Jan 2011 10:11:38 -0500
parents c778455fe570
children 6b2a44da71b0
files include/openid.h src/c/openid.c src/ur/openid.ur src/ur/openid.urs src/ur/openidFfi.urs tests/test.ur
diffstat 6 files changed, 65 insertions(+), 22 deletions(-) [+]
line wrap: on
line diff
--- a/include/openid.h	Sat Jan 01 14:00:52 2011 -0500
+++ b/include/openid.h	Sun Jan 02 10:11:38 2011 -0500
@@ -39,3 +39,5 @@
 uw_OpenidFfi_dh uw_OpenidFfi_generate(uw_context);
 uw_Basis_string uw_OpenidFfi_compute(uw_context, uw_OpenidFfi_dh, uw_Basis_string server_pub);
 uw_Basis_string uw_OpenidFfi_xor(uw_context, uw_Basis_string, uw_Basis_string);
+
+uw_OpenidFfi_inputs uw_OpenidFfi_remode(uw_context, uw_OpenidFfi_outputs, uw_Basis_string mode);
--- a/src/c/openid.c	Sat Jan 01 14:00:52 2011 -0500
+++ b/src/c/openid.c	Sun Jan 02 10:11:38 2011 -0500
@@ -446,3 +446,16 @@
 
   return base64(ctx, bufO, len1);
 }
+
+uw_OpenidFfi_inputs uw_OpenidFfi_remode(uw_context ctx, uw_OpenidFfi_outputs out, uw_Basis_string mode) {
+  uw_OpenidFfi_inputs in = uw_OpenidFfi_createInputs(ctx);
+  char *s;
+
+  for (s = out->start; *s; s = strchr(strchr(s, 0)+1, 0)+1)
+    if (!strcmp("openid.mode", s))
+      uw_OpenidFfi_addInput(ctx, in, "openid.mode", mode);
+    else
+      uw_OpenidFfi_addInput(ctx, in, s, strchr(s, 0)+1);
+
+  return in;
+}
--- a/src/ur/openid.ur	Sat Jan 01 14:00:52 2011 -0500
+++ b/src/ur/openid.ur	Sun Jan 02 10:11:38 2011 -0500
@@ -30,6 +30,10 @@
 
 datatype association_type = HMAC_SHA1 | HMAC_SHA256
 datatype association_session_type = NoEncryption | DH_SHA1 | DH_SHA256
+datatype association_mode =
+         Stateless
+       | Stateful of {AssociationType : association_type,
+                      AssociationSessionType : association_session_type}
 
 table associations : { Endpoint : string, Handle : string, Typ : serialized association_type, Key : string, Expires : time }
   PRIMARY KEY Endpoint
@@ -191,7 +195,9 @@
         Some (s', _) => s'
       | _ => s
 
-datatype handle_result = HandleOk of {Endpoint : string, Typ : association_type, Key : string} | HandleError of string
+datatype handle_result = HandleOk of {Endpoint : string, Typ : association_type, Key : string} | NoAssociation of string | HandleError of string
+
+datatype authentication = AuthenticatedAs of string | Canceled | Failure of string
 
 fun verifyHandle os id =
     id' <- return (eatFragment id);
@@ -204,13 +210,22 @@
           | Some handle =>
             assoc <- oldAssociation ep;
             case assoc of
-                None => return (HandleError "Couldn't find association handle")
+                None => return (NoAssociation ep)
               | Some assoc =>
                 if assoc.Handle <> handle then
                     return (HandleError "Association handles don't match")
                 else
                     return (HandleOk {Endpoint = ep, Typ = assoc.Typ, Key = assoc.Key})
 
+fun verifyStateless os ep id =
+    os' <- OpenidFfi.direct ep (OpenidFfi.remode os "check_authentication");
+    case OpenidFfi.getOutput os' "error" of
+        Some msg => return (Failure ("Failure confirming message contents with OP: " ^ msg))
+      | None =>
+        case OpenidFfi.getOutput os' "is_valid" of
+            Some "true" => return (AuthenticatedAs id)
+          | _ => return (Failure "OP does not confirm message contents")
+
 table nonces : { Endpoint : string, Nonce : string, Expires : time }
   PRIMARY KEY (Endpoint, Nonce)
 
@@ -295,8 +310,6 @@
                   | Some (left, _) => return (Some ("openid.signed is missing required fields: " ^ show left))
             end
 
-datatype authentication = AuthenticatedAs of string | Canceled | Failure of string
-
 fun authenticate after r =
     let
         fun returnTo (qs : option queryString) =
@@ -305,7 +318,7 @@
               | Some qs =>
                 os <- OpenidFfi.indirect qs;
                 case OpenidFfi.getOutput os "openid.error" of
-                    Some v => after (Failure "Authentication failed: {[v]}")
+                    Some v => after (Failure ("Authentication failed: " ^ v))
                   | None =>
                     case OpenidFfi.getOutput os "openid.mode" of
                         None => after (Failure "No openid.mode in response")
@@ -316,14 +329,17 @@
                             (case OpenidFfi.getOutput os "openid.claimed_id" of
                                  None => after (Failure "Missing identity in OP response")
                                | Some id =>
-                                 errO <- verifyHandle os id;
+                                 errO <- verifyReturnTo os;
                                  case errO of
-                                     HandleError s => after (Failure s)
-                                   | HandleOk {Endpoint = ep, Typ = atype, Key = key} =>
-                                     errO <- verifyReturnTo os;
+                                     Some s => after (Failure s)
+                                   | None =>
+                                     errO <- verifyHandle os id;
                                      case errO of
-                                         Some s => after (Failure s)
-                                       | None =>
+                                         HandleError s => after (Failure s)
+                                       | NoAssociation ep =>
+                                         r <- verifyStateless os ep id;
+                                         after r
+                                       | HandleOk {Endpoint = ep, Typ = atype, Key = key} =>
                                          errO <- verifyNonce os ep;
                                          case errO of
                                              Some s => after (Failure s)
@@ -347,14 +363,20 @@
         case dy of
             None => return "Discovery failed"
           | Some dy =>
-            assoc <- association r.AssociationType r.AssociationSessionType dy;
-            case assoc of
-                AssError msg => return ("Association failure: " ^ msg)
-              | AssAlternate _ => return "Association failure: server didn't accept its own alternate association modes"
-              | Association assoc =>
+            case r.Association of
+                Stateless =>
                 redirect (bless (dy ^ "?openid.ns=http://specs.openid.net/auth/2.0&openid.mode=checkid_setup&openid.claimed_id="
-                                 ^ r.Identifier ^ "&openid.identity=http://specs.openid.net/auth/2.0/identifier_select&openid.assoc_handle="
-                                 ^ assoc.Handle ^ "&openid.return_to=" ^ show (effectfulUrl returnTo)))
+                                 ^ r.Identifier ^ "&openid.identity=http://specs.openid.net/auth/2.0/identifier_select&openid.return_to="
+                                 ^ show (effectfulUrl returnTo)))
+              | Stateful ar =>
+                assoc <- association ar.AssociationType ar.AssociationSessionType dy;
+                case assoc of
+                    AssError msg => return ("Association failure: " ^ msg)
+                  | AssAlternate _ => return "Association failure: server didn't accept its own alternate association modes"
+                  | Association assoc =>
+                    redirect (bless (dy ^ "?openid.ns=http://specs.openid.net/auth/2.0&openid.mode=checkid_setup&openid.claimed_id="
+                                     ^ r.Identifier ^ "&openid.identity=http://specs.openid.net/auth/2.0/identifier_select&openid.assoc_handle="
+                                     ^ assoc.Handle ^ "&openid.return_to=" ^ show (effectfulUrl returnTo)))
     end
 
 task periodic 1 = fn () =>
--- a/src/ur/openid.urs	Sat Jan 01 14:00:52 2011 -0500
+++ b/src/ur/openid.urs	Sun Jan 02 10:11:38 2011 -0500
@@ -1,10 +1,14 @@
 datatype association_type = HMAC_SHA1 | HMAC_SHA256
 datatype association_session_type = NoEncryption | DH_SHA1 | DH_SHA256
+datatype association_mode =
+         Stateless
+       | Stateful of {AssociationType : association_type,
+                      AssociationSessionType : association_session_type}
+
 datatype authentication = AuthenticatedAs of string | Canceled | Failure of string
 
 val authenticate : (authentication -> transaction page)
-                   -> {AssociationType : association_type,
-                       AssociationSessionType : association_session_type,
+                   -> {Association : association_mode,
                        Identifier : string}
                    -> transaction string
 (* Doesn't return normally if everything goes as planned.
--- a/src/ur/openidFfi.urs	Sat Jan 01 14:00:52 2011 -0500
+++ b/src/ur/openidFfi.urs	Sun Jan 02 10:11:38 2011 -0500
@@ -29,3 +29,5 @@
 val generate : transaction dh
 val compute : dh -> string -> transaction string
 val xor : string -> string -> string
+
+val remode : outputs -> string -> inputs
--- a/tests/test.ur	Sat Jan 01 14:00:52 2011 -0500
+++ b/tests/test.ur	Sun Jan 02 10:11:38 2011 -0500
@@ -7,8 +7,8 @@
 
 fun auth r =
     msg <- Openid.authenticate afterward
-                               {AssociationType = Openid.HMAC_SHA256,
-                                AssociationSessionType = Openid.NoEncryption,
+                               {Association = Openid.Stateless (* Openid.Stateful {AssociationType = Openid.HMAC_SHA256,
+                                                                                   AssociationSessionType = Openid.NoEncryption} *),
                                 Identifier = r.Id};
     error <xml>{[msg]}</xml>