Mercurial > openid
changeset 6:99496175078b
Added preliminary versions of all the authentication verification steps
| author | Adam Chlipala <adam@chlipala.net> |
|---|---|
| date | Mon, 27 Dec 2010 13:18:02 -0500 |
| parents | 443f27cd1572 |
| children | 976121190b2d |
| files | include/openid.h src/c/openid.c src/ur/lib.urp src/ur/openid.ur src/ur/openidFfi.urs |
| diffstat | 5 files changed, 194 insertions(+), 9 deletions(-) [+] |
line wrap: on
line diff
--- a/include/openid.h Sun Dec 26 17:36:07 2010 -0500 +++ b/include/openid.h Mon Dec 27 13:18:02 2010 -0500 @@ -19,3 +19,5 @@ uw_OpenidFfi_outputs uw_OpenidFfi_direct(uw_context, uw_Basis_string url, uw_OpenidFfi_inputs); uw_OpenidFfi_outputs uw_OpenidFfi_indirect(uw_context, uw_Basis_string fields); + +uw_Basis_string uw_OpenidFfi_sha256(uw_context, uw_Basis_string);
--- a/src/c/openid.c Sun Dec 26 17:36:07 2010 -0500 +++ b/src/c/openid.c Mon Dec 27 13:18:02 2010 -0500 @@ -1,5 +1,8 @@ #include <string.h> +#include <openssl/bio.h> +#include <openssl/evp.h> +#include <openssl/buffer.h> #include <openssl/sha.h> #include <curl/curl.h> #include <expat.h> @@ -251,6 +254,8 @@ uw_buffer_init(BUF_MAX, b, BUF_INIT); + fields = uw_strdup(ctx, fields); + while (*fields) { char *equal = strchr(fields, '='), *and, *s; @@ -276,3 +281,31 @@ uw_buffer_append(b, "", 1); return b; } + +static uw_Basis_string base64(uw_context ctx, unsigned char *input, int length) { + BIO *bmem, *b64; + BUF_MEM *bptr; + + b64 = BIO_new(BIO_f_base64()); + bmem = BIO_new(BIO_s_mem()); + b64 = BIO_push(b64, bmem); + BIO_write(b64, input, length); + (void)BIO_flush(b64); + BIO_get_mem_ptr(b64, &bptr); + + char *buff = uw_malloc(ctx, bptr->length); + memcpy(buff, bptr->data, bptr->length-1); + buff[bptr->length-1] = 0; + + BIO_free_all(b64); + + return buff; +} + +uw_Basis_string uw_OpenidFfi_sha256(uw_context ctx, uw_Basis_string s) { + unsigned char out[SHA256_DIGEST_LENGTH]; + + SHA256((unsigned char *)s, strlen(s), out); + + return base64(ctx, out, sizeof out); +}
--- a/src/ur/lib.urp Sun Dec 26 17:36:07 2010 -0500 +++ b/src/ur/lib.urp Mon Dec 27 13:18:02 2010 -0500 @@ -7,5 +7,6 @@ effectful OpenidFfi.addInput effectful OpenidFfi.indirect +$/string $/option openid
--- a/src/ur/openid.ur Sun Dec 26 17:36:07 2010 -0500 +++ b/src/ur/openid.ur Mon Dec 27 13:18:02 2010 -0500 @@ -1,9 +1,26 @@ +val discoveryExpiry = 3600 +val nonceExpiry = 3600 + task initialize = fn () => OpenidFfi.init +table discoveries : { Identifier : string, Endpoint : string, Expires : time } + PRIMARY KEY Identifier + fun discover s = - r <- OpenidFfi.discover s; - return (Option.mp (fn r => {Endpoint = OpenidFfi.endpoint r, - LocalId = OpenidFfi.localId r}) r) + endpoint <- oneOrNoRowsE1 (SELECT (discoveries.Endpoint) + FROM discoveries + WHERE discoveries.Identifier = {[s]}); + case endpoint of + Some ep => return (Some ep) + | None => + r <- OpenidFfi.discover s; + case r of + None => return None + | Some r => + tm <- now; + dml (INSERT INTO discoveries (Identifier, Endpoint, Expires) + VALUES ({[s]}, {[OpenidFfi.endpoint r]}, {[addSeconds tm discoveryExpiry]})); + return (Some (OpenidFfi.endpoint r)) val createInputs = is <- OpenidFfi.createInputs; @@ -13,8 +30,6 @@ table associations : { Endpoint : string, Handle : string, Key : string, Expires : time } PRIMARY KEY Endpoint -task periodic 1 = fn () => dml (DELETE FROM associations WHERE Expires < CURRENT_TIMESTAMP) - datatype association = Association of {Handle : string, Key : string} | AssError of string fun association url = @@ -44,6 +59,108 @@ return (Association {Handle = handle, Key = key})) | _ => return (AssError "Missing fields in response from OP") +fun eatFragment s = + case String.split s #"#" of + Some (_, s') => s' + | _ => s + +datatype handle_result = HandleOk of string | HandleError of string + +fun verifyHandle os id = + ep <- discover (eatFragment id); + case ep of + None => return (HandleError "Discovery failed on returned endpoint") + | Some ep => + case OpenidFfi.getOutput os "openid.assoc_handle" of + None => return (HandleError "Missing association handle in response") + | Some handle => + assoc <- association ep; + case assoc of + AssError s => return (HandleError s) + | Association assoc => + if assoc.Handle <> handle then + return (HandleError "Association handles don't match") + else + return (HandleOk ep) + +table nonces : { Endpoint : string, Nonce : string, Expires : time } + PRIMARY KEY (Endpoint, Nonce) + +fun timeOfNonce s = + case String.split s #"T" of + None => None + | Some (date, s) => + case String.split s #"Z" of + None => None + | Some (time, _) => read (date ^ " " ^ time) + +fun verifyNonce os ep = + case OpenidFfi.getOutput os "openid.response_nonce" of + None => return (Some "Missing nonce in OP response") + | Some nonce => + case timeOfNonce nonce of + None => return (Some "Invalid timestamp in nonce") + | Some tm => + now <- now; + exp <- return (addSeconds now nonceExpiry); + if tm < exp then + return (Some "Nonce timestamp is too old") + else + b <- oneRowE1 (SELECT COUNT( * ) > 0 + FROM nonces + WHERE nonces.Endpoint = {[ep]} + AND nonces.Nonce = {[nonce]}); + + if b then + return (Some "Duplicate nonce") + else + dml (INSERT INTO nonces (Endpoint, Nonce, Expires) + VALUES ({[ep]}, {[nonce]}, {[exp]})); + return None + +fun verifySig os = + case OpenidFfi.getOutput os "openid.signed" of + None => return (Some "Missing openid.signed in OP response") + | Some signed => + case OpenidFfi.getOutput os "openid.sig" of + None => return (Some "Missing openid.sig in OP response") + | Some sign => let + fun gatherNvps signed acc = + let + val (this, next) = + case String.split signed #"," of + None => (signed, None) + | Some (this, next) => (this, Some next) + in + case OpenidFfi.getOutput os ("openid." ^ this) of + None => None + | Some value => + let + val acc = acc ^ this ^ ":" ^ value ^ "\n" + in + case next of + None => Some acc + | Some next => gatherNvps next acc + end + end + in + case gatherNvps signed "" of + None => return (Some "openid.signed mentions missing field") + | Some nvps => + let + val sign' = OpenidFfi.sha256 nvps + in + debug ("Fields: " ^ signed); + debug ("Nvps: " ^ nvps); + debug ("His: " ^ sign); + debug ("Mine: " ^ sign'); + if sign' = sign then + return None + else + return (Some "Signatures don't match") + end + end + fun returnTo (qs : option queryString) = case qs of None => error <xml>Empty query string for OpenID callback</xml> @@ -53,25 +170,55 @@ Some v => error <xml>Authentication failed: {[v]}</xml> | None => case OpenidFfi.getOutput os "openid.mode" of - None => error <xml>No <tt>openid.mode</tt> in response</xml> + None => error <xml>No <tt>openid.mode</tt> in response ({[qs]})</xml> | Some mode => case mode of "cancel" => error <xml>You canceled the authentication!</xml> | "id_res" => (case OpenidFfi.getOutput os "openid.identity" of None => error <xml>Missing identity in OP response</xml> - | Some v => return <xml>Identity: {[v]}</xml>) + | Some id => + errO <- verifyHandle os id; + case errO of + HandleError s => error <xml>{[s]}</xml> + | HandleOk ep => + errO <- verifyReturnTo os; + case errO of + Some s => error <xml>{[s]}</xml> + | None => + errO <- verifyNonce os ep; + case errO of + Some s => error <xml>{[s]}</xml> + | None => + errO <- verifySig os; + case errO of + Some s => error <xml>{[s]}</xml> + | None => return <xml>Identity: {[id]}</xml>) | _ => error <xml>Unexpected <tt>openid.mode</tt>: <tt>{[mode]}</tt></xml> +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) then + return (Some "Wrong return_to in OP response") + else + return None + fun authenticate id = dy <- discover id; case dy of None => return "Discovery failed" | Some dy => - assoc <- association dy.Endpoint; + assoc <- association dy; case assoc of AssError msg => return msg | Association assoc => - redirect (bless (dy.Endpoint ^ "?openid.ns=http://specs.openid.net/auth/2.0&openid.mode=checkid_setup&openid.claimed_id=" + redirect (bless (dy ^ "?openid.ns=http://specs.openid.net/auth/2.0&openid.mode=checkid_setup&openid.claimed_id=" ^ id ^ "&openid.identity=http://specs.openid.net/auth/2.0/identifier_select&openid.assoc_handle=" ^ assoc.Handle ^ "&openid.return_to=" ^ show (effectfulUrl returnTo))) + +task periodic 1 = fn () => + dml (DELETE FROM discoveries WHERE Expires < CURRENT_TIMESTAMP); + dml (DELETE FROM associations WHERE Expires < CURRENT_TIMESTAMP); + dml (DELETE FROM nonces WHERE Expires < CURRENT_TIMESTAMP)