From 4f0fd36c2c8422c051b955216f896eddcc557d1d Mon Sep 17 00:00:00 2001
From: rich <rich>
Date: Fri, 24 Sep 2004 15:53:57 +0000
Subject: [PATCH] Per-page email notification, with double opt-in/-out.

---
 MANIFEST                          |   7 ++
 cocanwiki.sql                     | 139 ++++++++++++++++++++++++++------------
 conf/cocanwiki.conf               |   4 +-
 scripts/Makefile                  |   6 +-
 scripts/cocanwiki_emailnotify.ml  |   4 +-
 scripts/edit.ml                   |  47 ++++++++++++-
 scripts/edit_page_css.ml          |   5 +-
 scripts/page_email_confirm.ml     |  63 +++++++++++++++++
 scripts/page_email_form.ml        |  47 +++++++++++++
 scripts/page_email_send.ml        | 101 +++++++++++++++++++++++++++
 scripts/page_email_unsubscribe.ml |  46 +++++++++++++
 scripts/restore.ml                |   5 +-
 templates/edit_page_email.txt     |  10 +++
 templates/page.html               |   1 +
 templates/page_email_form.html    |  71 +++++++++++++++++++
 templates/page_email_send.txt     |  17 +++++
 16 files changed, 520 insertions(+), 53 deletions(-)
 create mode 100644 scripts/page_email_confirm.ml
 create mode 100644 scripts/page_email_form.ml
 create mode 100644 scripts/page_email_send.ml
 create mode 100644 scripts/page_email_unsubscribe.ml
 create mode 100644 templates/edit_page_email.txt
 create mode 100644 templates/page_email_form.html
 create mode 100644 templates/page_email_send.txt

diff --git a/MANIFEST b/MANIFEST
index 0645dce..bc72253 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -107,6 +107,10 @@ scripts/login.ml
 scripts/login_form.ml
 scripts/logout.ml
 scripts/page.ml
+scripts/page_email_confirm.ml
+scripts/page_email_form.ml
+scripts/page_email_send.ml
+scripts/page_email_unsubscribe.ml
 scripts/pagestyle.ml
 scripts/preview.ml
 scripts/recent.ml
@@ -157,6 +161,7 @@ templates/edit_contact_form.html
 templates/edit_host_css_form.html
 templates/edit_host_settings_form.html
 templates/edit_page_css_form.html
+templates/edit_page_email.txt
 templates/edit_sitemenu.html
 templates/edit_user_form.html
 templates/files.html
@@ -169,6 +174,8 @@ templates/login_form.html
 templates/ok_error.html
 templates/page.html
 templates/page_404.html
+templates/page_email_form.html
+templates/page_email_send.txt
 templates/recent.html
 templates/restore_form.html
 templates/rss.xml
diff --git a/cocanwiki.sql b/cocanwiki.sql
index ca322a8..76811d1 100644
--- a/cocanwiki.sql
+++ b/cocanwiki.sql
@@ -54,7 +54,7 @@ GRANT ALL ON TABLE pages TO "www-data";
 SET SESSION AUTHORIZATION 'rich';
 
 --
--- TOC entry 34 (OID 536004)
+-- TOC entry 36 (OID 536004)
 -- Name: pages_id_seq; Type: ACL; Schema: public; Owner: rich
 --
 
@@ -91,7 +91,7 @@ GRANT ALL ON TABLE contents TO "www-data";
 SET SESSION AUTHORIZATION 'rich';
 
 --
--- TOC entry 35 (OID 536021)
+-- TOC entry 37 (OID 536021)
 -- Name: contents_id_seq; Type: ACL; Schema: public; Owner: rich
 --
 
@@ -129,7 +129,7 @@ GRANT ALL ON TABLE hosts TO "www-data";
 SET SESSION AUTHORIZATION 'rich';
 
 --
--- TOC entry 36 (OID 536371)
+-- TOC entry 38 (OID 536371)
 -- Name: hosts_id_seq; Type: ACL; Schema: public; Owner: rich
 --
 
@@ -222,7 +222,7 @@ GRANT ALL ON TABLE images TO "www-data";
 SET SESSION AUTHORIZATION 'rich';
 
 --
