Mercurial > openid
comparison src/ur/openid.ur @ 17:df2eb629f21a
Successfully created an account
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Thu, 06 Jan 2011 14:42:37 -0500 |
parents | 35bc4da563dd |
children | 70ab0230649b |
comparison
equal
deleted
inserted
replaced
16:9851bc87b0d7 | 17:df2eb629f21a |
---|---|
5 task initialize = fn () => OpenidFfi.init | 5 task initialize = fn () => OpenidFfi.init |
6 | 6 |
7 table discoveries : { Identifier : string, Endpoint : string, Expires : time } | 7 table discoveries : { Identifier : string, Endpoint : string, Expires : time } |
8 PRIMARY KEY Identifier | 8 PRIMARY KEY Identifier |
9 | 9 |
10 fun eatFragment s = | |
11 case String.split s #"#" of | |
12 Some (s', _) => s' | |
13 | _ => s | |
14 | |
10 fun discover s = | 15 fun discover s = |
16 s <- return (eatFragment s); | |
11 endpoint <- oneOrNoRowsE1 (SELECT (discoveries.Endpoint) | 17 endpoint <- oneOrNoRowsE1 (SELECT (discoveries.Endpoint) |
12 FROM discoveries | 18 FROM discoveries |
13 WHERE discoveries.Identifier = {[s]}); | 19 WHERE discoveries.Identifier = {[s]}); |
14 case endpoint of | 20 case endpoint of |
15 Some ep => return (Some ep) | 21 Some ep => return (Some ep) |
187 return (AssError "Suggested new modes match old ones!") | 193 return (AssError "Suggested new modes match old ones!") |
188 else | 194 else |
189 debug "Renegotiating protocol"; | 195 debug "Renegotiating protocol"; |
190 newAssociation url alt.Atype alt.Stype | 196 newAssociation url alt.Atype alt.Stype |
191 | v => return v | 197 | v => return v |
192 | |
193 fun eatFragment s = | |
194 case String.split s #"#" of | |
195 Some (s', _) => s' | |
196 | _ => s | |
197 | 198 |
198 datatype handle_result = HandleOk of {Endpoint : string, Typ : association_type, Key : string} | NoAssociation of string | HandleError of string | 199 datatype handle_result = HandleOk of {Endpoint : string, Typ : association_type, Key : string} | NoAssociation of string | HandleError of string |
199 | 200 |
200 datatype authentication = AuthenticatedAs of string | Canceled | Failure of string | 201 datatype authentication = AuthenticatedAs of string | Canceled | Failure of string |
201 | 202 |
308 let | 309 let |
309 val sign' = case atype of | 310 val sign' = case atype of |
310 HMAC_SHA256 => OpenidFfi.hmac_sha256 key nvps | 311 HMAC_SHA256 => OpenidFfi.hmac_sha256 key nvps |
311 | HMAC_SHA1 => OpenidFfi.hmac_sha1 key nvps | 312 | HMAC_SHA1 => OpenidFfi.hmac_sha1 key nvps |
312 in | 313 in |
313 (*debug ("Fields: " ^ signed); | |
314 debug ("Nvps: " ^ nvps); | |
315 debug ("Key: " ^ key); | |
316 debug ("His: " ^ sign); | |
317 debug ("Mine: " ^ sign');*) | |
318 if sign' = sign then | 314 if sign' = sign then |
319 return None | 315 return None |
320 else | 316 else |
321 return (Some "Signatures don't match") | 317 return (Some "Signatures don't match") |
322 end | 318 end |
386 None => return "Discovery failed" | 382 None => return "Discovery failed" |
387 | Some dy => | 383 | Some dy => |
388 case r.Association of | 384 case r.Association of |
389 Stateless => | 385 Stateless => |
390 redirect (bless (dy ^ "?openid.ns=http://specs.openid.net/auth/2.0&openid.mode=checkid_setup&openid.claimed_id=" | 386 redirect (bless (dy ^ "?openid.ns=http://specs.openid.net/auth/2.0&openid.mode=checkid_setup&openid.claimed_id=" |
391 ^ r.Identifier ^ "&openid.identity=http://specs.openid.net/auth/2.0/identifier_select&openid.return_to=" | 387 ^ eatFragment r.Identifier |
388 ^ "&openid.identity=http://specs.openid.net/auth/2.0/identifier_select&openid.return_to=" | |
392 ^ show (effectfulUrl returnTo) ^ realmString)) | 389 ^ show (effectfulUrl returnTo) ^ realmString)) |
393 | Stateful ar => | 390 | Stateful ar => |
394 assoc <- association ar.AssociationType ar.AssociationSessionType dy; | 391 assoc <- association ar.AssociationType ar.AssociationSessionType dy; |
395 case assoc of | 392 case assoc of |
396 AssError msg => return ("Association failure: " ^ msg) | 393 AssError msg => return ("Association failure: " ^ msg) |
397 | AssAlternate _ => return "Association failure: server didn't accept its own alternate association modes" | 394 | AssAlternate _ => return "Association failure: server didn't accept its own alternate association modes" |
398 | Association assoc => | 395 | Association assoc => |
399 redirect (bless (dy ^ "?openid.ns=http://specs.openid.net/auth/2.0&openid.mode=checkid_setup&openid.claimed_id=" | 396 redirect (bless (dy ^ "?openid.ns=http://specs.openid.net/auth/2.0&openid.mode=checkid_setup&openid.claimed_id=" |
400 ^ r.Identifier ^ "&openid.identity=http://specs.openid.net/auth/2.0/identifier_select&openid.assoc_handle=" | 397 ^ eatFragment r.Identifier |
398 ^ "&openid.identity=http://specs.openid.net/auth/2.0/identifier_select&openid.assoc_handle=" | |
401 ^ assoc.Handle ^ "&openid.return_to=" ^ show (effectfulUrl returnTo) ^ realmString)) | 399 ^ assoc.Handle ^ "&openid.return_to=" ^ show (effectfulUrl returnTo) ^ realmString)) |
402 end | 400 end |
403 | 401 |
404 task periodic 1 = fn () => | 402 task periodic 1 = fn () => |
405 dml (DELETE FROM discoveries WHERE Expires < CURRENT_TIMESTAMP); | 403 dml (DELETE FROM discoveries WHERE Expires < CURRENT_TIMESTAMP); |