(* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. * $Id: user_prefs.ml,v 1.5 2005/03/31 14:24:04 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 * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; see the file COPYING. If not, write to * the Free Software Foundation, Inc., 59 Temple Place - Suite 330, * Boston, MA 02111-1307, USA. *) open Apache open Registry open Cgi open Printf open Cocanwiki open Cocanwiki_ok open Cocanwiki_template open Cocanwiki_strings let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname=hostname} user = let email_change_template = _get_template "user_prefs_email_change.txt" in (* Get the fields. *) let new_email = trim (q#param "email") in let email_notify = q#param_true "email_notify" in let userid = match user with Anonymous -> assert false | User (userid, _, _, _) -> userid in (* Update the preferences fields. *) let sth = dbh#prepare_cached "update users set email_notify = ? where hostid = ? and id = ?" in sth#execute [`Bool email_notify; `Int hostid; `Int userid]; (* Have we changed the email address? *) let confirm_needed = if new_email = "" then ( (* Set the email field in the database to null. No need for * any confirmation. *) let sth = dbh#prepare_cached "update users set email = null where hostid = ? and id = ?" in sth#execute [`Int hostid; `Int userid]; false ) else ( (* Is the new email address different from the one currently recorded * in the database? *) let sth = dbh#prepare_cached "select ? <> coalesce (email, '') from users where hostid = ? and id = ?" in sth#execute [`String new_email; `Int hostid; `Int userid]; let changed = match sth#fetch1 () with [ `Bool b ] -> b | _ -> assert false in if changed then ( let key = random_sessionid () in (* Changed, so we add to the pending_email_changes table. *) let sth = dbh#prepare_cached "insert into pending_email_changes (key, userid, email) values (?, ?, ?)" in sth#execute [`String key; `Int userid; `String new_email]; (* Send the confirm email. *) email_change_template#set "hostname" hostname; email_change_template#set "key" key; let body = email_change_template#to_string in let subject = "Please verify your new email address at " ^ hostname in Sendmail.send_mail ~subject ~to_addr:[new_email] body ); changed ) in (* Good place to remove old rows in the pending_email_changes table. *) let sth = dbh#prepare_cached "delete from pending_email_changes where change_date - current_date > 7" in sth#execute []; (* Commit and finish off. *) dbh#commit (); let buttons = [ ok_button "/_userprefs" ] in ok ~title:"Preferences updated" ~buttons q ("Your user preferences were updated. " ^ if confirm_needed then ("Because you changed your email address, we have sent a " ^ "confirmation email to your new address. You will need to " ^ "click on the link in that email to verify your new address.") else "") let () = register_script ~anonymous:false run