Mercurial > openid

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