Mercurial > openid
comparison src/ur/openid.ur @ 39:f6b3fbf10dac
Proper handling of known vs. to-be-chosen identifiers
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Wed, 01 Jun 2011 07:51:55 -0400 |
parents | f129ddee75f3 |
children | 00c8f43be8b7 |
comparison
equal
deleted
inserted
replaced
38:8d23d76b5d48 | 39:f6b3fbf10dac |
---|---|
38 datatype association_session_type = NoEncryption | DH_SHA1 | DH_SHA256 | 38 datatype association_session_type = NoEncryption | DH_SHA1 | DH_SHA256 |
39 datatype association_mode = | 39 datatype association_mode = |
40 Stateless | 40 Stateless |
41 | Stateful of {AssociationType : association_type, | 41 | Stateful of {AssociationType : association_type, |
42 AssociationSessionType : association_session_type} | 42 AssociationSessionType : association_session_type} |
43 | |
44 datatype authentication_mode = | |
45 ChooseIdentifier of string | |
46 | KnownIdentifier of string | |
43 | 47 |
44 table associations : { Endpoint : string, Handle : string, Typ : serialized association_type, Key : string, Expires : time } | 48 table associations : { Endpoint : string, Handle : string, Typ : serialized association_type, Key : string, Expires : time } |
45 PRIMARY KEY Endpoint | 49 PRIMARY KEY Endpoint |
46 | 50 |
47 datatype association = Association of {Handle : string, Typ : association_type, Key : string} | 51 datatype association = Association of {Handle : string, Typ : association_type, Key : string} |
382 return None | 386 return None |
383 | 387 |
384 val realmString = case r.Realm of | 388 val realmString = case r.Realm of |
385 None => "" | 389 None => "" |
386 | Some realm => "&openid.realm=" ^ realm | 390 | Some realm => "&openid.realm=" ^ realm |
391 | |
392 val (ident, claimed) = | |
393 case r.Identifier of | |
394 ChooseIdentifier s => (eatFragment s, "http://specs.openid.net/auth/2.0/identifier_select") | |
395 | KnownIdentifier s => | |
396 let | |
397 val s = eatFragment s | |
398 in | |
399 (s, s) | |
400 end | |
387 in | 401 in |
388 dy <- discover r.Identifier; | 402 dy <- discover ident; |
389 case dy of | 403 case dy of |
390 None => return "Discovery failed" | 404 None => return "Discovery failed" |
391 | Some dy => | 405 | Some dy => |
392 let | 406 let |
393 val begin = case String.index dy #"?" of | 407 val begin = case String.index dy #"?" of |
395 | Some _ => "&" | 409 | Some _ => "&" |
396 in | 410 in |
397 case r.Association of | 411 case r.Association of |
398 Stateless => | 412 Stateless => |
399 redirect (bless (dy ^ begin ^ "openid.ns=http://specs.openid.net/auth/2.0&openid.mode=checkid_setup" | 413 redirect (bless (dy ^ begin ^ "openid.ns=http://specs.openid.net/auth/2.0&openid.mode=checkid_setup" |
400 ^ "&openid.claimed_id=http://specs.openid.net/auth/2.0/identifier_select" | 414 ^ "&openid.claimed_id=" ^ claimed |
401 ^ "&openid.identity=http://specs.openid.net/auth/2.0/identifier_select&openid.assoc_handle=" | 415 ^ "&openid.identity=" ^ claimed ^ "&openid.assoc_handle=" |
402 ^ "&openid.return_to=" ^ show (effectfulUrl returnTo) ^ realmString)) | 416 ^ "&openid.return_to=" ^ show (effectfulUrl returnTo) ^ realmString)) |
403 | Stateful ar => | 417 | Stateful ar => |
404 assoc <- association ar.AssociationType ar.AssociationSessionType dy; | 418 assoc <- association ar.AssociationType ar.AssociationSessionType dy; |
405 case assoc of | 419 case assoc of |
406 AssError msg => return ("Association failure: " ^ msg) | 420 AssError msg => return ("Association failure: " ^ msg) |
407 | AssAlternate _ => return "Association failure: server didn't accept its own alternate association modes" | 421 | AssAlternate _ => return "Association failure: server didn't accept its own alternate association modes" |
408 | Association assoc => | 422 | Association assoc => |
409 redirect (bless (dy ^ begin ^ "openid.ns=http://specs.openid.net/auth/2.0&openid.mode=checkid_setup" | 423 redirect (bless (dy ^ begin ^ "openid.ns=http://specs.openid.net/auth/2.0&openid.mode=checkid_setup" |
410 ^ "&openid.claimed_id=http://specs.openid.net/auth/2.0/identifier_select" | 424 ^ "&openid.claimed_id=" ^ claimed |
411 ^ "&openid.identity=http://specs.openid.net/auth/2.0/identifier_select&openid.assoc_handle=" | 425 ^ "&openid.identity=" ^ claimed ^ "&openid.assoc_handle=" |
412 ^ assoc.Handle ^ "&openid.return_to=" ^ show (effectfulUrl returnTo) ^ realmString)) | 426 ^ assoc.Handle ^ "&openid.return_to=" ^ show (effectfulUrl returnTo) ^ realmString)) |
413 end | 427 end |
414 end | 428 end |
415 | 429 |
416 task periodic 60 = fn () => | 430 task periodic 60 = fn () => |