Mercurial > openid

annotate src/ur/openidUser.ur @ 16:9851bc87b0d7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Beginning of OpenidUser
author Adam Chlipala <adam@chlipala.net>
date Thu, 06 Jan 2011 12:48:13 -0500
parents
children df2eb629f21a
rev   line source
adam@16 1 functor Make(M: sig
adam@16 2 con cols :: {Type}
adam@16 3 constraint [Id] ~ cols
adam@16 4
adam@16 5 val sessionLifetime : int
adam@16 6 val afterLogout : url
adam@16 7 val secureCookies : bool
adam@16 8 val association : Openid.association_mode
adam@16 9 val realm : option string
adam@16 10 end) = struct
adam@16 11
adam@16 12 type user = string
adam@16 13 val show_user = _
adam@16 14 val inj_user = _
adam@16 15
adam@16 16 table user : ([Id = user] ++ M.cols)
adam@16 17 PRIMARY KEY Id
adam@16 18
adam@16 19 table identity : {User : user, Identifier : string}
adam@16 20 PRIMARY KEY (User, Identifier)
adam@16 21
adam@16 22 sequence sessionIds
adam@16 23
adam@16 24 table session : {Id : int, Key : int, Identifier : option string, Expires : time}
adam@16 25 PRIMARY KEY Id
adam@16 26
adam@16 27 cookie signingUp : {Session : int, Key : int}
adam@16 28 cookie login : {User : user, Session : int, Key : int}
adam@16 29
adam@16 30 val current =
adam@16 31 login <- getCookie login;
adam@16 32 case login of
adam@16 33 None => return None
adam@16 34 | Some login =>
adam@16 35 ident <- oneOrNoRowsE1 (SELECT (session.Identifier)
adam@16 36 FROM session
adam@16 37 WHERE session.Id = {[login.Session]}
adam@16 38 AND session.Key = {[login.Key]});
adam@16 39 case ident of
adam@16 40 None => error <xml>Invalid or expired session</xml>
adam@16 41 | Some None => return None
adam@16 42 | Some (Some ident) =>
adam@16 43 valid <- oneRowE1 (SELECT COUNT( * ) > 0
adam@16 44 FROM identity
adam@16 45 WHERE identity.User = {[login.User]}
adam@16 46 AND identity.Identifier = {[ident]});
adam@16 47 if valid then
adam@16 48 return (Some login.User)
adam@16 49 else
adam@16 50 error <xml>Session not authorized to act as user</xml>
adam@16 51
adam@16 52 fun main wrap =
adam@16 53 let
adam@16 54 fun logout () =
adam@16 55 clearCookie login;
adam@16 56 redirect M.afterLogout
adam@16 57
adam@16 58 fun opCallback after ses res =
adam@16 59 case res of
adam@16 60 Openid.Canceled => error <xml>You canceled the login process.</xml>
adam@16 61 | Openid.Failure s => error <xml>Login failed: {[s]}</xml>
adam@16 62 | Openid.AuthenticatedAs ident =>
adam@16 63 signup <- getCookie signingUp;
adam@16 64 case signup of
adam@16 65 Some signup =>
adam@16 66 if signup.Session <> ses then
adam@16 67 error <xml>Session has changed suspiciously</xml>
adam@16 68 else
adam@16 69 invalid <- oneRowE1 (SELECT COUNT( * ) = 0
adam@16 70 FROM session
adam@16 71 WHERE session.Id = {[signup.Session]}
adam@16 72 AND session.Key = {[signup.Key]});
adam@16 73 if invalid then
adam@16 74 error <xml>Invalid or expired session</xml>
adam@16 75 else
adam@16 76 return <xml>I now believe that you are {[ident]}.</xml>
adam@16 77 | None =>
adam@16 78 login <- getCookie login;
adam@16 79 case login of
adam@16 80 None => error <xml>Missing session cookie</xml>
adam@16 81 | Some login =>
adam@16 82 if login.Session <> ses then
adam@16 83 error <xml>Session has changed suspiciously</xml>
adam@16 84 else
adam@16 85 invalid <- oneRowE1 (SELECT COUNT( * ) = 0
adam@16 86 FROM session
adam@16 87 WHERE session.Id = {[login.Session]}
adam@16 88 AND session.Key = {[login.Key]});
adam@16 89 if invalid then
adam@16 90 error <xml>Invalid or expired session</xml>
adam@16 91 else
adam@16 92 dml (UPDATE session
adam@16 93 SET Identifier = {[Some ident]}
adam@16 94 WHERE Key = {[login.Key]});
adam@16 95 redirect (bless after)
adam@16 96
adam@16 97 fun newSession () =
adam@16 98 ses <- nextval sessionIds;
adam@16 99 now <- now;
adam@16 100 key <- rand;
adam@16 101 dml (INSERT INTO session (Id, Key, Identifier, Expires)
adam@16 102 VALUES ({[ses]}, {[key]}, NULL, {[addSeconds now M.sessionLifetime]}));
adam@16 103 return {Session = ses, Key = key}
adam@16 104
adam@16 105 fun logon r =
adam@16 106 ident <- oneOrNoRowsE1 (SELECT (identity.Identifier)
adam@16 107 FROM identity
adam@16 108 WHERE identity.User = {[r.User]}
adam@16 109 LIMIT 1);
adam@16 110 case ident of
adam@16 111 None => error <xml>Username not found</xml>
adam@16 112 | Some ident =>
adam@16 113 ses <- newSession ();
adam@16 114 setCookie login {Value = r ++ ses,
adam@16 115 Expires = None,
adam@16 116 Secure = M.secureCookies};
adam@16 117 after <- currentUrl;
adam@16 118 after <- return (show after);
adam@16 119 ses <- return ses.Session;
adam@16 120 msg <- Openid.authenticate (opCallback after ses)
adam@16 121 {Association = M.association,
adam@16 122 Realm = M.realm,
adam@16 123 Identifier = ident};
adam@16 124 error <xml>Login with your identity provider failed: {[msg]}</xml>
adam@16 125
adam@16 126 fun doSignup after r =
adam@16 127 ses <- newSession ();
adam@16 128 setCookie signingUp {Value = ses,
adam@16 129 Expires = None,
adam@16 130 Secure = M.secureCookies};
adam@16 131 ses <- return ses.Session;
adam@16 132 msg <- Openid.authenticate (opCallback after ses)
adam@16 133 {Association = M.association,
adam@16 134 Realm = M.realm,
adam@16 135 Identifier = r.Identifier};
adam@16 136 error <xml>Login with your identity provider failed: {[msg]}</xml>
adam@16 137
adam@16 138 fun signup () =
adam@16 139 after <- currentUrl;
adam@16 140 wrap "Account Signup" <xml>
adam@16 141 <form>
adam@16 142 OpenID Identifier: <textbox{#Identifier}/><br/>
adam@16 143 <submit value="Sign Up" action={doSignup (show after)}/>
adam@16 144 </form>
adam@16 145 </xml>
adam@16 146 in
adam@16 147 cur <- current;
adam@16 148 case cur of
adam@16 149 Some cur => return <xml>Logged in as {[cur]}. <a link={logout ()}>[Log out]</a></xml>
adam@16 150 | None => return <xml>
adam@16 151 <form><textbox{#User}/> <submit value="Log In" action={logon}/></form>
adam@16 152 <a link={signup ()}>Sign up</a>
adam@16 153 </xml>
adam@16 154 end
adam@16 155
adam@16 156 task periodic 60 = fn () => dml (DELETE FROM session
adam@16 157 WHERE Expires >= CURRENT_TIMESTAMP)
adam@16 158
adam@16 159 end