Mercurial > openid

comparison src/ur/openidUser.ur @ 56:c41d3ac0958b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge from upstream.
author Karn Kallio <kkallio@eka>
date Sun, 24 Jul 2011 13:03:11 -0430
parents a984dc1c8954
children 9f392276d614
comparison
equal deleted inserted replaced
55:1ceea714b3b5 56:c41d3ac0958b
7 7
8 datatype choose_result a = Success of a | Failure of string 8 datatype choose_result a = Success of a | Failure of string
9 9
10 signature CTLDISPLAY = sig 10 signature CTLDISPLAY = sig
11 val formatUser : xbody -> xbody 11 val formatUser : xbody -> xbody
12 val formatLogout : url -> xbody 12 val formatLogout : ($([]) -> transaction page) -> xbody
13 val formatSignup : url -> xbody 13 val formatSignup : url -> xbody
14 val formatLogon : ({User : string} -> transaction page) -> xbody 14 val formatLogon : ({User : string} -> transaction page) -> xbody
15 end 15 end
16 16
17 structure DefaultDisplay : CTLDISPLAY = struct 17 structure DefaultDisplay : CTLDISPLAY = struct
18 fun formatUser user = 18 fun formatUser user =
19 <xml>You are logged in as {user}.</xml> 19 <xml>You are logged in as {user}.</xml>
20 20
21 fun formatLogout url = 21 fun formatLogout handler =
22 <xml><a href={url}>Log Out</a></xml> 22 <xml>
23 <form><submit value="Logout" action={handler}/></form>
24 </xml>
23 25
24 fun formatSignup url = 26 fun formatSignup url =
25 <xml><a href={url}>Sign Up</a></xml> 27 <xml><a href={url}>Sign Up</a></xml>
26 28
27 fun formatLogon handler = 29 fun formatLogon handler =
88 if b then 90 if b then
89 return M.afterLogout 91 return M.afterLogout
90 else 92 else
91 currentUrl 93 currentUrl
92 94
93 val current = 95 fun current' tweakSession =
94 login <- getCookie auth; 96 login <- getCookie auth;
95 case login of 97 case login of
96 Some (LoggedIn login) => 98 Some (LoggedIn login) =>
97 (ident <- oneOrNoRowsE1 (SELECT (session.Identifier) 99 (ident <- oneOrNoRowsE1 (SELECT (session.Identifier)
98 FROM session 100 FROM session
105 valid <- oneRowE1 (SELECT COUNT( * ) > 0 107 valid <- oneRowE1 (SELECT COUNT( * ) > 0
106 FROM identity 108 FROM identity
107 WHERE identity.User = {[login.User]} 109 WHERE identity.User = {[login.User]}
108 AND identity.Identifier = {[ident]}); 110 AND identity.Identifier = {[ident]});
109 if valid then 111 if valid then
112 tweakSession login.Session;
110 return (Some login.User) 113 return (Some login.User)
111 else 114 else
112 error <xml>Session not authorized to act as user</xml>) 115 error <xml>Session not authorized to act as user</xml>)
113 | _ => return None 116 | _ => return None
114 117
118 val current = current' (fn _ => return ())
119
120 val renew = current' (fn id =>
121 now <- now;
122 dml (UPDATE session
123 SET Expires = {[addSeconds now M.sessionLifetime]}
124 WHERE Id = {[id]}))
125
115 fun validUser s = String.length s > 0 && String.length s < 20 126 fun validUser s = String.length s > 0 && String.length s < 20
116 && String.all Char.isAlnum s 127 && String.all Char.isAlnum s
117 128
118 fun main wrap = 129 fun main wrap =
119 let 130 let
120 fun logout () = 131 fun logout () =
132 login <- getCookie auth;
121 clearCookie auth; 133 clearCookie auth;
134 (case login of
135 Some (LoggedIn login) =>
136 dml (DELETE FROM session
137 WHERE Id = {[login.Session]}
138 AND Key = {[login.Key]})
139 | _ => return ());
122 redirect M.afterLogout 140 redirect M.afterLogout
123 141
124 fun newSession identO = 142 fun newSession identO =
125 ses <- nextval sessionIds; 143 ses <- nextval sessionIds;
126 now <- now; 144 now <- now;
335 cur <- current; 353 cur <- current;
336 here <- currentUrl; 354 here <- currentUrl;
337 355
338 case cur of 356 case cur of
339 Some cur => return {Status = (M.CtlDisplay.formatUser <xml>{[cur]}</xml>), 357 Some cur => return {Status = (M.CtlDisplay.formatUser <xml>{[cur]}</xml>),
340 Other = {Url = (url (logout ())), 358 Other = {Url = None,
341 Xml = (M.CtlDisplay.formatLogout (url (logout ())))}} 359 Xml = (M.CtlDisplay.formatLogout logout)}}
342 | None => return {Status = (M.CtlDisplay.formatLogon (logon (show here))), 360 | None => return {Status = (M.CtlDisplay.formatLogon (logon (show here))),
343 Other = {Url = (url (signup (show here))), 361 Other = {Url = Some (url (signup (show here))),
344 Xml = (M.CtlDisplay.formatSignup (url (signup (show here))))}} 362 Xml = (M.CtlDisplay.formatSignup (url (signup (show here))))}}
345 end 363 end
346 364
347 task periodic 60 = fn () => dml (DELETE FROM session 365 task periodic 60 = fn () => dml (DELETE FROM session
348 WHERE Expires < CURRENT_TIMESTAMP) 366 WHERE Expires < CURRENT_TIMESTAMP)