Mercurial > openid

comparison src/ur/openid.ur @ 11:e637249abfd2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Test with RP-side nonces
author Adam Chlipala <adam@chlipala.net>
date Wed, 29 Dec 2010 16:25:32 -0500
parents 194577b60771
children c778455fe570
comparison
equal deleted inserted replaced
10:194577b60771 11:e637249abfd2
1 val discoveryExpiry = 3600 1 val discoveryExpiry = 3600
2 val nonceExpiry = 3600 2 val nonceExpiry = 600
3 val nonceSkew = 3600 3 val nonceSkew = 600
4 4
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
225 | Some tm => 225 | Some tm =>
226 now <- now; 226 now <- now;
227 if tm < addSeconds now (-nonceExpiry) then 227 if tm < addSeconds now (-nonceExpiry) then
228 return (Some "Nonce timestamp is too old") 228 return (Some "Nonce timestamp is too old")
229 else if tm > addSeconds now nonceSkew then 229 else if tm > addSeconds now nonceSkew then
230 return (Some ("Nonce timestamp is too far in the future: " ^ show tm ^ " (from " ^ nonce ^ ")")) 230 return (Some "Nonce timestamp is too far in the future")
231 else 231 else
232 b <- oneRowE1 (SELECT COUNT( * ) > 0 232 b <- oneRowE1 (SELECT COUNT( * ) > 0
233 FROM nonces 233 FROM nonces
234 WHERE nonces.Endpoint = {[ep]} 234 WHERE nonces.Endpoint = {[ep]}
235 AND nonces.Nonce = {[nonce]}); 235 AND nonces.Nonce = {[nonce]});
289 | Some (left, _) => return (Some ("openid.signed is missing required fields: " ^ show left)) 289 | Some (left, _) => return (Some ("openid.signed is missing required fields: " ^ show left))
290 end 290 end
291 291
292 datatype authentication = AuthenticatedAs of string | Canceled | Failure of string 292 datatype authentication = AuthenticatedAs of string | Canceled | Failure of string
293 293
294 sequence nextNonce
295
294 fun authenticate after r = 296 fun authenticate after r =
295 let 297 let
296 fun returnTo (qs : option queryString) = 298 fun returnTo myNonce (qs : option queryString) =
297 case qs of 299 case qs of
298 None => after (Failure "Empty query string for OpenID callback") 300 None => after (Failure "Empty query string for OpenID callback")
299 | Some qs => 301 | Some qs =>
300 os <- OpenidFfi.indirect qs; 302 os <- OpenidFfi.indirect qs;
301 case OpenidFfi.getOutput os "openid.error" of 303 case OpenidFfi.getOutput os "openid.error" of
312 | Some id => 314 | Some id =>
313 errO <- verifyHandle os id; 315 errO <- verifyHandle os id;
314 case errO of 316 case errO of
315 HandleError s => after (Failure s) 317 HandleError s => after (Failure s)
316 | HandleOk {Endpoint = ep, Typ = atype, Key = key} => 318 | HandleOk {Endpoint = ep, Typ = atype, Key = key} =>
317 errO <- verifyReturnTo os; 319 errO <- verifyReturnTo os myNonce;
318 case errO of 320 case errO of
319 Some s => after (Failure s) 321 Some s => after (Failure s)
320 | None => 322 | None =>
321 errO <- verifyNonce os ep; 323 errO <- verifyNonce os ep;
322 case errO of 324 case errO of
326 case errO of 328 case errO of
327 Some s => after (Failure s) 329 Some s => after (Failure s)
328 | None => after (AuthenticatedAs id)) 330 | None => after (AuthenticatedAs id))
329 | _ => after (Failure ("Unexpected openid.mode: " ^ mode)) 331 | _ => after (Failure ("Unexpected openid.mode: " ^ mode))
330 332
331 and verifyReturnTo os = 333 and verifyReturnTo os myNonce =
332 case OpenidFfi.getOutput os "openid.return_to" of 334 case OpenidFfi.getOutput os "openid.return_to" of
333 None => return (Some "Missing return_to in OP response") 335 None => return (Some "Missing return_to in OP response")
334 | Some rt => 336 | Some rt =>
335 if rt <> show (effectfulUrl returnTo) then 337 if rt <> show (effectfulUrl (returnTo myNonce)) then
336 return (Some "Wrong return_to in OP response") 338 return (Some "Wrong return_to in OP response")
337 else 339 else
338 return None 340 return None
339 in 341 in
340 dy <- discover r.Identifier; 342 dy <- discover r.Identifier;
344 assoc <- association r.AssociationType r.AssociationSessionType dy; 346 assoc <- association r.AssociationType r.AssociationSessionType dy;
345 case assoc of 347 case assoc of
346 AssError msg => return ("Association failure: " ^ msg) 348 AssError msg => return ("Association failure: " ^ msg)
347 | AssAlternate _ => return "Association failure: server didn't accept its own alternate association modes" 349 | AssAlternate _ => return "Association failure: server didn't accept its own alternate association modes"
348 | Association assoc => 350 | Association assoc =>
351 myNonce <- nextval nextNonce;
349 redirect (bless (dy ^ "?openid.ns=http://specs.openid.net/auth/2.0&openid.mode=checkid_setup&openid.claimed_id=" 352 redirect (bless (dy ^ "?openid.ns=http://specs.openid.net/auth/2.0&openid.mode=checkid_setup&openid.claimed_id="
350 ^ r.Identifier ^ "&openid.identity=http://specs.openid.net/auth/2.0/identifier_select&openid.assoc_handle=" 353 ^ r.Identifier ^ "&openid.identity=http://specs.openid.net/auth/2.0/identifier_select&openid.assoc_handle="
351 ^ assoc.Handle ^ "&openid.return_to=" ^ show (effectfulUrl returnTo))) 354 ^ assoc.Handle ^ "&openid.return_to=" ^ show (effectfulUrl (returnTo myNonce))))
352 end 355 end
353 356
354 task periodic 1 = fn () => 357 task periodic 1 = fn () =>
355 dml (DELETE FROM discoveries WHERE Expires < CURRENT_TIMESTAMP); 358 dml (DELETE FROM discoveries WHERE Expires < CURRENT_TIMESTAMP);
356 dml (DELETE FROM associations WHERE Expires < CURRENT_TIMESTAMP); 359 dml (DELETE FROM associations WHERE Expires < CURRENT_TIMESTAMP);