From 8d82e370518cb6d936682c6550d0c0bf0b0e0b35 Mon Sep 17 00:00:00 2001
From: rich <rich>
Date: Fri, 24 Sep 2004 16:41:16 +0000
Subject: [PATCH] Mailing list sub/unsub with double opt-in.

---
 MANIFEST                            |  6 +++
 conf/cocanwiki.conf                 |  4 +-
 scripts/Makefile                    |  6 ++-
 scripts/mailing_list_confirm.ml     | 61 +++++++++++++++++++++++
 scripts/mailing_list_form.ml        | 36 ++++++++++++++
 scripts/mailing_list_send.ml        | 98 +++++++++++++++++++++++++++++++++++++
 scripts/mailing_list_unsubscribe.ml | 46 +++++++++++++++++
 templates/mailing_list_form.html    | 65 ++++++++++++++++++++++++
 templates/mailing_list_send.txt     | 17 +++++++
 9 files changed, 337 insertions(+), 2 deletions(-)
 create mode 100644 scripts/mailing_list_confirm.ml
 create mode 100644 scripts/mailing_list_form.ml
 create mode 100644 scripts/mailing_list_send.ml
 create mode 100644 scripts/mailing_list_unsubscribe.ml
 create mode 100644 templates/mailing_list_form.html
 create mode 100644 templates/mailing_list_send.txt

diff --git a/MANIFEST b/MANIFEST
index bc72253..ab45561 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -106,6 +106,10 @@ scripts/largest_pages.ml
 scripts/login.ml
 scripts/login_form.ml
 scripts/logout.ml
+scripts/mailing_list_confirm.ml
+scripts/mailing_list_form.ml
+scripts/mailing_list_send.ml
+scripts/mailing_list_unsubscribe.ml
 scripts/page.ml
 scripts/page_email_confirm.ml
 scripts/page_email_form.ml
@@ -171,6 +175,8 @@ templates/host_menu.html
 templates/images.html
 templates/largest_pages.html
 templates/login_form.html
+templates/mailing_list_form.html
+templates/mailing_list_send.txt
 templates/ok_error.html
 templates/page.html
 templates/page_404.html
diff --git a/conf/cocanwiki.conf b/conf/cocanwiki.conf
index 43b884e..17e2b18 100644
--- a/conf/cocanwiki.conf
+++ b/conf/cocanwiki.conf
@@ -1,5 +1,5 @@
 # Apache configuration for COCANWIKI.
-# $Id: cocanwiki.conf,v 1.8 2004/09/24 15:53:57 rich Exp $
+# $Id: cocanwiki.conf,v 1.9 2004/09/24 16:41:16 rich Exp $
 
 # Uncomment the following lines if necessary.  You will probably need
 # to adjust the paths to reflect where cocanwiki is really installed.
@@ -54,6 +54,8 @@ RewriteRule ^/_global.css$ /_bin/hoststyle.cmo [PT,L,QSA]
 RewriteRule ^/_images$ /_bin/images.cmo [PT,L,QSA]
 RewriteRule ^/_login$ /_bin/login_form.cmo [PT,L]
 RewriteRule ^/_logout$ /_bin/logout.cmo [PT,L,QSA]
+RewriteRule ^/_ml_confirm$ /_bin/mailing_list_confirm.cmo [PT,L,QSA]
+RewriteRule ^/_ml_unsub$ /_bin/mailing_list_unsubscribe.cmo [PT,L,QSA]
 RewriteRule ^/_pe_confirm$ /_bin/page_email_confirm.cmo [PT,L,QSA]
 RewriteRule ^/_pe_unsub$ /_bin/page_email_unsubscribe.cmo [PT,L,QSA]
 RewriteRule ^/_recent$ /_bin/recent.cmo [PT,L,QSA]
diff --git a/scripts/Makefile b/scripts/Makefile
index 2d1f5b1..d8529ef 100644
--- a/scripts/Makefile
+++ b/scripts/Makefile
@@ -1,5 +1,5 @@
 # Makefile for COCANWIKI.
-# $Id: Makefile,v 1.23 2004/09/24 15:53:57 rich Exp $
+# $Id: Makefile,v 1.24 2004/09/24 16:41:16 rich Exp $
 
 include ../Makefile.config
 
@@ -67,6 +67,10 @@ OBJS := 00-TEMPLATE.cmo \
 	login.cmo \
 	login_form.cmo \
 	logout.cmo \
+	mailing_list_confirm.cmo \
+	mailing_list_form.cmo \
+	mailing_list_send.cmo \
+	mailing_list_unsubscribe.cmo \
 	page.cmo \
 	page_email_confirm.cmo \
 	page_email_form.cmo \
