1 (* Easy Web Pages (EWP) scripts.
2 * Written by Richard W.M. Jones <rich@merjis.com>.
3 * Copyright (C) 2004 Merjis Ltd.
4 * $Id: login.ml,v 1.1 2004/09/07 16:19:43 rich Exp $
15 let expires = "Wed, 18-May-2033 04:33:20 GMT"
17 let run r (q : cgi) (dbh : Dbi.connection) (hostid, _, _) _ =
18 let username = q#param "username" in
19 let password = q#param "password" in
20 let permanent = try "1" = q#param "permanent" with Not_found -> false in
21 let redirect = try q#param "redirect" with Not_found -> "/" in
23 let sth = dbh#prepare_cached "select id from users
24 where name = ? and password = ?
26 sth#execute [`String username; `String password; `Int hostid];
29 let userid = sth#fetch1int () in
31 (* Create a cookie. *)
32 let cookie = random_sessionid () in
33 let sth = dbh#prepare_cached "insert into usercookies (userid, cookie)
35 sth#execute [`Int userid; `String cookie];
41 Cookie.cookie ~name:"auth" ~value:cookie ~path:"/" ~expires ()
43 Cookie.cookie ~name:"auth" ~value:cookie ~path:"/" () in
45 ok ~title:"Logged in" ~buttons:[ok_button redirect] ~cookie
46 q ("Welcome back " ^ username ^ ".")
50 ~title:"Bad name or password"
52 q "The name or password was wrong."