Mercurial > openid
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>)