changeset 56:c41d3ac0958b

Merge from upstream.
author Karn Kallio <kkallio@eka>
date Sun, 24 Jul 2011 13:03:11 -0430
parents 1ceea714b3b5 a984dc1c8954
children 748dd8a2e3a2
files
diffstat 2 files changed, 35 insertions(+), 12 deletions(-) [+]
line wrap: on
line diff
--- 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 =
         <xml>You are logged in as {user}.</xml>
 
-    fun formatLogout url =
-        <xml><a href={url}>Log Out</a></xml>
+    fun formatLogout handler =
+        <xml>
+	  <form><submit value="Logout" action={handler}/></form>
+	</xml>
 
     fun formatSignup url =
         <xml><a href={url}>Sign Up</a></xml>
@@ -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 <xml>Session not authorized to act as user</xml>)
           | _ => 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 <xml>{[cur]}</xml>),
-                                    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
 
--- 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