Mercurial > openid

annotate src/ur/openidUser.ur @ 18:dd8eb53da51b

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