--- /dev/null
+(* COCANWIKI - a wiki written in Objective CAML.
+ * Written by Richard W.M. Jones <rich@merjis.com>.
+ * Copyright (C) 2004 Merjis Ltd.
+ * $Id: contact.ml,v 1.1 2004/09/17 12:35:38 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 "contact.txt" in
+
+ let fail msg =
+ error ~back_button:true ~title:"Bad form"
+ q (msg ^ " Please contact the owner of the site by email.");
+ raise CgiExit
+ in
+
+ (* Get the id field. *)
+ let id =
+ try int_of_string (q#param "id")
+ with
+ Not_found -> fail "The 'id' field is missing in that form."
+ | Failure "int_of_string" ->
+ fail "The 'id' field in that form is not a number." in
+
+ (* Get the contacts / emails from the database. *)
+ let sth = dbh#prepare_cached "select subject from contacts
+ where hostid = ? and id = ?" in
+ sth#execute [`Int hostid; `Int id];
+
+ let subject =
+ try sth#fetch1string ()
+ with Not_found -> fail "There is no such contact id in the database." in
+
+ let sth = dbh#prepare_cached "select email from contact_emails
+ where contactid = ?" in
+ sth#execute [`Int id];
+
+ let emails = sth#map (function [`String email] -> email
+ | _ -> assert false) in
+
+ if emails = [] then
+ fail "There are no email addresses associated with that contact id.";
+
+ (* Now process the strings passed as parameters to the script. Any
+ * parameter which starts with 'file' (eg. 'file0') is treated as a
+ * file upload automatically.
+ *)
+ let names = List.map fst q#params in
+ let names, uploads =
+ if q#is_multipart then (
+ let uploads =
+ List.filter (fun str -> String.starts_with str "file") names in
+ let names =
+ List.filter (fun str -> str <> "id" &&
+ not (String.starts_with str "file")) names in
+ names, uploads
+ ) else
+ names, [] in
+
+ (* Sort them.
+ * Ignore repeat parameters. - Don't use these in forms.
+ *)
+ let rec uniq = function
+ [] -> []
+ | [x] -> [x]
+ | x :: y :: xs when compare x y = 0 -> uniq (x :: xs)
+ | x :: y :: xs -> x :: uniq (y :: xs)
+ in
+
+ let names = uniq (List.sort compare names) in
+ let uploads = uniq (List.sort compare uploads) in
+
+ (* 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;
+
+ (* Construct the table of names, values for the initial email. *)
+ let table = List.map (fun name ->
+ let value = q#param name in
+ [ "name", Template.VarString name;
+ "value", Template.VarString value ]) names in
+ template#table "names" table;
+
+ (* Any uploads to follow? *)
+ template#conditional "uploads" (uploads <> []);
+ template#set "nr_uploads" (string_of_int (List.length uploads));
+
+ (* Send the initial email. *)
+ let body = template#to_string in
+ Sendmail.send_mail ~subject ~to_addr:emails ~body ();
+
+ (* Send the following uploads by email. *)
+ List.iter (fun name ->
+ let upload = q#upload name in
+ let subject = upload.upload_filename in
+ (* XXX This is insecure. *)
+ let content_type = upload.upload_content_type in
+ let body = upload.upload_value in
+
+ Sendmail.send_mail ~subject ~to_addr:emails ~content_type
+ ~body ())
+ uploads;
+
+ (* Confirm. *)
+ ok ~title:"Thank you for your contact" ~buttons:[ok_button "/"]
+ q "An email was sent and you should receive a reply shortly."
+
+let () =
+ register_script run
git.annexia.org / cocanwiki.git / commitdiff