From 3e686452bc8b27781edb06b68749f7c34bf5fab4 Mon Sep 17 00:00:00 2001 From: rich Date: Fri, 17 Sep 2004 12:35:36 +0000 Subject: [PATCH] Basic contact form implemented (no user interface for it yet, however). Updated MANIFEST. --- MANIFEST | 2 + Makefile | 4 +- conf/cocanwiki.conf | 3 +- scripts/Makefile | 3 +- scripts/contact.ml | 152 ++++++++++++++++++++++++++++++++++++++++++++++++++ templates/contact.txt | 24 ++++++++ 6 files changed, 184 insertions(+), 4 deletions(-) create mode 100644 scripts/contact.ml create mode 100644 templates/contact.txt diff --git a/MANIFEST b/MANIFEST index 8e9fbcf..15a5d35 100644 --- a/MANIFEST +++ b/MANIFEST @@ -60,6 +60,7 @@ scripts/cocanwiki_strings.ml scripts/cocanwiki_template.ml scripts/cocanwiki_template.mli scripts/cocanwiki_version.ml.in +scripts/contact.ml scripts/create.ml scripts/create_form.ml scripts/delete_file.ml @@ -111,6 +112,7 @@ templates/admin/edit_emails_form.html templates/admin/edit_host_css_form.html templates/admin/edit_hostnames_form.html templates/admin/host.html +templates/contact.txt templates/create_form.html templates/delete_file_form.html templates/delete_image_form.html diff --git a/Makefile b/Makefile index 52bf088..b6c340e 100644 --- a/Makefile +++ b/Makefile @@ -1,4 +1,4 @@ -# $Id: Makefile,v 1.5 2004/09/15 09:32:09 rich Exp $ +# $Id: Makefile,v 1.6 2004/09/17 12:35:37 rich Exp $ include Makefile.config @@ -38,7 +38,7 @@ pkg-install: install -m 0644 html/_graphics/*.png $(DESTDIR)$(WIKIINSTALLDIR)/html/_graphics install -m 0644 html/_js/*.js $(DESTDIR)$(WIKIINSTALLDIR)/html/_js install -m 0644 html/_static/*.html $(DESTDIR)$(WIKIINSTALLDIR)/html/_static - install -m 0644 templates/*.html $(DESTDIR)$(WIKIINSTALLDIR)/templates + install -m 0644 templates/*.html templates/*.txt $(DESTDIR)$(WIKIINSTALLDIR)/templates install -m 0644 templates/admin/*.html $(DESTDIR)$(WIKIINSTALLDIR)/templates/admin clean: diff --git a/conf/cocanwiki.conf b/conf/cocanwiki.conf index 2400d27..4391c39 100644 --- a/conf/cocanwiki.conf +++ b/conf/cocanwiki.conf @@ -1,5 +1,5 @@ # Apache configuration for COCANWIKI. -# $Id: cocanwiki.conf,v 1.3 2004/09/08 12:45:37 rich Exp $ +# $Id: cocanwiki.conf,v 1.4 2004/09/17 12:35:37 rich Exp $ # Uncomment the following lines if necessary. You will probably need # to adjust the paths to reflect where cocanwiki is really installed. @@ -48,6 +48,7 @@ RewriteRule ^/robots.txt /robots.txt [PT,L] # Global scripts. RewriteRule ^/_admin$ /_bin/admin/admin.cmo [PT,L,QSA] +RewriteRule ^/_contact$ /_bin/contact.cmo [PT,L,QSA] RewriteRule ^/_files$ /_bin/files.cmo [PT,L,QSA] RewriteRule ^/_global.css$ /_bin/hoststyle.cmo [PT,L,QSA] RewriteRule ^/_images$ /_bin/images.cmo [PT,L,QSA] diff --git a/scripts/Makefile b/scripts/Makefile index 3d87b3f..ec9ebb5 100644 --- a/scripts/Makefile +++ b/scripts/Makefile @@ -1,5 +1,5 @@ # Makefile for COCANWIKI. -# $Id: Makefile,v 1.10 2004/09/08 17:07:24 rich Exp $ +# $Id: Makefile,v 1.11 2004/09/17 12:35:38 rich Exp $ include ../Makefile.config @@ -22,6 +22,7 @@ LIB_OBJS := \ cgi_expires.cmo OBJS := 00-TEMPLATE.cmo \ + contact.cmo \ create.cmo \ create_form.cmo \ delete_file.cmo \ diff --git a/scripts/contact.ml b/scripts/contact.ml new file mode 100644 index 0000000..753f695 --- /dev/null +++ b/scripts/contact.ml @@ -0,0 +1,152 @@ +(* COCANWIKI - a wiki written in Objective CAML. + * Written by Richard W.M. Jones . + * 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 diff --git a/templates/contact.txt b/templates/contact.txt new file mode 100644 index 0000000..aa89dc1 --- /dev/null +++ b/templates/contact.txt @@ -0,0 +1,24 @@ +This is an automatically generated message from the contact form at +::hostname::. Someone has filled out this form and sent it to you +below. + +---------------------------------------------------------------------- +::table(names):: + ::name::: + ::value:: +::end:: +---------------------------------------------------------------------- +::if(uploads):: +The user also uploaded ::nr_uploads:: file(s). These will follow +in subsequent messages. + +IMPORTANT: Please note that uploaded files have not been virus-checked +in any way. If you are using Windows, you should run the files +through a virus checker before opening them. +::end:: + +LOGGING INFORMATION: + +IP address: ::ip:: +Username: ::username:: +User-Agent: ::ua:: -- 1.8.3.1