--- TOC entry 37 (OID 537151)
+-- TOC entry 39 (OID 537151)
 -- Name: images_id_seq; Type: ACL; Schema: public; Owner: rich
 --
 
@@ -261,7 +261,7 @@ GRANT ALL ON TABLE files TO "www-data";
 SET SESSION AUTHORIZATION 'rich';
 
 --
--- TOC entry 38 (OID 537166)
+-- TOC entry 40 (OID 537166)
 -- Name: files_id_seq; Type: ACL; Schema: public; Owner: rich
 --
 
@@ -303,7 +303,7 @@ GRANT ALL ON TABLE users TO "www-data";
 SET SESSION AUTHORIZATION 'rich';
 
 --
--- TOC entry 39 (OID 540816)
+-- TOC entry 41 (OID 540816)
 -- Name: users_id_seq; Type: ACL; Schema: public; Owner: rich
 --
 
@@ -384,7 +384,7 @@ GRANT ALL ON TABLE contacts TO "www-data";
 SET SESSION AUTHORIZATION 'rich';
 
 --
--- TOC entry 40 (OID 542605)
+-- TOC entry 42 (OID 542605)
 -- Name: contacts_id_seq; Type: ACL; Schema: public; Owner: rich
 --
 
@@ -462,7 +462,34 @@ GRANT SELECT ON TABLE server_settings TO "www-data";
 SET SESSION AUTHORIZATION 'rich';
 
 --
--- TOC entry 45 (OID 536388)
+-- TOC entry 34 (OID 543754)
+-- Name: page_emails; Type: TABLE; Schema: public; Owner: rich
+--
+
+CREATE TABLE page_emails (
+    hostid integer NOT NULL,
+    url text NOT NULL,
+    email text NOT NULL,
+    entry_date date DEFAULT ('now'::text)::date NOT NULL,
+    last_sent date DEFAULT ('now'::text)::date NOT NULL,
+    pending text,
+    opt_out text NOT NULL
+);
+
+
+--
+-- TOC entry 35 (OID 543754)
+-- Name: page_emails; Type: ACL; Schema: public; Owner: rich
+--
+
+REVOKE ALL ON TABLE page_emails FROM PUBLIC;
+GRANT ALL ON TABLE page_emails TO "www-data";
+
+
+SET SESSION AUTHORIZATION 'rich';
+
+--
+-- TOC entry 47 (OID 536388)
 -- Name: hostnames_hostid_name_uq; Type: INDEX; Schema: public; Owner: rich
 --
 
