Mercurial > openid
diff src/ur/openid.ur @ 12:c778455fe570
Diffie-Hellman seems to be working
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Sat, 01 Jan 2011 14:00:52 -0500 |
parents | e637249abfd2 |
children | de04a3fc6b72 |
line wrap: on
line diff
--- a/src/ur/openid.ur Wed Dec 29 16:25:32 2010 -0500 +++ b/src/ur/openid.ur Sat Jan 01 14:00:52 2011 -0500 @@ -140,7 +140,12 @@ (case read expires of None => return (AssError "Invalid 'expires_in' field") | Some expires => - key <- OpenidFfi.compute dh pub; + secret <- OpenidFfi.compute dh pub; + digest <- return (case stype of + DH_SHA1 => OpenidFfi.sha1 secret + | DH_SHA256 => OpenidFfi.sha256 secret + | _ => error <xml>Non-DH stype in associateDh</xml>); + key <- return (OpenidFfi.xor mac digest); tm <- now; dml (INSERT INTO associations (Endpoint, Handle, Typ, Key, Expires) VALUES ({[url]}, {[handle]}, {[serialize atype]}, {[key]}, {[addSeconds tm expires]})); @@ -177,6 +182,7 @@ if alt.Atype = atype && alt.Stype = stype then return (AssError "Suggested new modes match old ones!") else + debug "Renegotiating protocol"; newAssociation url alt.Atype alt.Stype | v => return v @@ -273,8 +279,8 @@ | Some ([], nvps) => let val sign' = case atype of - HMAC_SHA256 => OpenidFfi.sha256 key nvps - | HMAC_SHA1 => OpenidFfi.sha1 key nvps + HMAC_SHA256 => OpenidFfi.hmac_sha256 key nvps + | HMAC_SHA1 => OpenidFfi.hmac_sha1 key nvps in (*debug ("Fields: " ^ signed); debug ("Nvps: " ^ nvps); @@ -291,11 +297,9 @@ datatype authentication = AuthenticatedAs of string | Canceled | Failure of string -sequence nextNonce - fun authenticate after r = let - fun returnTo myNonce (qs : option queryString) = + fun returnTo (qs : option queryString) = case qs of None => after (Failure "Empty query string for OpenID callback") | Some qs => @@ -316,7 +320,7 @@ case errO of HandleError s => after (Failure s) | HandleOk {Endpoint = ep, Typ = atype, Key = key} => - errO <- verifyReturnTo os myNonce; + errO <- verifyReturnTo os; case errO of Some s => after (Failure s) | None => @@ -330,11 +334,11 @@ | None => after (AuthenticatedAs id)) | _ => after (Failure ("Unexpected openid.mode: " ^ mode)) - and verifyReturnTo os myNonce = + and verifyReturnTo os = case OpenidFfi.getOutput os "openid.return_to" of None => return (Some "Missing return_to in OP response") | Some rt => - if rt <> show (effectfulUrl (returnTo myNonce)) then + if rt <> show (effectfulUrl returnTo) then return (Some "Wrong return_to in OP response") else return None @@ -348,10 +352,9 @@ AssError msg => return ("Association failure: " ^ msg) | AssAlternate _ => return "Association failure: server didn't accept its own alternate association modes" | Association assoc => - myNonce <- nextval nextNonce; 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 myNonce)))) + ^ assoc.Handle ^ "&openid.return_to=" ^ show (effectfulUrl returnTo))) end task periodic 1 = fn () =>