X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=scripts%2Flogin.ml;h=e316d64a82d4668e186f4bcdcf0d4fda55af8729;hb=79f907772aef608a83338589f64c10a901889b5c;hp=01d325cef3bd67f7fe5563e05cd63d06f9dbb12a;hpb=c22e34dd58cdc2a79b71dedd3c52ed705c9b8b51;p=cocanwiki.git diff --git a/scripts/login.ml b/scripts/login.ml index 01d325c..e316d64 100644 --- a/scripts/login.ml +++ b/scripts/login.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: login.ml,v 1.3 2004/09/09 12:21:22 rich Exp $ + * $Id: login.ml,v 1.4 2004/09/25 13:17:00 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -35,13 +35,17 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = let permanent = try "1" = q#param "permanent" with Not_found -> false in let redirect = try q#param "redirect" with Not_found -> "/" in - let sth = dbh#prepare_cached "select id from users + let sth = dbh#prepare_cached "select id, force_password_change from users where name = ? and password = ? and hostid = ?" in sth#execute [`String username; `String password; `Int hostid]; try - let userid = sth#fetch1int () in + let userid, force_password_change = + match sth#fetch1 () with + [ `Int userid; `Bool force_password_change ] -> + userid, force_password_change + | _ -> assert false in (* Create a cookie. *) let cookie = random_sessionid () in @@ -51,6 +55,11 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = dbh#commit (); + (* Force password change? *) + let redirect = + if force_password_change then "/_bin/change_password_form.cmo" + else redirect in + let cookie = if permanent then Cookie.cookie ~name:"auth" ~value:cookie ~path:"/" ~expires () @@ -58,7 +67,9 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = Cookie.cookie ~name:"auth" ~value:cookie ~path:"/" () in ok ~title:"Logged in" ~buttons:[ok_button redirect] ~cookie - q ("Welcome back " ^ username ^ ".") + q ("Welcome back " ^ username ^ "." ^ + if force_password_change then " Please change your password now." + else "") with Not_found -> error