# HG changeset patch # User Karn Kallio # Date 1311528791 16200 # Node ID c41d3ac0958bec3d377206cffcd52edb2a00ff96 # Parent 1ceea714b3b5e903afc69e97a691776a53b08b42# Parent a984dc1c8954825d9682633a2b03452fa0ced56b Merge from upstream. diff -r 1ceea714b3b5 -r c41d3ac0958b src/ur/openidUser.ur --- a/src/ur/openidUser.ur Tue Jul 19 11:03:29 2011 -0430 +++ b/src/ur/openidUser.ur Sun Jul 24 13:03:11 2011 -0430 @@ -9,7 +9,7 @@ signature CTLDISPLAY = sig val formatUser : xbody -> xbody - val formatLogout : url -> xbody + val formatLogout : ($([]) -> transaction page) -> xbody val formatSignup : url -> xbody val formatLogon : ({User : string} -> transaction page) -> xbody end @@ -18,8 +18,10 @@ fun formatUser user = You are logged in as {user}. - fun formatLogout url = - Log Out + fun formatLogout handler = + +
+
fun formatSignup url = Sign Up @@ -90,7 +92,7 @@ else currentUrl - val current = + fun current' tweakSession = login <- getCookie auth; case login of Some (LoggedIn login) => @@ -107,18 +109,34 @@ WHERE identity.User = {[login.User]} AND identity.Identifier = {[ident]}); if valid then + tweakSession login.Session; return (Some login.User) else error Session not authorized to act as user) | _ => return None + val current = current' (fn _ => return ()) + + val renew = current' (fn id => + now <- now; + dml (UPDATE session + SET Expires = {[addSeconds now M.sessionLifetime]} + WHERE Id = {[id]})) + fun validUser s = String.length s > 0 && String.length s < 20 && String.all Char.isAlnum s fun main wrap = let fun logout () = + login <- getCookie auth; clearCookie auth; + (case login of + Some (LoggedIn login) => + dml (DELETE FROM session + WHERE Id = {[login.Session]} + AND Key = {[login.Key]}) + | _ => return ()); redirect M.afterLogout fun newSession identO = @@ -337,10 +355,10 @@ case cur of Some cur => return {Status = (M.CtlDisplay.formatUser {[cur]}), - Other = {Url = (url (logout ())), - Xml = (M.CtlDisplay.formatLogout (url (logout ())))}} + Other = {Url = None, + Xml = (M.CtlDisplay.formatLogout logout)}} | None => return {Status = (M.CtlDisplay.formatLogon (logon (show here))), - Other = {Url = (url (signup (show here))), + Other = {Url = Some (url (signup (show here))), Xml = (M.CtlDisplay.formatSignup (url (signup (show here))))}} end diff -r 1ceea714b3b5 -r c41d3ac0958b src/ur/openidUser.urs --- a/src/ur/openidUser.urs Tue Jul 19 11:03:29 2011 -0430 +++ b/src/ur/openidUser.urs Sun Jul 24 13:03:11 2011 -0430 @@ -15,8 +15,8 @@ val formatUser : xbody -> xbody (* Format the display of the logged on user *) - val formatLogout : url -> xbody - (* Format the logout link *) + val formatLogout : ($([]) -> transaction page) -> xbody + (* Format the logout button *) val formatSignup : url -> xbody (* Format the signup link *) @@ -105,16 +105,21 @@ val current : transaction (option user) (* Figure out which, if any, user is logged in on this connection. *) + val renew : transaction (option user) + (* Like [current], but also resets the expiration time of the user's + * session, if one is found. *) + val main : (string -> xbody -> transaction page) -> transaction {Status : xbody, - Other : {Url : url, Xml : xbody}} + Other : {Url : option url, Xml : xbody}} (* Pass in your generic page template; get out the HTML snippet for user * management, suitable for, e.g., inclusion in your standard page * header. The output gives a "status" chunk, which will either be a login * form or a message about which user is logged in; and an "other" chunk, - * which will be a log out or sign up link. In the case "other", the link - * itself is also provided for cases when one format is not enough. *) + * which will be a log out button or sign up link. In the case of "other", + * the link itself (if available) is also provided for cases when one + * format is not enough. *) end