adam@16: functor Make(M: sig adam@16: con cols :: {Type} adam@16: constraint [Id] ~ cols adam@16: adam@16: val sessionLifetime : int adam@16: val afterLogout : url adam@16: val secureCookies : bool adam@16: val association : Openid.association_mode adam@16: val realm : option string adam@16: end) = struct adam@16: adam@16: type user = string adam@16: val show_user = _ adam@16: val inj_user = _ adam@16: adam@16: table user : ([Id = user] ++ M.cols) adam@16: PRIMARY KEY Id adam@16: adam@16: table identity : {User : user, Identifier : string} adam@16: PRIMARY KEY (User, Identifier) adam@16: adam@16: sequence sessionIds adam@16: adam@16: table session : {Id : int, Key : int, Identifier : option string, Expires : time} adam@16: PRIMARY KEY Id adam@16: adam@16: cookie signingUp : {Session : int, Key : int} adam@16: cookie login : {User : user, Session : int, Key : int} adam@16: adam@16: val current = adam@16: login <- getCookie login; adam@16: case login of adam@16: None => return None adam@16: | Some login => adam@16: ident <- oneOrNoRowsE1 (SELECT (session.Identifier) adam@16: FROM session adam@16: WHERE session.Id = {[login.Session]} adam@16: AND session.Key = {[login.Key]}); adam@16: case ident of adam@16: None => error Invalid or expired session adam@16: | Some None => return None adam@16: | Some (Some ident) => adam@16: valid <- oneRowE1 (SELECT COUNT( * ) > 0 adam@16: FROM identity adam@16: WHERE identity.User = {[login.User]} adam@16: AND identity.Identifier = {[ident]}); adam@16: if valid then adam@16: return (Some login.User) adam@16: else adam@16: error Session not authorized to act as user adam@16: adam@16: fun main wrap = adam@16: let adam@16: fun logout () = adam@16: clearCookie login; adam@16: redirect M.afterLogout adam@16: adam@16: fun opCallback after ses res = adam@16: case res of adam@16: Openid.Canceled => error You canceled the login process. adam@16: | Openid.Failure s => error Login failed: {[s]} adam@16: | Openid.AuthenticatedAs ident => adam@16: signup <- getCookie signingUp; adam@16: case signup of adam@16: Some signup => adam@16: if signup.Session <> ses then adam@16: error Session has changed suspiciously adam@16: else adam@16: invalid <- oneRowE1 (SELECT COUNT( * ) = 0 adam@16: FROM session adam@16: WHERE session.Id = {[signup.Session]} adam@16: AND session.Key = {[signup.Key]}); adam@16: if invalid then adam@16: error Invalid or expired session adam@16: else adam@16: return I now believe that you are {[ident]}. adam@16: | None => adam@16: login <- getCookie login; adam@16: case login of adam@16: None => error Missing session cookie adam@16: | Some login => adam@16: if login.Session <> ses then adam@16: error Session has changed suspiciously adam@16: else adam@16: invalid <- oneRowE1 (SELECT COUNT( * ) = 0 adam@16: FROM session adam@16: WHERE session.Id = {[login.Session]} adam@16: AND session.Key = {[login.Key]}); adam@16: if invalid then adam@16: error Invalid or expired session adam@16: else adam@16: dml (UPDATE session adam@16: SET Identifier = {[Some ident]} adam@16: WHERE Key = {[login.Key]}); adam@16: redirect (bless after) adam@16: adam@16: fun newSession () = adam@16: ses <- nextval sessionIds; adam@16: now <- now; adam@16: key <- rand; adam@16: dml (INSERT INTO session (Id, Key, Identifier, Expires) adam@16: VALUES ({[ses]}, {[key]}, NULL, {[addSeconds now M.sessionLifetime]})); adam@16: return {Session = ses, Key = key} adam@16: adam@16: fun logon r = adam@16: ident <- oneOrNoRowsE1 (SELECT (identity.Identifier) adam@16: FROM identity adam@16: WHERE identity.User = {[r.User]} adam@16: LIMIT 1); adam@16: case ident of adam@16: None => error Username not found adam@16: | Some ident => adam@16: ses <- newSession (); adam@16: setCookie login {Value = r ++ ses, adam@16: Expires = None, adam@16: Secure = M.secureCookies}; adam@16: after <- currentUrl; adam@16: after <- return (show after); adam@16: ses <- return ses.Session; adam@16: msg <- Openid.authenticate (opCallback after ses) adam@16: {Association = M.association, adam@16: Realm = M.realm, adam@16: Identifier = ident}; adam@16: error Login with your identity provider failed: {[msg]} adam@16: adam@16: fun doSignup after r = adam@16: ses <- newSession (); adam@16: setCookie signingUp {Value = ses, adam@16: Expires = None, adam@16: Secure = M.secureCookies}; adam@16: ses <- return ses.Session; adam@16: msg <- Openid.authenticate (opCallback after ses) adam@16: {Association = M.association, adam@16: Realm = M.realm, adam@16: Identifier = r.Identifier}; adam@16: error Login with your identity provider failed: {[msg]} adam@16: adam@16: fun signup () = adam@16: after <- currentUrl; adam@16: wrap "Account Signup" adam@16:
adam@16: OpenID Identifier:
adam@16: adam@16: adam@16:
adam@16: in adam@16: cur <- current; adam@16: case cur of adam@16: Some cur => return Logged in as {[cur]}. [Log out] adam@16: | None => return adam@16:
adam@16: Sign up adam@16:
adam@16: end adam@16: adam@16: task periodic 60 = fn () => dml (DELETE FROM session adam@16: WHERE Expires >= CURRENT_TIMESTAMP) adam@16: adam@16: end