val discoveryExpiry = 3600 val nonceExpiry = 3600 task initialize = fn () => OpenidFfi.init table discoveries : { Identifier : string, Endpoint : string, Expires : time } PRIMARY KEY Identifier fun discover s = endpoint <- oneOrNoRowsE1 (SELECT (discoveries.Endpoint) FROM discoveries WHERE discoveries.Identifier = {[s]}); case endpoint of Some ep => return (Some ep) | None => r <- OpenidFfi.discover s; case r of None => return None | Some r => tm <- now; dml (INSERT INTO discoveries (Identifier, Endpoint, Expires) VALUES ({[s]}, {[OpenidFfi.endpoint r]}, {[addSeconds tm discoveryExpiry]})); return (Some (OpenidFfi.endpoint r)) val createInputs = is <- OpenidFfi.createInputs; OpenidFfi.addInput is "openid.ns" "http://specs.openid.net/auth/2.0"; return is table associations : { Endpoint : string, Handle : string, Key : string, Expires : time } PRIMARY KEY Endpoint datatype association = Association of {Handle : string, Key : string} | AssError of string fun association url = secret <- oneOrNoRows1 (SELECT associations.Handle, associations.Key FROM associations WHERE associations.Endpoint = {[url]}); case secret of 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"; debug ("Contacting " ^ url); os <- OpenidFfi.direct url is; case OpenidFfi.getOutput os "error" of Some v => return (AssError v) | None => 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 (AssError "Invalid 'expires_in' field") | Some expires => tm <- now; dml (INSERT INTO associations (Endpoint, Handle, Key, Expires) VALUES ({[url]}, {[handle]}, {[key]}, {[addSeconds tm expires]})); return (Association {Handle = handle, Key = key})) | (None, _, _) => return (AssError "Missing assoc_handle") | (_, None, _) => return (AssError "Missing mac_key") | _ => return (AssError "Missing fields in response from OP") fun eatFragment s = case String.split s #"#" of Some (_, s') => s' | _ => s datatype handle_result = HandleOk of {Endpoint : string, Key : string} | HandleError of string fun verifyHandle os id = ep <- discover (eatFragment id); case ep of None => return (HandleError "Discovery failed on returned endpoint") | Some ep => case OpenidFfi.getOutput os "openid.assoc_handle" of None => return (HandleError "Missing association handle in response") | Some handle => assoc <- association ep; case assoc of AssError s => return (HandleError s) | Association assoc => if assoc.Handle <> handle then return (HandleError "Association handles don't match") else return (HandleOk {Endpoint = ep, Key = assoc.Key}) table nonces : { Endpoint : string, Nonce : string, Expires : time } PRIMARY KEY (Endpoint, Nonce) fun timeOfNonce s = case String.split s #"T" of None => None | Some (date, s) => case String.split s #"Z" of None => None | Some (time, _) => readUtc (date ^ " " ^ time) fun verifyNonce os ep = case OpenidFfi.getOutput os "openid.response_nonce" of None => return (Some "Missing nonce in OP response") | Some nonce => case timeOfNonce nonce of None => return (Some "Invalid timestamp in nonce") | Some tm => now <- now; exp <- return (addSeconds now nonceExpiry); if tm < exp then return (Some "Nonce timestamp is too old") else b <- oneRowE1 (SELECT COUNT( * ) > 0 FROM nonces WHERE nonces.Endpoint = {[ep]} AND nonces.Nonce = {[nonce]}); if b then return (Some "Duplicate nonce") else debug ("Nonce expires: " ^ show exp); dml (INSERT INTO nonces (Endpoint, Nonce, Expires) VALUES ({[ep]}, {[nonce]}, {[exp]})); return None fun verifySig os key = case OpenidFfi.getOutput os "openid.signed" of None => return (Some "Missing openid.signed in OP response") | Some signed => case OpenidFfi.getOutput os "openid.sig" of None => return (Some "Missing openid.sig in OP response") | Some sign => let fun gatherNvps signed acc = let val (this, next) = case String.split signed #"," of None => (signed, None) | Some (this, next) => (this, Some next) in case OpenidFfi.getOutput os ("openid." ^ this) of None => None | Some value => let val acc = acc ^ this ^ ":" ^ value ^ "\n" in case next of None => Some acc | Some next => gatherNvps next acc end end in case gatherNvps signed "" of None => return (Some "openid.signed mentions missing field") | Some nvps => let val sign' = OpenidFfi.sha256 key nvps in debug ("Fields: " ^ signed); debug ("Nvps: " ^ nvps); debug ("Key: " ^ key); debug ("His: " ^ sign); debug ("Mine: " ^ sign'); if sign' = sign then return None else return (Some "Signatures don't match") end end fun returnTo (qs : option queryString) = case qs of None => error Empty query string for OpenID callback | Some qs => os <- OpenidFfi.indirect qs; case OpenidFfi.getOutput os "openid.error" of Some v => error Authentication failed: {[v]} | None => case OpenidFfi.getOutput os "openid.mode" of None => error No openid.mode in response ({[qs]}) | Some mode => case mode of "cancel" => error You canceled the authentication! | "id_res" => (case OpenidFfi.getOutput os "openid.identity" of None => error Missing identity in OP response | Some id => errO <- verifyHandle os id; case errO of HandleError s => error {[s]} | HandleOk {Endpoint = ep, Key = key} => errO <- verifyReturnTo os; case errO of Some s => error {[s]} | None => errO <- verifyNonce os ep; case errO of Some s => error {[s]} | None => errO <- verifySig os key; case errO of Some s => error {[s]} | None => return Identity: {[id]}) | _ => error Unexpected openid.mode: {[mode]} and verifyReturnTo os = case OpenidFfi.getOutput os "openid.return_to" of None => return (Some "Missing return_to in OP response") | Some rt => if rt <> show (effectfulUrl returnTo) then return (Some "Wrong return_to in OP response") else return None fun authenticate id = dy <- discover id; case dy of None => return "Discovery failed" | Some dy => assoc <- association dy; case assoc of AssError msg => return msg | Association assoc => redirect (bless (dy ^ "?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))) task periodic 1 = fn () => dml (DELETE FROM discoveries WHERE Expires < CURRENT_TIMESTAMP); dml (DELETE FROM associations WHERE Expires < CURRENT_TIMESTAMP); dml (DELETE FROM nonces WHERE Expires < CURRENT_TIMESTAMP)