diff --git a/scripts/mailing_list_confirm.ml b/scripts/mailing_list_confirm.ml
new file mode 100644
index 0000000..2f8ff0c
--- /dev/null
+++ b/scripts/mailing_list_confirm.ml
@@ -0,0 +1,61 @@
+(* COCANWIKI - a wiki written in Objective CAML.
+ * Written by Richard W.M. Jones <rich@merjis.com>.
+ * Copyright (C) 2004 Merjis Ltd.
+ * $Id: mailing_list_confirm.ml,v 1.1 2004/09/24 16:41:16 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
+
+let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+  let pending = q#param "p" in
+
+  (* Get the relevant fields from the database. *)
+  let sth = dbh#prepare_cached "select email from mailing_lists
+                                 where hostid = ? and pending = ?" in
+  sth#execute [`Int hostid; `String pending];
+
+  let page =
+    try
+      sth#fetch1string ()
+    with
+	Not_found ->
+	  error ~close_button:true ~title:"Email already confirmed"
+	    q "It looks like that email address has already been confirmed.";
+	  return () in
+
+  (* Update the database. *)
+  let sth = dbh#prepare_cached "update mailing_lists set pending = null
+                                 where hostid = ? and pending = ?" in
+  sth#execute [`Int hostid; `String pending];
+
+  dbh#commit ();
+
+  (* Confirmed. *)
+  let buttons = [ ok_button ("/" ^ page) ] in
+  ok ~buttons ~title:"Confirmed"
+    q ("Your email address has been confirmed.  " ^
+       "You are now on our mailing list.")
+
+let () =
+  register_script run
diff --git a/scripts/mailing_list_form.ml b/scripts/mailing_list_form.ml
new file mode 100644
index 0000000..041c451
--- /dev/null
+++ b/scripts/mailing_list_form.ml
@@ -0,0 +1,36 @@
+(* COCANWIKI - a wiki written in Objective CAML.
+ * Written by Richard W.M. Jones <rich@merjis.com>.
+ * Copyright (C) 2004 Merjis Ltd.
+ * $Id: mailing_list_form.ml,v 1.1 2004/09/24 16:41:16 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_template
+
+let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+  let template = get_template dbh hostid "mailing_list_form.html" in
+
+  q#template template
+
+let () =
+  register_script run
diff --git a/scripts/mailing_list_send.ml b/scripts/mailing_list_send.ml
new file mode 100644
index 0000000..ce239cc
--- /dev/null
+++ b/scripts/mailing_list_send.ml
@@ -0,0 +1,98 @@
+(* COCANWIKI - a wiki written in Objective CAML.
+ * Written by Richard W.M. Jones <rich@merjis.com>.
+ * Copyright (C) 2004 Merjis Ltd.
+ * $Id: mailing_list_send.ml,v 1.1 2004/09/24 16:41:16 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 } _ =
+  let template = get_template dbh hostid "mailing_list_send.txt" in
+
+  let email = trim (q#param "email") in
+
+  if email = "" then (
+    error ~title:"No email address" ~back_button:true
+      q "You must give an email address.";
+    return ()
+  );
+
+  (* Good a place as any to delete old, unconfirmed emails. *)
+  let sth = dbh#prepare_cached "delete from mailing_lists
+                                 where pending is not null
+                                   and entry_date < current_date - 7" in
+  sth#execute [];
+  dbh#commit ();
+
+  (* Is that email address already registered in the database? *)
+  let sth = dbh#prepare_cached "select 1 from mailing_lists where hostid = ?
+                                  and email = ?" in
+  sth#execute [`Int hostid; `String email];
+
+  let registered = try sth#fetch1int () = 1 with Not_found -> false in
+
+  if registered then (
+    error ~title:"Email address already used" ~back_button:true
+      q
+      ("That email address is already on our mailing list. "^
+       "If you are not receiving mailing list messages, then you will " ^
+       "need to confirm that address. If you continue to have problems " ^
+       "please contact the site administrator.");
+    return ()
+  );
+
+  (* Create the unique pending and opt_out fields.  The pending field
+   * allows the user to register.  The opt_out field allows the user
+   * to unsubscribe.
+   *)
+  let pending = random_sessionid () in
+  let opt_out = random_sessionid () in
+
+  (* Insert into the database. *)
+  let sth = dbh#prepare_cached "insert into mailing_lists (hostid, email,
+                                  pending, opt_out) values (?, ?, ?, ?)" in
+  sth#execute [`Int hostid; `String email; `String pending; `String opt_out];
+
+  dbh#commit ();
+
+  (* Send the initial email to the user. *)
+  template#set "hostname" hostname;
+  template#set "pending" pending;
+  template#set "opt_out" opt_out;
+
+  let body = template#to_string in
+  let subject = "Site notice: " ^ hostname ^ ": Confirm your email address" in
+  Sendmail.send_mail ~subject ~body ~to_addr:[email] ();
+
+  (* Finish up. *)
+  let buttons = [ ok_button ("/" ^ page) ] in
+  ok ~buttons ~title:"Confirmation email sent"
+    q ("Please check your email now.  You have been sent a confirmation " ^
+       "email so we can verify the email address is yours.  Click on the " ^
+       "first link in that email to confirm.")
+
+let () =
+  register_script run
diff --git a/scripts/mailing_list_unsubscribe.ml b/scripts/mailing_list_unsubscribe.ml
new file mode 100644
index 0000000..d2b1328
--- /dev/null
+++ b/scripts/mailing_list_unsubscribe.ml
@@ -0,0 +1,46 @@
+(* COCANWIKI - a wiki written in Objective CAML.
+ * Written by Richard W.M. Jones <rich@merjis.com>.
+ * Copyright (C) 2004 Merjis Ltd.
+ * $Id: mailing_list_unsubscribe.ml,v 1.1 2004/09/24 16:41:16 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
+
+let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
+  let opt_out = q#param "o" in
+
+  (* Update the database. *)
+  let sth = dbh#prepare_cached "delete from mailing_lists
+                                 where hostid = ? and opt_out = ?" in
+  sth#execute [`Int hostid; `String opt_out];
+
+  dbh#commit ();
+
+  (* Confirmed. *)
+  let buttons = [ ok_button "/" ] in
+  ok ~buttons ~title:"Unsubscribed"
+    q "Your email address has been unsubscribed."
+
+let () =
+  register_script run
diff --git a/templates/mailing_list_form.html b/templates/mailing_list_form.html
new file mode 100644
index 0000000..bda294c
--- /dev/null
+++ b/templates/mailing_list_form.html
@@ -0,0 +1,65 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
+<head>
+<title>Join our mailing list</title>
+<meta name="robots" content="noindex,nofollow"/>
+<meta name="author" content="http://www.merjis.com/" />
+<link rel="stylesheet" href="::theme_css_html_tag::" type="text/css" title="Standard"/>
+</head><body>
+
+<h1>Join our mailing list</h1>
+
+<p>
+Please fill in this form to join our mailing list.
+</p>
+
+<form method="post" action="/_bin/mailing_list_send.cmo">
+<table class="left_table">
+<tr>
+<th> Email address: </th>
+<td> <input name="email" value="" size="50" /> </td>
+</tr>
+<tr>
+<td></td>
+<td> <input type="submit" value="   Send   " /> </td>
+</tr>
+</table>
+</form>
+
+<h2>Notes</h2>
+
+<ol>
+<li> You will be sent an initial email so that we can confirm
+  that the email address is yours. </li>
+<li> <strong>You can unsubscribe at any time.</strong>  Just click on the link
+  which will be sent to you in the initial email or in each
+  update email you receive. </li>
+</ol>
+
+
+<ul id="topmenu" class="menu">
+<li class="first"> <a href="/">Home&nbsp;page</a> </li>
+<li> <a href="/_sitemap">Sitemap</a> </li>
+<li> <a href="/_recent">Recent&nbsp;changes</a> </li>
+</ul>
+
+<div id="menu_div">
+<ul id="bottommenu" class="menu">
+<li class="first"> <a href="/">Home&nbsp;page</a> </li>
+::table(sitemenu)::<li> <a href="/::url_html_tag::">::label_html::</a> </li>
+::end::
+<li> <a href="/_sitemap">Sitemap</a> </li>
+</ul>
+</div>
+
+<div id="footer_div">
+<hr/>
+
+<ul id="footer" class="menu">
+<li class="first"> <a href="/copyright">Copyright &copy; ::year::</a> </li>
+<li> Powered by <a href="http://sandbox.merjis.com/">::cocanwiki_package_html:: ::cocanwiki_version_html::</a> </li>
+</ul>
+</div>
+
+</body>
+</html>
\ No newline at end of file
diff --git a/templates/mailing_list_send.txt b/templates/mailing_list_send.txt
new file mode 100644
index 0000000..f3213cb
--- /dev/null
+++ b/templates/mailing_list_send.txt
@@ -0,0 +1,17 @@
+Someone, possibly you, requested to join the mailing list at
+::hostname::.
+
+To CONFIRM this, please click on the following link.
+
+http://::hostname::/_ml_confirm?p=::pending::
+
+(Note: DO NOT REPLY TO THIS EMAIL!)
+
+----------------------------------------------------------------------
+
+Please keep this email for your records.
+
+In future you can UNSUBSCRIBE from further emails at any time by
+clicking on the following link:
+
+http://::hostname::/_ml_unsub?o=::opt_out::
-- 
1.8.3.1