(* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. * $Id: send_feedback.ml,v 1.3 2004/10/04 15:19:56 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 ExtString open Cocanwiki open Cocanwiki_template open Cocanwiki_ok let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = let template = get_template dbh hostid "send_feedback.txt" in if q#param_true "cancel" then ( (* Request cancelled. *) q#redirect ("http://" ^ hostname); return () ); (* Get the feedback email for this host. *) let sth = dbh#prepare_cached "select feedback_email from hosts where id = ?" in sth#execute [`Int hostid]; let to_addr = sth#fetch1string () in (* Get the fields. *) let page = q#param "page" in let name = q#param "name" in let email = q#param "email" in let feedback = q#param "feedback" in template#set "page" page; template#set "name" name; template#set "email" email; template#set "feedback" feedback; (* Get the IP address for logging purposes. *) let ip = try Connection.remote_ip (Request.connection r) with Not_found -> "" in (* Get the User-Agent string. Consider in future rejecting spammers * who don't set User-Agent. *) let ua = try Table.get (Request.headers_in r) "User-Agent" with Not_found -> "" in (* Get the user details, if any. *) let username = match user with Anonymous -> "anonymous" | User (userid, username, _) -> sprintf "%s (%d)" username userid in template#set "ip" ip; template#set "ua" ua; template#set "username" username; template#set "hostname" hostname; (* Send the feedback email. *) let subject = "Wiki feedback: Feedback about " ^ page ^ " page" in let body = template#to_string in Sendmail.send_mail ~subject ~to_addr:[to_addr] ~body (); (* Confirm. *) ok ~title:"Thank you for your feedback" ~buttons:[ok_button "/"] q "An email has been sent to the site administrators." let () = register_script ~restrict:[CanView] run