Mercurial > openid

annotate src/ur/openidUser.ur @ 21:354dae3008de

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Fix embarrassing bug that deleted sessions that were too new, rather than old
author Adam Chlipala <adam@chlipala.net>
date Sat, 08 Jan 2011 18:47:27 -0500
parents 2342d9baa0df
children 70ab0230649b
rev   line source
adam@16 1 functor Make(M: sig
adam@16 2 con cols :: {Type}
adam@16 3 constraint [Id] ~ cols
adam@17 4 val folder : folder cols
adam@17 5 val inj : $(map sql_injectable cols)
adam@17 6
adam@17 7 type creationState
adam@17 8 type creationData
adam@17 9 val creationState : transaction creationState
adam@17 10 val render : creationState -> xtable
adam@20 11 val ready : creationState -> signal bool
adam@17 12 val tabulate : creationState -> signal creationData
adam@17 13 val choose : sql_table ([Id = string] ++ cols) [Pkey = [Id]] -> creationData -> transaction $cols
adam@16 14
adam@16 15 val sessionLifetime : int
adam@16 16 val afterLogout : url
adam@16 17 val secureCookies : bool
adam@16 18 val association : Openid.association_mode
adam@16 19 val realm : option string
adam@17 20 val formClass : css_class
adam@16 21 end) = struct
adam@16 22
adam@16 23 type user = string
adam@16 24 val show_user = _
adam@16 25 val inj_user = _
adam@16 26
adam@16 27 table user : ([Id = user] ++ M.cols)
adam@16 28 PRIMARY KEY Id
adam@16 29
adam@16 30 table identity : {User : user, Identifier : string}
adam@16 31 PRIMARY KEY (User, Identifier)
adam@16 32
adam@16 33 sequence sessionIds
adam@16 34
adam@16 35 table session : {Id : int, Key : int, Identifier : option string, Expires : time}
adam@16 36 PRIMARY KEY Id
adam@16 37
adam@16 38 cookie signingUp : {Session : int, Key : int}
adam@16 39 cookie login : {User : user, Session : int, Key : int}
adam@16 40
adam@17 41 val currentUrl =
adam@17 42 b <- currentUrlHasPost;
adam@17 43 if b then
adam@17 44 return M.afterLogout
adam@17 45 else
adam@17 46 currentUrl
adam@17 47
adam@16 48 val current =
adam@16 49 login <- getCookie login;
adam@16 50 case login of
adam@16 51 None => return None
adam@16 52 | Some login =>
adam@16 53 ident <- oneOrNoRowsE1 (SELECT (session.Identifier)
adam@16 54 FROM session
adam@16 55 WHERE session.Id = {[login.Session]}
adam@16 56 AND session.Key = {[login.Key]});
adam@16 57 case ident of
adam@18 58 None => return None
adam@16 59 | Some None => return None
adam@16 60 | Some (Some ident) =>
adam@16 61 valid <- oneRowE1 (SELECT COUNT( * ) > 0
adam@16 62 FROM identity
adam@16 63 WHERE identity.User = {[login.User]}
adam@16 64 AND identity.Identifier = {[ident]});
adam@16 65 if valid then
adam@16 66 return (Some login.User)
adam@16 67 else
adam@16 68 error <xml>Session not authorized to act as user</xml>
adam@16 69
adam@17 70 fun validUser s = String.length s > 0 && String.length s < 20
adam@17 71 && String.all Char.isAlnum s
adam@17 72
adam@16 73 fun main wrap =
adam@16 74 let
adam@16 75 fun logout () =
adam@16 76 clearCookie login;
adam@16 77 redirect M.afterLogout
adam@16 78
adam@17 79 fun signupDetails after =
adam@17 80 let
adam@17 81 fun finishSignup uid data =
adam@17 82 if not (validUser uid) then
adam@17 83 return (Some "That username is not valid. It must be between 1 and 19 characters long, containing only letters and numbers.")
adam@17 84 else
adam@17 85 used <- oneRowE1 (SELECT COUNT( * ) > 0
adam@17 86 FROM user
adam@17 87 WHERE user.Id = {[uid]});
adam@17 88 if used then
adam@17 89 return (Some "That username is taken. Please choose another.")
adam@17 90 else
adam@17 91 ses <- getCookie signingUp;
adam@17 92 case ses of
adam@17 93 None => return (Some "Missing session cookie")
adam@17 94 | Some ses =>
adam@17 95 ident <- oneOrNoRowsE1 (SELECT (session.Identifier)
adam@17 96 FROM session
adam@17 97 WHERE session.Id = {[ses.Session]}
adam@17 98 AND session.Key = {[ses.Key]});
adam@17 99 case ident of
adam@17 100 None => return (Some "Invalid session data")
adam@17 101 | Some None => return (Some "Session has no associated identifier")
adam@17 102 | Some (Some ident) =>
adam@17 103 clearCookie signingUp;
adam@17 104 setCookie login {Value = {User = uid} ++ ses,
adam@17 105 Expires = None,
adam@17 106 Secure = M.secureCookies};
adam@17 107
adam@17 108 cols <- M.choose user data;
adam@17 109 dml (insert user ({Id = (SQL {[uid]})} ++ @Sql.sqexps M.folder M.inj cols));
adam@17 110 dml (INSERT INTO identity (User, Identifier)
adam@17 111 VALUES ({[uid]}, {[ident]}));
adam@17 112 redirect (bless after)
adam@17 113 in
adam@17 114 uid <- source "";
adam@17 115 cs <- M.creationState;
adam@17 116
adam@17 117 wrap "Your User Details" <xml>
adam@17 118 <table class={M.formClass}>
adam@17 119 <tr> <th class={M.formClass}>Username:</th> <td><ctextbox source={uid}/></td> </tr>
adam@17 120 {M.render cs}
adam@20 121 <tr> <td><dyn signal={b <- M.ready cs;
adam@20 122 return (if b then
adam@20 123 <xml><button value="Create Account"
adam@20 124 onclick={uid <- get uid;
adam@20 125 data <- Basis.current (M.tabulate cs);
adam@20 126 res <- rpc (finishSignup uid data);
adam@20 127 case res of
adam@20 128 None => redirect (bless after)
adam@20 129 | Some msg => alert msg}/></xml>
adam@20 130 else
adam@20 131 <xml/>)}/></td> </tr>
adam@17 132 </table>
adam@17 133 </xml>
adam@17 134 end
adam@17 135
adam@16 136 fun opCallback after ses res =
adam@16 137 case res of
adam@16 138 Openid.Canceled => error <xml>You canceled the login process.</xml>
adam@16 139 | Openid.Failure s => error <xml>Login failed: {[s]}</xml>
adam@16 140 | Openid.AuthenticatedAs ident =>
adam@16 141 signup <- getCookie signingUp;
adam@16 142 case signup of
adam@16 143 Some signup =>
adam@16 144 if signup.Session <> ses then
adam@16 145 error <xml>Session has changed suspiciously</xml>
adam@16 146 else
adam@16 147 invalid <- oneRowE1 (SELECT COUNT( * ) = 0
adam@16 148 FROM session
adam@16 149 WHERE session.Id = {[signup.Session]}
adam@16 150 AND session.Key = {[signup.Key]});
adam@16 151 if invalid then
adam@16 152 error <xml>Invalid or expired session</xml>
adam@16 153 else
adam@17 154 dml (UPDATE session
adam@17 155 SET Identifier = {[Some ident]}
adam@17 156 WHERE Id = {[signup.Session]});
adam@17 157 signupDetails after
adam@16 158 | None =>
adam@16 159 login <- getCookie login;
adam@16 160 case login of
adam@16 161 None => error <xml>Missing session cookie</xml>
adam@16 162 | Some login =>
adam@16 163 if login.Session <> ses then
adam@16 164 error <xml>Session has changed suspiciously</xml>
adam@16 165 else
adam@16 166 invalid <- oneRowE1 (SELECT COUNT( * ) = 0
adam@16 167 FROM session
adam@16 168 WHERE session.Id = {[login.Session]}
adam@16 169 AND session.Key = {[login.Key]});
adam@16 170 if invalid then
adam@16 171 error <xml>Invalid or expired session</xml>
adam@16 172 else
adam@16 173 dml (UPDATE session
adam@16 174 SET Identifier = {[Some ident]}
adam@17 175 WHERE Id = {[login.Session]});
adam@16 176 redirect (bless after)
adam@16 177
adam@16 178 fun newSession () =
adam@16 179 ses <- nextval sessionIds;
adam@16 180 now <- now;
adam@16 181 key <- rand;
adam@16 182 dml (INSERT INTO session (Id, Key, Identifier, Expires)
adam@16 183 VALUES ({[ses]}, {[key]}, NULL, {[addSeconds now M.sessionLifetime]}));
adam@16 184 return {Session = ses, Key = key}
adam@16 185
adam@17 186 fun logon after r =
adam@16 187 ident <- oneOrNoRowsE1 (SELECT (identity.Identifier)
adam@16 188 FROM identity
adam@16 189 WHERE identity.User = {[r.User]}
adam@16 190 LIMIT 1);
adam@16 191 case ident of
adam@16 192 None => error <xml>Username not found</xml>
adam@16 193 | Some ident =>
adam@16 194 ses <- newSession ();
adam@16 195 setCookie login {Value = r ++ ses,
adam@16 196 Expires = None,
adam@16 197 Secure = M.secureCookies};
adam@16 198 ses <- return ses.Session;
adam@16 199 msg <- Openid.authenticate (opCallback after ses)
adam@16 200 {Association = M.association,
adam@16 201 Realm = M.realm,
adam@16 202 Identifier = ident};
adam@16 203 error <xml>Login with your identity provider failed: {[msg]}</xml>
adam@16 204
adam@16 205 fun doSignup after r =
adam@16 206 ses <- newSession ();
adam@16 207 setCookie signingUp {Value = ses,
adam@16 208 Expires = None,
adam@16 209 Secure = M.secureCookies};
adam@16 210 ses <- return ses.Session;
adam@16 211 msg <- Openid.authenticate (opCallback after ses)
adam@16 212 {Association = M.association,
adam@16 213 Realm = M.realm,
adam@16 214 Identifier = r.Identifier};
adam@16 215 error <xml>Login with your identity provider failed: {[msg]}</xml>
adam@16 216
adam@16 217 fun signup () =
adam@16 218 after <- currentUrl;
adam@16 219 wrap "Account Signup" <xml>
adam@16 220 <form>
adam@16 221 OpenID Identifier: <textbox{#Identifier}/><br/>
adam@16 222 <submit value="Sign Up" action={doSignup (show after)}/>
adam@16 223 </form>
adam@16 224 </xml>
adam@16 225 in
adam@16 226 cur <- current;
adam@17 227 here <- currentUrl;
adam@16 228 case cur of
adam@16 229 Some cur => return <xml>Logged in as {[cur]}. <a link={logout ()}>[Log out]</a></xml>
adam@16 230 | None => return <xml>
adam@17 231 <form><textbox{#User}/> <submit value="Log In" action={logon (show here)}/></form>
adam@16 232 <a link={signup ()}>Sign up</a>
adam@16 233 </xml>
adam@16 234 end
adam@16 235
adam@16 236 task periodic 60 = fn () => dml (DELETE FROM session
adam@21 237 WHERE Expires < CURRENT_TIMESTAMP)
adam@16 238
adam@16 239 end