Mercurial > openid

comparison src/ur/openid.ur @ 39:f6b3fbf10dac

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 () =>