adam@6
|
1 val discoveryExpiry = 3600
|
adam@11
|
2 val nonceExpiry = 600
|
adam@11
|
3 val nonceSkew = 600
|
adam@6
|
4
|
adam@0
|
5 task initialize = fn () => OpenidFfi.init
|
adam@1
|
6
|
adam@6
|
7 table discoveries : { Identifier : string, Endpoint : string, Expires : time }
|
adam@6
|
8 PRIMARY KEY Identifier
|
adam@6
|
9
|
adam@17
|
10 fun eatFragment s =
|
adam@17
|
11 case String.split s #"#" of
|
adam@17
|
12 Some (s', _) => s'
|
adam@17
|
13 | _ => s
|
adam@17
|
14
|
adam@2
|
15 fun discover s =
|
adam@17
|
16 s <- return (eatFragment s);
|
adam@6
|
17 endpoint <- oneOrNoRowsE1 (SELECT (discoveries.Endpoint)
|
adam@6
|
18 FROM discoveries
|
adam@6
|
19 WHERE discoveries.Identifier = {[s]});
|
adam@6
|
20 case endpoint of
|
adam@6
|
21 Some ep => return (Some ep)
|
adam@6
|
22 | None =>
|
adam@6
|
23 r <- OpenidFfi.discover s;
|
adam@6
|
24 case r of
|
adam@6
|
25 None => return None
|
adam@6
|
26 | Some r =>
|
adam@6
|
27 tm <- now;
|
adam@6
|
28 dml (INSERT INTO discoveries (Identifier, Endpoint, Expires)
|
adam@6
|
29 VALUES ({[s]}, {[OpenidFfi.endpoint r]}, {[addSeconds tm discoveryExpiry]}));
|
adam@6
|
30 return (Some (OpenidFfi.endpoint r))
|
adam@3
|
31
|
adam@3
|
32 val createInputs =
|
adam@3
|
33 is <- OpenidFfi.createInputs;
|
adam@3
|
34 OpenidFfi.addInput is "openid.ns" "http://specs.openid.net/auth/2.0";
|
adam@3
|
35 return is
|
adam@3
|
36
|
adam@8
|
37 datatype association_type = HMAC_SHA1 | HMAC_SHA256
|
adam@8
|
38 datatype association_session_type = NoEncryption | DH_SHA1 | DH_SHA256
|
adam@13
|
39 datatype association_mode =
|
adam@13
|
40 Stateless
|
adam@13
|
41 | Stateful of {AssociationType : association_type,
|
adam@13
|
42 AssociationSessionType : association_session_type}
|
adam@8
|
43
|
adam@8
|
44 table associations : { Endpoint : string, Handle : string, Typ : serialized association_type, Key : string, Expires : time }
|
adam@3
|
45 PRIMARY KEY Endpoint
|
adam@3
|
46
|
adam@8
|
47 datatype association = Association of {Handle : string, Typ : association_type, Key : string}
|
adam@8
|
48 | AssError of string
|
adam@8
|
49 | AssAlternate of {Atype : association_type, Stype : association_session_type}
|
adam@3
|
50
|
adam@8
|
51 fun atype_show v =
|
adam@8
|
52 case v of
|
adam@8
|
53 HMAC_SHA1 => "HMAC-SHA1"
|
adam@8
|
54 | HMAC_SHA256 => "HMAC-SHA256"
|
adam@8
|
55
|
adam@8
|
56 val show_atype = mkShow atype_show
|
adam@8
|
57
|
adam@8
|
58 fun stype_show v =
|
adam@8
|
59 case v of
|
adam@8
|
60 NoEncryption => "no-encryption"
|
adam@8
|
61 | DH_SHA1 => "DH-SHA1"
|
adam@8
|
62 | DH_SHA256 => "DH-SHA256"
|
adam@8
|
63
|
adam@8
|
64 val show_stype = mkShow stype_show
|
adam@8
|
65
|
adam@8
|
66 fun atype_read s =
|
adam@8
|
67 case s of
|
adam@8
|
68 "HMAC-SHA1" => Some HMAC_SHA1
|
adam@8
|
69 | "HMAC-SHA256" => Some HMAC_SHA256
|
adam@8
|
70 | _ => None
|
adam@8
|
71
|
adam@8
|
72 val read_atype = mkRead' atype_read "association type"
|
adam@8
|
73
|
adam@8
|
74 fun stype_read s =
|
adam@8
|
75 case s of
|
adam@8
|
76 "no-encryption" => Some NoEncryption
|
adam@8
|
77 | "DH-SHA1" => Some DH_SHA1
|
adam@8
|
78 | "DH-SHA256" => Some DH_SHA256
|
adam@8
|
79 | _ => None
|
adam@8
|
80
|
adam@8
|
81 val read_stype = mkRead' stype_read "association session type"
|
adam@8
|
82
|
adam@8
|
83 fun atype_eq v1 v2 =
|
adam@8
|
84 case (v1, v2) of
|
adam@8
|
85 (HMAC_SHA1, HMAC_SHA1) => True
|
adam@8
|
86 | (HMAC_SHA256, HMAC_SHA256) => True
|
adam@8
|
87 | _ => False
|
adam@8
|
88
|
adam@8
|
89 val eq_atype = mkEq atype_eq
|
adam@8
|
90
|
adam@8
|
91 fun stype_eq v1 v2 =
|
adam@8
|
92 case (v1, v2) of
|
adam@8
|
93 (NoEncryption, NoEncryption) => True
|
adam@8
|
94 | (DH_SHA1, DH_SHA1) => True
|
adam@8
|
95 | (DH_SHA256, DH_SHA256) => True
|
adam@8
|
96 | _ => False
|
adam@8
|
97
|
adam@8
|
98 val eq_stype = mkEq stype_eq
|
adam@8
|
99
|
adam@8
|
100 fun errorResult atype stype os =
|
adam@8
|
101 case OpenidFfi.getOutput os "error" of
|
adam@8
|
102 Some v =>
|
adam@8
|
103 (case (OpenidFfi.getOutput os "error_code", OpenidFfi.getOutput os "assoc_type", OpenidFfi.getOutput os "session_type") of
|
adam@8
|
104 (Some "unsupported-type", at, st) => Some (AssAlternate {Atype = Option.get atype (Option.bind read at),
|
adam@8
|
105 Stype = Option.get stype (Option.bind read st)})
|
adam@8
|
106 | _ => Some (AssError ("OP error during association: " ^ v)))
|
adam@8
|
107 | None => None
|
adam@8
|
108
|
adam@27
|
109 fun eatQstring s =
|
adam@27
|
110 case String.split s #"?" of
|
adam@27
|
111 Some (s', _) => s'
|
adam@27
|
112 | _ => s
|
adam@27
|
113
|
adam@8
|
114 fun associateNoEncryption url atype =
|
adam@27
|
115 url <- return (eatQstring url);
|
adam@8
|
116 is <- createInputs;
|
adam@8
|
117 OpenidFfi.addInput is "openid.mode" "associate";
|
adam@8
|
118 OpenidFfi.addInput is "openid.assoc_type" (show atype);
|
adam@8
|
119 OpenidFfi.addInput is "openid.session_type" (show NoEncryption);
|
adam@8
|
120
|
adam@8
|
121 os <- OpenidFfi.direct url is;
|
adam@8
|
122 case errorResult atype NoEncryption os of
|
adam@8
|
123 Some v => return v
|
adam@8
|
124 | None =>
|
adam@8
|
125 case (OpenidFfi.getOutput os "assoc_handle", OpenidFfi.getOutput os "mac_key", OpenidFfi.getOutput os "expires_in") of
|
adam@8
|
126 (Some handle, Some key, Some expires) =>
|
adam@8
|
127 (case read expires of
|
adam@8
|
128 None => return (AssError "Invalid 'expires_in' field")
|
adam@8
|
129 | Some expires =>
|
adam@8
|
130 tm <- now;
|
adam@8
|
131 dml (INSERT INTO associations (Endpoint, Handle, Typ, Key, Expires)
|
adam@8
|
132 VALUES ({[url]}, {[handle]}, {[serialize atype]}, {[key]}, {[addSeconds tm expires]}));
|
adam@8
|
133 return (Association {Handle = handle, Typ = atype, Key = key}))
|
adam@8
|
134 | (None, _, _) => return (AssError "Missing assoc_handle")
|
adam@8
|
135 | (_, None, _) => return (AssError "Missing mac_key")
|
adam@8
|
136 | _ => return (AssError "Missing expires_in")
|
adam@8
|
137
|
adam@8
|
138 fun associateDh url atype stype =
|
adam@27
|
139 url <- return (eatQstring url);
|
adam@8
|
140 dh <- OpenidFfi.generate;
|
adam@8
|
141
|
adam@8
|
142 is <- createInputs;
|
adam@8
|
143 OpenidFfi.addInput is "openid.mode" "associate";
|
adam@8
|
144 OpenidFfi.addInput is "openid.assoc_type" (show atype);
|
adam@8
|
145 OpenidFfi.addInput is "openid.session_type" (show stype);
|
adam@8
|
146 OpenidFfi.addInput is "openid.dh_modulus" (OpenidFfi.modulus dh);
|
adam@8
|
147 OpenidFfi.addInput is "openid.dh_gen" (OpenidFfi.generator dh);
|
adam@8
|
148 OpenidFfi.addInput is "openid.dh_consumer_public" (OpenidFfi.public dh);
|
adam@8
|
149
|
adam@8
|
150 os <- OpenidFfi.direct url is;
|
adam@8
|
151 case errorResult atype stype os of
|
adam@8
|
152 Some v => return v
|
adam@8
|
153 | None =>
|
adam@8
|
154 case (OpenidFfi.getOutput os "assoc_handle", OpenidFfi.getOutput os "dh_server_public",
|
adam@8
|
155 OpenidFfi.getOutput os "enc_mac_key", OpenidFfi.getOutput os "expires_in") of
|
adam@8
|
156 (Some handle, Some pub, Some mac, Some expires) =>
|
adam@8
|
157 (case read expires of
|
adam@8
|
158 None => return (AssError "Invalid 'expires_in' field")
|
adam@8
|
159 | Some expires =>
|
adam@12
|
160 secret <- OpenidFfi.compute dh pub;
|
adam@12
|
161 digest <- return (case stype of
|
adam@12
|
162 DH_SHA1 => OpenidFfi.sha1 secret
|
adam@12
|
163 | DH_SHA256 => OpenidFfi.sha256 secret
|
adam@12
|
164 | _ => error <xml>Non-DH stype in associateDh</xml>);
|
adam@12
|
165 key <- return (OpenidFfi.xor mac digest);
|
adam@8
|
166 tm <- now;
|
adam@8
|
167 dml (INSERT INTO associations (Endpoint, Handle, Typ, Key, Expires)
|
adam@8
|
168 VALUES ({[url]}, {[handle]}, {[serialize atype]}, {[key]}, {[addSeconds tm expires]}));
|
adam@8
|
169 return (Association {Handle = handle, Typ = atype, Key = key}))
|
adam@8
|
170 | (None, _, _, _) => return (AssError "Missing assoc_handle")
|
adam@8
|
171 | (_, None, _, _) => return (AssError "Missing dh_server_public")
|
adam@8
|
172 | (_, _, None, _) => return (AssError "Missing enc_mac_key")
|
adam@8
|
173 | _ => return (AssError "Missing expires_in")
|
adam@8
|
174
|
adam@8
|
175 fun oldAssociation url =
|
adam@27
|
176 url <- return (eatQstring url);
|
adam@8
|
177 secret <- oneOrNoRows1 (SELECT associations.Handle, associations.Typ, associations.Key
|
adam@7
|
178 FROM associations
|
adam@7
|
179 WHERE associations.Endpoint = {[url]});
|
adam@3
|
180 case secret of
|
adam@8
|
181 Some r => return (Some (r -- #Typ ++ {Typ = deserialize r.Typ}))
|
adam@8
|
182 | None => return None
|
adam@8
|
183
|
adam@8
|
184 fun newAssociation url atype stype =
|
adam@8
|
185 case stype of
|
adam@8
|
186 NoEncryption => associateNoEncryption url atype
|
adam@8
|
187 | _ => associateDh url atype stype
|
adam@8
|
188
|
adam@8
|
189 fun association atype stype url =
|
adam@8
|
190 secret <- oldAssociation url;
|
adam@8
|
191 case secret of
|
adam@4
|
192 Some r => return (Association r)
|
adam@3
|
193 | None =>
|
adam@8
|
194 stype <- return (case (stype, String.isPrefix {Full = url, Prefix = "https://"}) of
|
adam@8
|
195 (NoEncryption, False) => DH_SHA256
|
adam@8
|
196 | _ => stype);
|
adam@8
|
197 r <- newAssociation url atype stype;
|
adam@8
|
198 case r of
|
adam@8
|
199 AssAlternate alt =>
|
adam@8
|
200 if alt.Atype = atype && alt.Stype = stype then
|
adam@8
|
201 return (AssError "Suggested new modes match old ones!")
|
adam@8
|
202 else
|
adam@12
|
203 debug "Renegotiating protocol";
|
adam@8
|
204 newAssociation url alt.Atype alt.Stype
|
adam@8
|
205 | v => return v
|
adam@4
|
206
|
adam@13
|
207 datatype handle_result = HandleOk of {Endpoint : string, Typ : association_type, Key : string} | NoAssociation of string | HandleError of string
|
adam@13
|
208
|
adam@13
|
209 datatype authentication = AuthenticatedAs of string | Canceled | Failure of string
|
adam@6
|
210
|
adam@6
|
211 fun verifyHandle os id =
|
adam@10
|
212 id' <- return (eatFragment id);
|
adam@10
|
213 ep <- discover id';
|
adam@6
|
214 case ep of
|
adam@10
|
215 None => return (HandleError ("Discovery failed on returned identifier: " ^ id'))
|
adam@6
|
216 | Some ep =>
|
adam@6
|
217 case OpenidFfi.getOutput os "openid.assoc_handle" of
|
adam@6
|
218 None => return (HandleError "Missing association handle in response")
|
adam@6
|
219 | Some handle =>
|
adam@8
|
220 assoc <- oldAssociation ep;
|
adam@6
|
221 case assoc of
|
adam@13
|
222 None => return (NoAssociation ep)
|
adam@8
|
223 | Some assoc =>
|
adam@6
|
224 if assoc.Handle <> handle then
|
adam@6
|
225 return (HandleError "Association handles don't match")
|
adam@6
|
226 else
|
adam@8
|
227 return (HandleOk {Endpoint = ep, Typ = assoc.Typ, Key = assoc.Key})
|
adam@6
|
228
|
adam@14
|
229 fun verifyStateless os ep id expectInvalidation =
|
adam@13
|
230 os' <- OpenidFfi.direct ep (OpenidFfi.remode os "check_authentication");
|
adam@13
|
231 case OpenidFfi.getOutput os' "error" of
|
adam@13
|
232 Some msg => return (Failure ("Failure confirming message contents with OP: " ^ msg))
|
adam@13
|
233 | None =>
|
adam@14
|
234 let
|
adam@14
|
235 fun finish () = case OpenidFfi.getOutput os' "is_valid" of
|
adam@14
|
236 Some "true" => return (AuthenticatedAs id)
|
adam@14
|
237 | _ => return (Failure "OP does not confirm message contents")
|
adam@14
|
238 in
|
adam@14
|
239 case OpenidFfi.getOutput os' "invalidate_handle" of
|
adam@14
|
240 None =>
|
adam@14
|
241 if expectInvalidation then
|
adam@14
|
242 return (Failure "Claimed invalidate_handle is not confirmed")
|
adam@14
|
243 else
|
adam@14
|
244 finish ()
|
adam@14
|
245 | Some handle =>
|
adam@14
|
246 dml (DELETE FROM associations
|
adam@14
|
247 WHERE Endpoint = {[ep]} AND Handle = {[handle]});
|
adam@14
|
248 finish ()
|
adam@14
|
249 end
|
adam@13
|
250
|
adam@6
|
251 table nonces : { Endpoint : string, Nonce : string, Expires : time }
|
adam@6
|
252 PRIMARY KEY (Endpoint, Nonce)
|
adam@6
|
253
|
adam@6
|
254 fun timeOfNonce s =
|
adam@6
|
255 case String.split s #"T" of
|
adam@6
|
256 None => None
|
adam@6
|
257 | Some (date, s) =>
|
adam@6
|
258 case String.split s #"Z" of
|
adam@6
|
259 None => None
|
adam@7
|
260 | Some (time, _) => readUtc (date ^ " " ^ time)
|
adam@6
|
261
|
adam@6
|
262 fun verifyNonce os ep =
|
adam@6
|
263 case OpenidFfi.getOutput os "openid.response_nonce" of
|
adam@6
|
264 None => return (Some "Missing nonce in OP response")
|
adam@6
|
265 | Some nonce =>
|
adam@6
|
266 case timeOfNonce nonce of
|
adam@6
|
267 None => return (Some "Invalid timestamp in nonce")
|
adam@6
|
268 | Some tm =>
|
adam@6
|
269 now <- now;
|
adam@9
|
270 if tm < addSeconds now (-nonceExpiry) then
|
adam@6
|
271 return (Some "Nonce timestamp is too old")
|
adam@9
|
272 else if tm > addSeconds now nonceSkew then
|
adam@11
|
273 return (Some "Nonce timestamp is too far in the future")
|
adam@6
|
274 else
|
adam@6
|
275 b <- oneRowE1 (SELECT COUNT( * ) > 0
|
adam@6
|
276 FROM nonces
|
adam@6
|
277 WHERE nonces.Endpoint = {[ep]}
|
adam@6
|
278 AND nonces.Nonce = {[nonce]});
|
adam@6
|
279
|
adam@6
|
280 if b then
|
adam@6
|
281 return (Some "Duplicate nonce")
|
adam@6
|
282 else
|
adam@6
|
283 dml (INSERT INTO nonces (Endpoint, Nonce, Expires)
|
adam@9
|
284 VALUES ({[ep]}, {[nonce]}, {[addSeconds now nonceExpiry]}));
|
adam@6
|
285 return None
|
adam@6
|
286
|
adam@8
|
287 fun verifySig os atype key =
|
adam@6
|
288 case OpenidFfi.getOutput os "openid.signed" of
|
adam@6
|
289 None => return (Some "Missing openid.signed in OP response")
|
adam@6
|
290 | Some signed =>
|
adam@6
|
291 case OpenidFfi.getOutput os "openid.sig" of
|
adam@6
|
292 None => return (Some "Missing openid.sig in OP response")
|
adam@6
|
293 | Some sign => let
|
adam@9
|
294 fun gatherNvps signed required acc =
|
adam@6
|
295 let
|
adam@6
|
296 val (this, next) =
|
adam@6
|
297 case String.split signed #"," of
|
adam@6
|
298 None => (signed, None)
|
adam@6
|
299 | Some (this, next) => (this, Some next)
|
adam@6
|
300 in
|
adam@6
|
301 case OpenidFfi.getOutput os ("openid." ^ this) of
|
adam@6
|
302 None => None
|
adam@6
|
303 | Some value =>
|
adam@6
|
304 let
|
adam@9
|
305 val required = List.filter (fn other => other <> this) required
|
adam@6
|
306 val acc = acc ^ this ^ ":" ^ value ^ "\n"
|
adam@6
|
307 in
|
adam@6
|
308 case next of
|
adam@9
|
309 None => Some (required, acc)
|
adam@9
|
310 | Some next => gatherNvps next required acc
|
adam@6
|
311 end
|
adam@6
|
312 end
|
adam@6
|
313 in
|
adam@9
|
314 case gatherNvps signed ("op_endpoint" :: "return_to" :: "response_nonce" :: "assoc_handle" :: "claimed_id" :: "identity" :: []) "" of
|
adam@6
|
315 None => return (Some "openid.signed mentions missing field")
|
adam@9
|
316 | Some ([], nvps) =>
|
adam@6
|
317 let
|
adam@8
|
318 val sign' = case atype of
|
adam@12
|
319 HMAC_SHA256 => OpenidFfi.hmac_sha256 key nvps
|
adam@12
|
320 | HMAC_SHA1 => OpenidFfi.hmac_sha1 key nvps
|
adam@6
|
321 in
|
adam@6
|
322 if sign' = sign then
|
adam@6
|
323 return None
|
adam@6
|
324 else
|
adam@6
|
325 return (Some "Signatures don't match")
|
adam@6
|
326 end
|
adam@9
|
327 | Some (left, _) => return (Some ("openid.signed is missing required fields: " ^ show left))
|
adam@6
|
328 end
|
adam@6
|
329
|
adam@10
|
330 fun authenticate after r =
|
adam@10
|
331 let
|
adam@12
|
332 fun returnTo (qs : option queryString) =
|
adam@10
|
333 case qs of
|
adam@10
|
334 None => after (Failure "Empty query string for OpenID callback")
|
adam@10
|
335 | Some qs =>
|
adam@10
|
336 os <- OpenidFfi.indirect qs;
|
adam@10
|
337 case OpenidFfi.getOutput os "openid.error" of
|
adam@13
|
338 Some v => after (Failure ("Authentication failed: " ^ v))
|
adam@10
|
339 | None =>
|
adam@10
|
340 case OpenidFfi.getOutput os "openid.mode" of
|
adam@10
|
341 None => after (Failure "No openid.mode in response")
|
adam@10
|
342 | Some mode =>
|
adam@10
|
343 case mode of
|
adam@10
|
344 "cancel" => after Canceled
|
adam@10
|
345 | "id_res" =>
|
adam@10
|
346 (case OpenidFfi.getOutput os "openid.claimed_id" of
|
adam@10
|
347 None => after (Failure "Missing identity in OP response")
|
adam@10
|
348 | Some id =>
|
adam@13
|
349 errO <- verifyReturnTo os;
|
adam@6
|
350 case errO of
|
adam@13
|
351 Some s => after (Failure s)
|
adam@13
|
352 | None =>
|
adam@13
|
353 errO <- verifyHandle os id;
|
adam@6
|
354 case errO of
|
adam@13
|
355 HandleError s => after (Failure s)
|
adam@13
|
356 | NoAssociation ep =>
|
adam@14
|
357 r <- verifyStateless os ep id False;
|
adam@13
|
358 after r
|
adam@13
|
359 | HandleOk {Endpoint = ep, Typ = atype, Key = key} =>
|
adam@14
|
360 case OpenidFfi.getOutput os "openid.invalidate_handle" of
|
adam@14
|
361 Some _ =>
|
adam@14
|
362 r <- verifyStateless os ep id True;
|
adam@14
|
363 after r
|
adam@10
|
364 | None =>
|
adam@14
|
365 errO <- verifyNonce os ep;
|
adam@10
|
366 case errO of
|
adam@10
|
367 Some s => after (Failure s)
|
adam@14
|
368 | None =>
|
adam@14
|
369 errO <- verifySig os atype key;
|
adam@14
|
370 case errO of
|
adam@14
|
371 Some s => after (Failure s)
|
adam@14
|
372 | None => after (AuthenticatedAs id))
|
adam@10
|
373 | _ => after (Failure ("Unexpected openid.mode: " ^ mode))
|
adam@4
|
374
|
adam@12
|
375 and verifyReturnTo os =
|
adam@10
|
376 case OpenidFfi.getOutput os "openid.return_to" of
|
adam@10
|
377 None => return (Some "Missing return_to in OP response")
|
adam@10
|
378 | Some rt =>
|
adam@12
|
379 if rt <> show (effectfulUrl returnTo) then
|
adam@10
|
380 return (Some "Wrong return_to in OP response")
|
adam@10
|
381 else
|
adam@10
|
382 return None
|
adam@15
|
383
|
adam@15
|
384 val realmString = case r.Realm of
|
adam@15
|
385 None => ""
|
adam@15
|
386 | Some realm => "&openid.realm=" ^ realm
|
adam@10
|
387 in
|
adam@10
|
388 dy <- discover r.Identifier;
|
adam@10
|
389 case dy of
|
adam@10
|
390 None => return "Discovery failed"
|
adam@10
|
391 | Some dy =>
|
adam@27
|
392 let
|
adam@27
|
393 val begin = case String.index dy #"?" of
|
adam@27
|
394 None => "?"
|
adam@27
|
395 | Some _ => "&"
|
adam@27
|
396 in
|
adam@27
|
397 case r.Association of
|
adam@27
|
398 Stateless =>
|
adam@27
|
399 redirect (bless (dy ^ begin ^ "openid.ns=http://specs.openid.net/auth/2.0&openid.mode=checkid_setup"
|
adam@26
|
400 ^ "&openid.claimed_id=http://specs.openid.net/auth/2.0/identifier_select"
|
adam@17
|
401 ^ "&openid.identity=http://specs.openid.net/auth/2.0/identifier_select&openid.assoc_handle="
|
adam@27
|
402 ^ "&openid.return_to=" ^ show (effectfulUrl returnTo) ^ realmString))
|
adam@27
|
403 | Stateful ar =>
|
adam@27
|
404 assoc <- association ar.AssociationType ar.AssociationSessionType dy;
|
adam@27
|
405 case assoc of
|
adam@27
|
406 AssError msg => return ("Association failure: " ^ msg)
|
adam@27
|
407 | AssAlternate _ => return "Association failure: server didn't accept its own alternate association modes"
|
adam@27
|
408 | Association assoc =>
|
adam@27
|
409 redirect (bless (dy ^ begin ^ "openid.ns=http://specs.openid.net/auth/2.0&openid.mode=checkid_setup"
|
adam@27
|
410 ^ "&openid.claimed_id=http://specs.openid.net/auth/2.0/identifier_select"
|
adam@27
|
411 ^ "&openid.identity=http://specs.openid.net/auth/2.0/identifier_select&openid.assoc_handle="
|
adam@27
|
412 ^ assoc.Handle ^ "&openid.return_to=" ^ show (effectfulUrl returnTo) ^ realmString))
|
adam@27
|
413 end
|
adam@10
|
414 end
|
adam@6
|
415
|
adam@22
|
416 task periodic 60 = fn () =>
|
adam@22
|
417 dml (DELETE FROM discoveries WHERE Expires < CURRENT_TIMESTAMP);
|
adam@22
|
418 dml (DELETE FROM associations WHERE Expires < CURRENT_TIMESTAMP);
|
adam@22
|
419 dml (DELETE FROM nonces WHERE Expires < CURRENT_TIMESTAMP)
|