Mercurial > openid
changeset 4:2d409aff8800
Received an OpenID authentication response, but haven't checked it yet
| author | Adam Chlipala <adam@chlipala.net> |
|---|---|
| date | Sun, 26 Dec 2010 17:19:52 -0500 |
| parents | f59083771ee2 |
| children | 443f27cd1572 |
| files | include/openid.h src/c/openid.c src/ur/openid.ur src/ur/openid.urs src/ur/openidFfi.urs tests/test.ur tests/test.urp |
| diffstat | 7 files changed, 106 insertions(+), 31 deletions(-) [+] |
line wrap: on
line diff
--- a/include/openid.h Sun Dec 26 15:11:23 2010 -0500 +++ b/include/openid.h Sun Dec 26 17:19:52 2010 -0500 @@ -17,4 +17,5 @@ uw_Basis_string uw_OpenidFfi_getOutput(uw_context, uw_OpenidFfi_outputs, uw_Basis_string key); -uw_OpenidFfi_outputs uw_OpenidFfi_indirect(uw_context, uw_Basis_string url, uw_OpenidFfi_inputs); +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);
--- a/src/c/openid.c Sun Dec 26 15:11:23 2010 -0500 +++ b/src/c/openid.c Sun Dec 26 17:19:52 2010 -0500 @@ -22,6 +22,8 @@ } uw_unit uw_OpenidFfi_init(uw_context ctx) { + + curl_global_init(CURL_GLOBAL_ALL); return uw_unit_v; @@ -177,7 +179,7 @@ const char curl_failure[] = "error\0Error fetching URL"; -uw_OpenidFfi_outputs uw_OpenidFfi_indirect(uw_context ctx, uw_Basis_string url, uw_OpenidFfi_inputs inps) { +uw_OpenidFfi_outputs uw_OpenidFfi_direct(uw_context ctx, uw_Basis_string url, uw_OpenidFfi_inputs inps) { uw_buffer *buf = uw_malloc(ctx, sizeof(uw_buffer)); CURL *c = curl(ctx); CURLcode code; @@ -225,3 +227,52 @@ return buf; } + +static uw_Basis_string deurl(uw_context ctx, uw_Basis_string s) { + uw_Basis_string r = uw_malloc(ctx, strlen(s)), s2 = r; + + for (; *s; ++s) { + if (s[0] == '%' && s[1] && s[2]) { + unsigned u; + + sscanf(s+1, "%02x", &u); + *s2++ = u; + s += 2; + } else + *s2++ = *s; + } + + *s2 = 0; + return r; +} + +uw_OpenidFfi_outputs uw_OpenidFfi_indirect(uw_context ctx, uw_Basis_string fields) { + uw_OpenidFfi_outputs b = malloc(sizeof(uw_buffer)); + + uw_buffer_init(BUF_MAX, b, BUF_INIT); + + while (*fields) { + char *equal = strchr(fields, '='), *and, *s; + + if (!equal) + break; + + *equal = 0; + s = deurl(ctx, fields); + uw_buffer_append(b, s, strlen(s)); + uw_buffer_append(b, "", 1); + + and = strchr(equal+1, '&'); + if (and) { + *and = 0; + fields = and+1; + } else + fields = and = strchr(equal+1, 0); + s = deurl(ctx, equal+1); + uw_buffer_append(b, s, strlen(s)); + uw_buffer_append(b, "", 1); + } + + uw_buffer_append(b, "", 1); + return b; +}
--- a/src/ur/openid.ur Sun Dec 26 15:11:23 2010 -0500 +++ b/src/ur/openid.ur Sun Dec 26 17:19:52 2010 -0500 @@ -10,35 +10,61 @@ OpenidFfi.addInput is "openid.ns" "http://specs.openid.net/auth/2.0"; return is -table associations : { Endpoint : string, Secret : string, Expires : time } +table associations : { Endpoint : string, Handle : string, Key : string, Expires : time } PRIMARY KEY Endpoint -task periodic 0 = fn () => dml (DELETE FROM associations WHERE Expires < CURRENT_TIMESTAMP) +task periodic 1 = fn () => dml (DELETE FROM associations WHERE Expires < CURRENT_TIMESTAMP) -datatype association = Handle of string | Error of string +datatype association = Association of {Handle : string, Key : string} | AssError of string fun association url = - secret <- oneOrNoRowsE1 (SELECT (associations.Secret) + secret <- oneOrNoRows1 (SELECT associations.Handle, associations.Key FROM associations WHERE associations.Endpoint = {[url]}); case secret of - Some v => return (Handle v) + Some r => return (Association r) | None => is <- createInputs; OpenidFfi.addInput is "openid.mode" "associate"; OpenidFfi.addInput is "openid.assoc_type" "HMAC-SHA256"; OpenidFfi.addInput is "openid.session_type" "no-encryption"; - os <- OpenidFfi.indirect url is; + + os <- OpenidFfi.direct url is; case OpenidFfi.getOutput os "error" of - Some v => return (Error v) + Some v => return (AssError v) | None => - case (OpenidFfi.getOutput os "assoc_handle", OpenidFfi.getOutput os "expires_in") of - (Some handle, Some expires) => + case (OpenidFfi.getOutput os "assoc_handle", OpenidFfi.getOutput os "mac_key", OpenidFfi.getOutput os "expires_in") of + (Some handle, Some key, Some expires) => (case read expires of - None => return (Error "Invalid 'expires_in' field") + None => return (AssError "Invalid 'expires_in' field") | Some expires => tm <- now; - dml (INSERT INTO associations (Endpoint, Secret, Expires) - VALUES ({[url]}, {[handle]}, {[addSeconds tm expires]})); - return (Handle handle)) - | _ => return (Error "Missing fields in response from OP") + dml (INSERT INTO associations (Endpoint, Handle, Key, Expires) + VALUES ({[url]}, {[handle]}, {[key]}, {[addSeconds tm expires]})); + return (Association {Handle = handle, Key = key})) + | _ => return (AssError "Missing fields in response from OP") + +fun returnTo (qs : option queryString) = + case qs of + None => error <xml>Empty query string for OpenID callback</xml> + | Some qs => + os <- OpenidFfi.indirect qs; + case OpenidFfi.getOutput os "openid.error" of + Some v => error <xml>Authentication failed: {[v]}</xml> + | None => + case OpenidFfi.getOutput os "openid.identity" of + None => error <xml>Missing identity in OP response</xml> + | Some v => return <xml>Identity: {[v]}</xml> + +fun authenticate id = + dy <- discover id; + case dy of + None => return "Discovery failed" + | Some dy => + assoc <- association dy.Endpoint; + 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=" + ^ id ^ "&openid.identity=http://specs.openid.net/auth/2.0/identifier_select&openid.assoc_handle=" + ^ assoc.Handle ^ "&openid.return_to=" ^ show (effectfulUrl returnTo)))
--- a/src/ur/openid.urs Sun Dec 26 15:11:23 2010 -0500 +++ b/src/ur/openid.urs Sun Dec 26 17:19:52 2010 -0500 @@ -1,4 +1,3 @@ -val discover : string -> transaction (option {Endpoint : string, LocalId : option string}) - -datatype association = Handle of string | Error of string -val association : string -> transaction association +val authenticate : string -> transaction string +(* Doesn't return normally if everything goes as planned. + * Instead, the user is redirected to his OP to authenticate there. *)
--- a/src/ur/openidFfi.urs Sun Dec 26 15:11:23 2010 -0500 +++ b/src/ur/openidFfi.urs Sun Dec 26 17:19:52 2010 -0500 @@ -12,4 +12,5 @@ type outputs val getOutput : outputs -> string -> option string -val indirect : string -> inputs -> transaction outputs +val direct : string -> inputs -> transaction outputs +val indirect : queryString -> transaction outputs
--- a/tests/test.ur Sun Dec 26 15:11:23 2010 -0500 +++ b/tests/test.ur Sun Dec 26 17:19:52 2010 -0500 @@ -1,16 +1,10 @@ -fun discover r = - dy <- Openid.discover r.Id; - case dy of - None => return <xml>No dice</xml> - | Some dy => - os <- Openid.association dy.Endpoint; - case os of - Openid.Error s => error <xml>{[s]}</xml> - | Openid.Handle s => return <xml>{[s]}</xml> +fun auth r = + msg <- Openid.authenticate r.Id; + error <xml>{[msg]}</xml> fun main () = return <xml><body> <form> <textbox{#Id}/> - <submit action={discover}/> + <submit action={auth}/> </form> </body></xml>