@@ -470,7 +497,7 @@ CREATE UNIQUE INDEX hostnames_hostid_name_uq ON hostnames USING btree (hostid, n
 
 
 --
--- TOC entry 46 (OID 536389)
+-- TOC entry 48 (OID 536389)
 -- Name: hostnams_name_uq; Type: INDEX; Schema: public; Owner: rich
 --
 
@@ -478,7 +505,7 @@ CREATE UNIQUE INDEX hostnams_name_uq ON hostnames USING btree (name);
 
 
 --
--- TOC entry 42 (OID 536419)
+-- TOC entry 44 (OID 536419)
 -- Name: pages_url_uq; Type: INDEX; Schema: public; Owner: rich
 --
 
@@ -486,7 +513,7 @@ CREATE UNIQUE INDEX pages_url_uq ON pages USING btree (hostid, url);
 
 
 --
--- TOC entry 47 (OID 536924)
+-- TOC entry 49 (OID 536924)
 -- Name: email_notify_email_uq; Type: INDEX; Schema: public; Owner: rich
 --
 
@@ -494,7 +521,7 @@ CREATE UNIQUE INDEX email_notify_email_uq ON email_notify USING btree (hostid, e
 
 
 --
--- TOC entry 48 (OID 540251)
+-- TOC entry 50 (OID 540251)
 -- Name: images_name_uq; Type: INDEX; Schema: public; Owner: rich
 --
 
@@ -502,7 +529,7 @@ CREATE UNIQUE INDEX images_name_uq ON images USING btree (hostid, name);
 
 
 --
--- TOC entry 50 (OID 540252)
+-- TOC entry 52 (OID 540252)
 -- Name: files_name_uq; Type: INDEX; Schema: public; Owner: rich
 --
 
@@ -510,7 +537,7 @@ CREATE UNIQUE INDEX files_name_uq ON files USING btree (hostid, name);
 
 
 --
--- TOC entry 53 (OID 540831)
+-- TOC entry 55 (OID 540831)
 -- Name: users_name_uq; Type: INDEX; Schema: public; Owner: rich
 --
 
@@ -518,7 +545,7 @@ CREATE UNIQUE INDEX users_name_uq ON users USING btree (hostid, name);
 
 
 --
--- TOC entry 52 (OID 540946)
+-- TOC entry 54 (OID 540946)
 -- Name: users_id_uq; Type: INDEX; Schema: public; Owner: rich
 --
 
@@ -526,7 +553,7 @@ CREATE UNIQUE INDEX users_id_uq ON users USING btree (hostid, id);
 
 
 --
--- TOC entry 55 (OID 540970)
+-- TOC entry 57 (OID 540970)
 -- Name: sitemenu_ordering_uq; Type: INDEX; Schema: public; Owner: rich
 --
 
@@ -534,7 +561,7 @@ CREATE UNIQUE INDEX sitemenu_ordering_uq ON sitemenu USING btree (hostid, orderi
 
 
 --
--- TOC entry 56 (OID 540971)
+-- TOC entry 58 (OID 540971)
 -- Name: sitemenu_url_uq; Type: INDEX; Schema: public; Owner: rich
 --
 
@@ -542,7 +569,7 @@ CREATE UNIQUE INDEX sitemenu_url_uq ON sitemenu USING btree (hostid, url);
 
 
 --
--- TOC entry 58 (OID 542626)
+-- TOC entry 60 (OID 542626)
 -- Name: contact_emails_uq; Type: INDEX; Schema: public; Owner: rich
 --
 
@@ -550,7 +577,7 @@ CREATE UNIQUE INDEX contact_emails_uq ON contact_emails USING btree (contactid,
 
 
 --
--- TOC entry 59 (OID 543505)
+-- TOC entry 61 (OID 543505)
 -- Name: themes_theme_css_uq; Type: INDEX; Schema: public; Owner: rich
 --
 
@@ -558,7 +585,15 @@ CREATE UNIQUE INDEX themes_theme_css_uq ON themes USING btree (theme_css);
 
 
 --
--- TOC entry 41 (OID 536012)
+-- TOC entry 62 (OID 543763)
+-- Name: page_emails_email_uq; Type: INDEX; Schema: public; Owner: rich
+--
+
+CREATE UNIQUE INDEX page_emails_email_uq ON page_emails USING btree (hostid, url, email);
+
+
+--
+-- TOC entry 43 (OID 536012)
 -- Name: pages_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -567,7 +602,7 @@ ALTER TABLE ONLY pages
 
 
 --
--- TOC entry 43 (OID 536027)
+-- TOC entry 45 (OID 536027)
 -- Name: contents_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -576,7 +611,7 @@ ALTER TABLE ONLY contents
 
 
 --
--- TOC entry 44 (OID 536377)
+-- TOC entry 46 (OID 536377)
 -- Name: hosts_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -585,7 +620,7 @@ ALTER TABLE ONLY hosts
 
 
 --
--- TOC entry 49 (OID 537158)
+-- TOC entry 51 (OID 537158)
 -- Name: images_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -594,7 +629,7 @@ ALTER TABLE ONLY images
 
 
 --
--- TOC entry 51 (OID 537173)
+-- TOC entry 53 (OID 537173)
 -- Name: files_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -603,7 +638,7 @@ ALTER TABLE ONLY files
 
 
 --
--- TOC entry 54 (OID 540825)
+-- TOC entry 56 (OID 540825)
 -- Name: users_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -612,7 +647,7 @@ ALTER TABLE ONLY users
 
 
 --
--- TOC entry 57 (OID 542611)
+-- TOC entry 59 (OID 542611)
 -- Name: contacts_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -621,7 +656,7 @@ ALTER TABLE ONLY contacts
 
 
 --
--- TOC entry 64 (OID 536029)
+-- TOC entry 67 (OID 536029)
 -- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -630,7 +665,7 @@ ALTER TABLE ONLY contents
 
 
 --
--- TOC entry 67 (OID 536384)
+-- TOC entry 70 (OID 536384)
 -- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -639,7 +674,7 @@ ALTER TABLE ONLY hostnames
 
 
 --
--- TOC entry 65 (OID 536394)
+-- TOC entry 68 (OID 536394)
 -- Name: hosts_hostname_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -648,7 +683,7 @@ ALTER TABLE ONLY hosts
 
 
 --
--- TOC entry 60 (OID 536404)
+-- TOC entry 63 (OID 536404)
 -- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -657,7 +692,7 @@ ALTER TABLE ONLY pages
 
 
 --
--- TOC entry 68 (OID 536920)
+-- TOC entry 71 (OID 536920)
 -- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -666,7 +701,7 @@ ALTER TABLE ONLY email_notify
 
 
 --
--- TOC entry 69 (OID 537160)
+-- TOC entry 72 (OID 537160)
 -- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -675,7 +710,7 @@ ALTER TABLE ONLY images
 
 
 --
--- TOC entry 70 (OID 537175)
+-- TOC entry 73 (OID 537175)
 -- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -684,7 +719,7 @@ ALTER TABLE ONLY files
 
 
 --
--- TOC entry 61 (OID 539155)
+-- TOC entry 64 (OID 539155)
 -- Name: pages_redirect_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -693,7 +728,7 @@ ALTER TABLE ONLY pages
 
 
 --
--- TOC entry 71 (OID 540827)
+-- TOC entry 74 (OID 540827)
 -- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -702,7 +737,7 @@ ALTER TABLE ONLY users
 
 
 --
--- TOC entry 72 (OID 540837)
+-- TOC entry 75 (OID 540837)
 -- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -711,7 +746,7 @@ ALTER TABLE ONLY usercookies
 
 
 --
--- TOC entry 62 (OID 540942)
+-- TOC entry 65 (OID 540942)
 -- Name: $2; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -720,7 +755,7 @@ ALTER TABLE ONLY pages
 
 
 --
--- TOC entry 63 (OID 540947)
+-- TOC entry 66 (OID 540947)
 -- Name: pages_user_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -729,7 +764,7 @@ ALTER TABLE ONLY pages
 
 
 --
--- TOC entry 73 (OID 540966)
+-- TOC entry 76 (OID 540966)
 -- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -738,7 +773,7 @@ ALTER TABLE ONLY sitemenu
 
 
 --
--- TOC entry 74 (OID 540972)
+-- TOC entry 77 (OID 540972)
 -- Name: sitemenu_url_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -747,7 +782,7 @@ ALTER TABLE ONLY sitemenu
 
 
 --
--- TOC entry 75 (OID 542613)
+-- TOC entry 78 (OID 542613)
 -- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -756,7 +791,7 @@ ALTER TABLE ONLY contacts
 
 
 --
--- TOC entry 76 (OID 542622)
+-- TOC entry 79 (OID 542622)
 -- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -765,7 +800,7 @@ ALTER TABLE ONLY contact_emails
 
 
 --
--- TOC entry 66 (OID 543506)
+-- TOC entry 69 (OID 543506)
 -- Name: hosts_theme_css_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
 --
 
@@ -773,6 +808,24 @@ ALTER TABLE ONLY hosts
     ADD CONSTRAINT hosts_theme_css_cn FOREIGN KEY (theme_css) REFERENCES themes(theme_css);
 
 
+--
+-- TOC entry 80 (OID 543759)
+-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
+--
+
+ALTER TABLE ONLY page_emails
+    ADD CONSTRAINT "$1" FOREIGN KEY (hostid) REFERENCES hosts(id);
+
+
+--
+-- TOC entry 81 (OID 543764)
+-- Name: page_emails_url_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
+--
+
+ALTER TABLE ONLY page_emails
+    ADD CONSTRAINT page_emails_url_cn FOREIGN KEY (hostid, url) REFERENCES pages(hostid, url) DEFERRABLE;
+
+
 SET SESSION AUTHORIZATION 'postgres';
 
 --
diff --git a/conf/cocanwiki.conf b/conf/cocanwiki.conf
index 6cad2c5..43b884e 100644
--- a/conf/cocanwiki.conf
+++ b/conf/cocanwiki.conf
@@ -1,5 +1,5 @@
 # Apache configuration for COCANWIKI.
-# $Id: cocanwiki.conf,v 1.7 2004/09/23 15:16:20 rich Exp $
+# $Id: cocanwiki.conf,v 1.8 2004/09/24 15:53:57 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 ^/_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]
 RewriteRule ^/_sitemap$ /_bin/sitemap.cmo [PT,L,QSA]
 RewriteRule ^/_users$ /_bin/users.cmo [PT,L,QSA]
diff --git a/scripts/Makefile b/scripts/Makefile
index ff8e09b..2d1f5b1 100644
--- a/scripts/Makefile
+++ b/scripts/Makefile
@@ -1,5 +1,5 @@
 # Makefile for COCANWIKI.
-# $Id: Makefile,v 1.22 2004/09/24 10:44:55 rich Exp $
+# $Id: Makefile,v 1.23 2004/09/24 15:53:57 rich Exp $
 
 include ../Makefile.config
 
@@ -68,6 +68,10 @@ OBJS := 00-TEMPLATE.cmo \
 	login_form.cmo \
 	logout.cmo \
 	page.cmo \
+	page_email_confirm.cmo \
+	page_email_form.cmo \
+	page_email_send.cmo \
+	page_email_unsubscribe.cmo \
 	pagestyle.cmo \
 	preview.cmo \
 	recent.cmo \
diff --git a/scripts/cocanwiki_emailnotify.ml b/scripts/cocanwiki_emailnotify.ml
index bb31ea0..bd9ec98 100644
--- a/scripts/cocanwiki_emailnotify.ml
+++ b/scripts/cocanwiki_emailnotify.ml
@@ -1,7 +1,7 @@
 (* COCANWIKI - a wiki written in Objective CAML.
  * Written by Richard W.M. Jones <rich@merjis.com>.
  * Copyright (C) 2004 Merjis Ltd.
- * $Id: cocanwiki_emailnotify.ml,v 1.3 2004/09/09 12:21:22 rich Exp $
+ * $Id: cocanwiki_emailnotify.ml,v 1.4 2004/09/24 15:53:57 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
@@ -47,7 +47,7 @@ let email_notify ~subject ~body (dbh : Dbi.connection) hostid =
      *)
     let body = body () in
 
-    let subject = "Wiki notice: " ^ subject in
+    let subject = "Site notice: " ^ subject in
 
     (* Send the email. *)
     Sendmail.send_mail ~subject ~to_addr ~body ()
diff --git a/scripts/edit.ml b/scripts/edit.ml
index 5bdf183..cede68b 100644
--- a/scripts/edit.ml
+++ b/scripts/edit.ml
@@ -1,7 +1,7 @@
 (* COCANWIKI - a wiki written in Objective CAML.
  * Written by Richard W.M. Jones <rich@merjis.com>.
  * Copyright (C) 2004 Merjis Ltd.
- * $Id: edit.ml,v 1.11 2004/09/23 11:56:47 rich Exp $
+ * $Id: edit.ml,v 1.12 2004/09/24 15:53:57 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
@@ -48,6 +48,7 @@ type model_t = {
 let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
   let template = get_template dbh hostid "edit.html" in
   let template_conflict = get_template dbh hostid "edit_conflict.html" in
+  let template_email = get_template dbh hostid "edit_page_email.txt" in
 
   (* Workaround bugs in IE, specifically lack of support for <button>
    * elements.
@@ -390,7 +391,8 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
        *)
       let sth =
 	dbh#prepare_cached
-	  "set constraints pages_redirect_cn, sitemenu_url_cn deferred" in
+	  "set constraints pages_redirect_cn, sitemenu_url_cn,
+               page_emails_url_cn deferred" in
       sth#execute [];
 
       (* Mark the old page as deleted.  NB. There is a small race
@@ -462,6 +464,47 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
 
       email_notify ~body ~subject dbh hostid;
 
+      (* General email notification of page edits.  Send an email to
+       * anyone in the page_emails table who has a confirmed address
+       * and who hasn't received an email already today.
+       *)
+      let sth = dbh#prepare_cached "select email, opt_out from page_emails
+                                     where hostid = ? and url = ?
+                                       and pending is null
+                                       and last_sent < current_date" in
+      sth#execute [`Int hostid; `String url];
+
+      let addrs = sth#map (function [`String email; `String opt_out] ->
+			     email, opt_out
+			     | _ -> assert false) in
+
+      if addrs <> [] then (
+	(* Construct the email. *)
+	template_email#set "hostname" hostname;
+	template_email#set "page" url;
+
+	let subject =
+	  "Site notice: " ^ hostname ^ "/" ^ url ^ " has been updated" in
+
+	(* Send each email individually (they all have different opt out
+	 * links).
+	 *)
+	List.iter (fun (to_addr, opt_out) ->
+		     template_email#set "opt_out" opt_out;
+		     let body = template_email#to_string in
+		     Sendmail.send_mail ~subject ~to_addr:[to_addr] ~body ())
+	  addrs
+      );
+
+      (* Update the database to record when these emails were sent. *)
+      let sth = dbh#prepare_cached "update page_emails
+                                       set last_sent = current_date
+                                     where hostid = ? and url = ?
+                                       and pending is null" in
+      sth#execute [`Int hostid; `String url];
+
+      dbh#commit ();
+
       let buttons = [ ok_button ("/" ^ url) ] in
       ok ~title:"Saved" ~buttons
         q "The page was saved."
diff --git a/scripts/edit_page_css.ml b/scripts/edit_page_css.ml
index 126c289..1d01a7a 100644
--- a/scripts/edit_page_css.ml
+++ b/scripts/edit_page_css.ml
@@ -1,7 +1,7 @@
 (* COCANWIKI - a wiki written in Objective CAML.
  * Written by Richard W.M. Jones <rich@merjis.com>.
  * Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_page_css.ml,v 1.8 2004/09/21 13:01:15 rich Exp $
+ * $Id: edit_page_css.ml,v 1.9 2004/09/24 15:53:57 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
@@ -62,7 +62,8 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
       | _ -> assert false in
 
   let sth = dbh#prepare_cached
-	      "set constraints pages_redirect_cn, sitemenu_url_cn deferred" in
+	      "set constraints pages_redirect_cn, sitemenu_url_cn,
+                   page_emails_url_cn deferred" in
   sth#execute [];
 
   let sth = dbh#prepare_cached "update pages set url_deleted = url,
diff --git a/scripts/page_email_confirm.ml b/scripts/page_email_confirm.ml
new file mode 100644
index 0000000..67adf66
--- /dev/null
+++ b/scripts/page_email_confirm.ml
@@ -0,0 +1,63 @@
+(* COCANWIKI - a wiki written in Objective CAML.
+ * Written by Richard W.M. Jones <rich@merjis.com>.
+ * Copyright (C) 2004 Merjis Ltd.
+ * $Id: page_email_confirm.ml,v 1.1 2004/09/24 15:53:57 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 url, email from page_emails
+                                 where hostid = ? and pending = ?" in
+  sth#execute [`Int hostid; `String pending];
+
+  let page, email =
+    try
+      (match sth#fetch1 () with
+	   [ `String page; `String email ] -> page, email
+	 | _ -> assert false)
+    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 page_emails 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 will now receive " ^
+       "an email whenever that page is updated.")
+
+let () =
+  register_script run
diff --git a/scripts/page_email_form.ml b/scripts/page_email_form.ml
new file mode 100644
index 0000000..53c51ae
--- /dev/null
+++ b/scripts/page_email_form.ml
@@ -0,0 +1,47 @@
+(* COCANWIKI - a wiki written in Objective CAML.
+ * Written by Richard W.M. Jones <rich@merjis.com>.
+ * Copyright (C) 2004 Merjis Ltd.
+ * $Id: page_email_form.ml,v 1.1 2004/09/24 15:53:57 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 "page_email_form.html" in
+
+  let page = q#param "page" in
+  template#set "page" page;
+
+  (* Get the page title. *)
+  let sth = dbh#prepare_cached "select title from pages
+                                 where hostid = ? and url = ?" in
+  sth#execute [`Int hostid; `String page];
+
+  let title = sth#fetch1string () in
+  template#set "title" title;
+
+  q#template template
+
+let () =
+  register_script run
diff --git a/scripts/page_email_send.ml b/scripts/page_email_send.ml
new file mode 100644
index 0000000..9fa7318
--- /dev/null
+++ b/scripts/page_email_send.ml
@@ -0,0 +1,101 @@
+(* COCANWIKI - a wiki written in Objective CAML.
+ * Written by Richard W.M. Jones <rich@merjis.com>.
+ * Copyright (C) 2004 Merjis Ltd.
+ * $Id: page_email_send.ml,v 1.1 2004/09/24 15:53:57 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 "page_email_send.txt" in
+
+  let page = q#param "page" 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 page_emails
+                                 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 page_emails where hostid = ?
+                                  and url = ? and email = ?" in
+  sth#execute [`Int hostid; `String page; `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 used for notifications from this page. "^
+       "If you are not receiving updates for this page, 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 page_emails (hostid, url, email,
+                                  pending, opt_out) values (?, ?, ?, ?, ?)" in
+  sth#execute [`Int hostid; `String page; `String email; `String pending;
+	       `String opt_out];
+
+  dbh#commit ();
+
+  (* Send the initial email to the user. *)
+  template#set "hostname" hostname;
+  template#set "page" page;
+  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/page_email_unsubscribe.ml b/scripts/page_email_unsubscribe.ml
new file mode 100644
index 0000000..eb354ff
--- /dev/null
+++ b/scripts/page_email_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: page_email_unsubscribe.ml,v 1.1 2004/09/24 15:53:57 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 page_emails
+                                 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/scripts/restore.ml b/scripts/restore.ml
index 53fb478..471b8fc 100644
--- a/scripts/restore.ml
+++ b/scripts/restore.ml
@@ -1,7 +1,7 @@
 (* COCANWIKI - a wiki written in Objective CAML.
  * Written by Richard W.M. Jones <rich@merjis.com>.
  * Copyright (C) 2004 Merjis Ltd.
- * $Id: restore.ml,v 1.8 2004/09/21 13:01:16 rich Exp $
+ * $Id: restore.ml,v 1.9 2004/09/24 15:53:57 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
@@ -60,7 +60,8 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
 
     let sth =
       dbh#prepare_cached
-	"set constraints pages_redirect_cn, sitemenu_url_cn deferred" in
+	"set constraints pages_redirect_cn, sitemenu_url_cn,
+             page_emails_url_cn deferred" in
     sth#execute [];
 
     let sth = dbh#prepare_cached "update pages set url_deleted = url,
diff --git a/templates/edit_page_email.txt b/templates/edit_page_email.txt
new file mode 100644
index 0000000..c753e19
--- /dev/null
+++ b/templates/edit_page_email.txt
@@ -0,0 +1,10 @@
+This page has been updated:
+
+http://::hostname::/::page::
+
+You received this email because previously you registered at
+::hostname:: to receive emails whenever that page changed.
+You can immediately unsubscribe from future emails by clicking
+on this link:
+
+http://::hostname::/_pe_unsub?o=::opt_out::
diff --git a/templates/page.html b/templates/page.html
index f65c494..b67d300 100644
--- a/templates/page.html
+++ b/templates/page.html
@@ -85,6 +85,7 @@
 ::if(can_edit)::
 <li> <a href="/_admin">Server administration</a> </li>
 ::end::
+<li> <a href="/_bin/page_email_form.cmo?page=::page_url::">Send email if this page changes</a> </li>
 </ul>
 </div>
 
diff --git a/templates/page_email_form.html b/templates/page_email_form.html
new file mode 100644
index 0000000..02ea7cf
--- /dev/null
+++ b/templates/page_email_form.html
@@ -0,0 +1,71 @@
+<!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>Send an email when the page is updated</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>Send an email when the page is updated</h1>
+
+<p>
+If you fill in this form you will receive an email
+whenever that page
+(<a href="/::page_html_tag::">::title_html::</a>)
+gets updated.
+</p>
+
+<form method="post" action="/_bin/page_email_send.cmo">
+<input type="hidden" name="page" value="::page_html_tag::"/>
+<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>
+<li> You will receive at most one email per day when the page
+  changes. </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/page_email_send.txt b/templates/page_email_send.txt
new file mode 100644
index 0000000..3fdfa1e
--- /dev/null
+++ b/templates/page_email_send.txt
@@ -0,0 +1,17 @@
+Someone, possibly you, requested email notification whenever the page
+http://::hostname::/::page:: changed.
+
+To CONFIRM this, please click on the following link.
+
+http://::hostname::/_pe_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::/_pe_unsub?o=::opt_out::
-- 
1.8.3.1