From 0bbc87f2b064e8080f18e77ffcadcd6348ecd9be Mon Sep 17 00:00:00 2001
From: rich <rich>
Date: Thu, 14 Oct 2004 15:57:15 +0000
Subject: [PATCH] User invites.

Login form is more stern when the site doesn't allow free signups.

Mail2wiki - not working, commented out of the Makefile.

URLs which begin with '/' are now treated as internal URLs relative
to the current site.

Updated MANIFEST.

Updated deps.
---
 MANIFEST                                |  11 ++
 conf/cocanwiki.conf                     |   3 +-
 scripts/.depend                         |  26 +++--
 scripts/Makefile                        |  12 ++-
 scripts/change_password.ml              |  11 +-
 scripts/cocanwiki_mail.ml               | 181 ++++++++++++++++++++++++++++++++
 scripts/cocanwiki_mail.mli              |  25 +++++
 scripts/invite_user.ml                  | 111 ++++++++++++++++++++
 scripts/invite_user_confirm.ml          | 106 +++++++++++++++++++
 scripts/invite_user_confirm_form.ml     |  56 ++++++++++
 scripts/invite_user_form.ml             |  36 +++++++
 scripts/login.ml                        |   4 +-
 scripts/mail_import.ml                  |   7 +-
 scripts/wikilib.ml                      |  10 +-
 templates/invite_user.txt               |   6 ++
 templates/invite_user_confirm.txt       |  10 ++
 templates/invite_user_confirm_form.html |  64 +++++++++++
 templates/invite_user_exists.txt        |  11 ++
 templates/invite_user_form.html         |  53 ++++++++++
 templates/login_form.html               |   7 +-
 templates/users.html                    |   3 +-
 21 files changed, 726 insertions(+), 27 deletions(-)
 create mode 100644 scripts/cocanwiki_mail.ml
 create mode 100644 scripts/cocanwiki_mail.mli
 create mode 100644 scripts/invite_user.ml
 create mode 100644 scripts/invite_user_confirm.ml
 create mode 100644 scripts/invite_user_confirm_form.ml
 create mode 100644 scripts/invite_user_form.ml
 create mode 100644 templates/invite_user.txt
 create mode 100644 templates/invite_user_confirm.txt
 create mode 100644 templates/invite_user_confirm_form.html
 create mode 100644 templates/invite_user_exists.txt
 create mode 100644 templates/invite_user_form.html

diff --git a/MANIFEST b/MANIFEST
index b53bcdf..cb62ce2 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -68,6 +68,8 @@ scripts/cocanwiki_images.ml
 scripts/cocanwiki_images.mli
 scripts/cocanwiki_links.ml
 scripts/cocanwiki_links.mli
+scripts/cocanwiki_mail.ml
+scripts/cocanwiki_mail.mli
 scripts/cocanwiki_ok.ml
 scripts/cocanwiki_pages.ml
 scripts/cocanwiki_pages.mli
@@ -117,6 +119,10 @@ scripts/host_menu.ml
 scripts/hoststyle.ml
 scripts/image.ml
 scripts/images.ml
+scripts/invite_user.ml
+scripts/invite_user_confirm.ml
+scripts/invite_user_confirm_form.ml
+scripts/invite_user_form.ml
 scripts/largest_pages.ml
 scripts/login.ml
 scripts/login_form.ml
@@ -203,6 +209,11 @@ templates/forgot_password_form.html
 templates/history.html
 templates/host_menu.html
 templates/images.html
+templates/invite_user.txt
+templates/invite_user_confirm.txt
+templates/invite_user_confirm_form.html
+templates/invite_user_exists.txt
+templates/invite_user_form.html
 templates/largest_pages.html
 templates/login_form.html
 templates/mail_import_form.html
diff --git a/conf/cocanwiki.conf b/conf/cocanwiki.conf
index 5386ca4..02debf8 100644
--- a/conf/cocanwiki.conf
+++ b/conf/cocanwiki.conf
@@ -1,5 +1,5 @@
 # Apache configuration for COCANWIKI.
-# $Id: cocanwiki.conf,v 1.12 2004/10/09 15:01:57 rich Exp $
+# $Id: cocanwiki.conf,v 1.13 2004/10/14 15:57:15 rich Exp $
 
 # Uncomment the following lines if necessary.  You will probably need
 # to adjust the paths to reflect where cocanwiki is really installed.
@@ -57,6 +57,7 @@ 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]
+RewriteRule ^/_invite$ /_bin/invite_user_confirm_form.cmo [PT,L,QSA]
 RewriteRule ^/_login$ /_bin/login_form.cmo [PT,L]
 RewriteRule ^/_logout$ /_bin/logout.cmo [PT,L,QSA]
 RewriteRule ^/_mailing_list.csv$ /_bin/mailing_list_view.cmo?csv=1 [PT,L]
diff --git a/scripts/.depend b/scripts/.depend
index 4c9c140..f7211ea 100644
--- a/scripts/.depend
+++ b/scripts/.depend
@@ -23,6 +23,8 @@ cocanwiki_images.cmx: cocanwiki_files.cmx cocanwiki_strings.cmx \
     cocanwiki_images.cmi 
 cocanwiki_links.cmo: cocanwiki.cmo wikilib.cmi cocanwiki_links.cmi 
 cocanwiki_links.cmx: cocanwiki.cmx wikilib.cmx cocanwiki_links.cmi 
+cocanwiki_mail.cmo: cocanwiki_mail.cmi 
+cocanwiki_mail.cmx: cocanwiki_mail.cmi 
 cocanwiki_ok.cmo: cocanwiki_template.cmi 
 cocanwiki_ok.cmx: cocanwiki_template.cmx 
 cocanwiki_pages.cmo: cocanwiki.cmo cocanwiki_links.cmi cocanwiki_strings.cmo \
@@ -125,6 +127,18 @@ image.cmo: cocanwiki.cmo
 image.cmx: cocanwiki.cmx 
 images.cmo: cocanwiki.cmo cocanwiki_template.cmi 
 images.cmx: cocanwiki.cmx cocanwiki_template.cmx 
+invite_user.cmo: cocanwiki.cmo cocanwiki_ok.cmo cocanwiki_template.cmi 
+invite_user.cmx: cocanwiki.cmx cocanwiki_ok.cmx cocanwiki_template.cmx 
+invite_user_confirm.cmo: cocanwiki.cmo cocanwiki_ok.cmo cocanwiki_strings.cmo \
+    cocanwiki_template.cmi 
+invite_user_confirm.cmx: cocanwiki.cmx cocanwiki_ok.cmx cocanwiki_strings.cmx \
+    cocanwiki_template.cmx 
+invite_user_confirm_form.cmo: cocanwiki.cmo cocanwiki_ok.cmo \
+    cocanwiki_strings.cmo cocanwiki_template.cmi 
+invite_user_confirm_form.cmx: cocanwiki.cmx cocanwiki_ok.cmx \
+    cocanwiki_strings.cmx cocanwiki_template.cmx 
+invite_user_form.cmo: cocanwiki.cmo cocanwiki_template.cmi 
+invite_user_form.cmx: cocanwiki.cmx cocanwiki_template.cmx 
 largest_pages.cmo: cocanwiki.cmo cocanwiki_template.cmi 
 largest_pages.cmx: cocanwiki.cmx cocanwiki_template.cmx 
 login.cmo: cocanwiki.cmo cocanwiki_ok.cmo 
@@ -133,12 +147,12 @@ login_form.cmo: cocanwiki.cmo cocanwiki_strings.cmo cocanwiki_template.cmi
 login_form.cmx: cocanwiki.cmx cocanwiki_strings.cmx cocanwiki_template.cmx 
 logout.cmo: cocanwiki.cmo cocanwiki_ok.cmo 
 logout.cmx: cocanwiki.cmx cocanwiki_ok.cmx 
-mail_import.cmo: cocanwiki.cmo cocanwiki_date.cmo cocanwiki_ok.cmo \
-    cocanwiki_pages.cmi cocanwiki_strings.cmo cocanwiki_template.cmi \
-    wikilib.cmi 
-mail_import.cmx: cocanwiki.cmx cocanwiki_date.cmx cocanwiki_ok.cmx \
-    cocanwiki_pages.cmx cocanwiki_strings.cmx cocanwiki_template.cmx \
-    wikilib.cmx 
+mail_import.cmo: cocanwiki.cmo cocanwiki_date.cmo cocanwiki_mail.cmi \
+    cocanwiki_ok.cmo cocanwiki_pages.cmi cocanwiki_strings.cmo \
+    cocanwiki_template.cmi wikilib.cmi 
+mail_import.cmx: cocanwiki.cmx cocanwiki_date.cmx cocanwiki_mail.cmx \
+    cocanwiki_ok.cmx cocanwiki_pages.cmx cocanwiki_strings.cmx \
+    cocanwiki_template.cmx wikilib.cmx 
 mail_import_form.cmo: cocanwiki.cmo cocanwiki_template.cmi 
 mail_import_form.cmx: cocanwiki.cmx cocanwiki_template.cmx 
 mailing_list_confirm.cmo: cocanwiki.cmo cocanwiki_ok.cmo 
diff --git a/scripts/Makefile b/scripts/Makefile
index eedeecb..39afce8 100644
--- a/scripts/Makefile
+++ b/scripts/Makefile
@@ -1,5 +1,5 @@
 # Makefile for COCANWIKI.
-# $Id: Makefile,v 1.39 2004/10/11 15:21:49 rich Exp $
+# $Id: Makefile,v 1.40 2004/10/14 15:57:15 rich Exp $
 
 include ../Makefile.config
 
@@ -28,6 +28,8 @@ LIB_OBJS := \
 	cocanwiki_create_host.cmo \
 	cocanwiki_ext_calendar.cmo
 
+#	cocanwiki_mail.cmo
+
 OBJS := \
 	broken_links.cmo \
 	change_password.cmo \
@@ -73,12 +75,14 @@ OBJS := \
 	host_menu.cmo \
 	image.cmo \
 	images.cmo \
+	invite_user.cmo \
+	invite_user_form.cmo \
+	invite_user_confirm.cmo \
+	invite_user_confirm_form.cmo \
 	largest_pages.cmo \
 	login.cmo \
 	login_form.cmo \
 	logout.cmo \
-	mail_import.cmo \
-	mail_import_form.cmo \
 	mailing_list_confirm.cmo \
 	mailing_list_form.cmo \
 	mailing_list_send.cmo \
@@ -118,6 +122,8 @@ OBJS := \
 	what_links_here.cmo
 
 # Not working:
+#	mail_import.cmo
+#	mail_import_form.cmo
 #	visualise_links.cmo
 
 ADMIN_OBJS := \
diff --git a/scripts/change_password.ml b/scripts/change_password.ml
index d189f83..531e2e6 100644
--- a/scripts/change_password.ml
+++ b/scripts/change_password.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: change_password.ml,v 1.1 2004/09/25 13:17:00 rich Exp $
+ * $Id: change_password.ml,v 1.2 2004/10/14 15:57:15 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
@@ -37,8 +37,9 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ user =
       | User (userid, _, _) -> userid in
 
   let sth = dbh#prepare_cached "select 1 from users
-                                 where id = ? and password = ?" in
-  sth#execute [`Int userid; `String old_password];
+                                 where hostid = ? and id = ?
+                                   and password = ?" in
+  sth#execute [`Int hostid; `Int userid; `String old_password];
 
   let old_password_ok =
     try 1 = sth#fetch1int ()
@@ -73,8 +74,8 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ user =
   let sth =
     dbh#prepare_cached
       "update users set password = ?, force_password_change = false
-        where id = ?" in
-  sth#execute [`String password; `Int userid];
+        where hostid = ? and id = ?" in
+  sth#execute [`String password; `Int hostid; `Int userid];
 
   dbh#commit ();
 
diff --git a/scripts/cocanwiki_mail.ml b/scripts/cocanwiki_mail.ml
new file mode 100644
index 0000000..e9d6ca9
--- /dev/null
+++ b/scripts/cocanwiki_mail.ml
@@ -0,0 +1,181 @@
+(* COCANWIKI - a wiki written in Objective CAML.
+ * Written by Richard W.M. Jones <rich@merjis.com>.
+ * Copyright (C) 2004 Merjis Ltd.
+ * $Id: cocanwiki_mail.ml,v 1.1 2004/10/14 15:57:15 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 ExtString
+
+(*
+(* Rebuild mail threads for (year, month).
+ * The algorithm used is by JWZ - see:
+ * http://www.jwz.org/doc/threading.html
+ *)
+class ['a] container m =
+object (self)
+  val mutable message = (m : 'a option)
+  val mutable parent = (None : 'a container option)
+  val mutable children = ([] : 'a container list)
+
+  method message = message
+  method set_message m = message <- Some m
+
+  (* Don't call 'set_parent' explicitly.  I wish I could understand the
+   * section in the manual on friend methods ...
+   *)
+  method parent = parent
+  method set_parent c = parent <- Some c
+  method set_no_parent () = parent <- None
+
+  method children = children
+  method add_child c =
+    assert (not (List.exists (fun child -> Oo.id child = Oo.id c) children));
+    children <- c :: children;
+    assert (c#parent = None);
+    c#set_parent self
+  method remove_child c =
+    match c#parent with
+	None
+      | Some parent when Oo.id parent <> Oo.id self
+    let n = List.length children in
+    children <- List.filter (fun child -> Oo.id child <> Oo.id c) children;
+    assert (List.length children = n-1)
+end
+
+let re_re = Pcre.regexp "^Re\\[\\d+\\]:\\s*"
+
+let thread_mail (dbh : Dbi.connection) hostid year month =
+  let title = "Mail/%04d/%02d/Thread Index" in
+
+  (* Pull out all the emails relevant to this month. *)
+  let sth =
+    dbh#prepare_cached "select id, subject, inet_message_id, message_date
+                          from messages
+                         where hostid = ?
+                           and extract (year from message_date) = ?
+                           and extract (month from message_date) = ?" in
+  sth#execute [`Int hostid; `Int year; `Int month];
+
+  let msgs =
+    sth#map
+      (function [`Int id; `String subject; `String inet_message_id;
+		 `Timestamp message_date] ->
+	 id, (inet_message_id, subject, message_date)
+	 | _ -> assert false) in
+
+  let references =
+    if msgs <> [] then (
+      let sth =
+	let qs = Dbi.placeholders (List.length msgs) in
+	dbh#prepare_cached ("select message_id, inet_message_id, ordering
+                               from messages
+                              where message_id in " ^ qs ^ "
+                              order by message_id, ordering") in
+      sth#execute (List.map (fun (id, _) -> `Int id) msgs);
+      sth#map (function [`Int id; `String inet_message_id; _] ->
+		 id, inet_message_id
+		 | _ -> assert false)
+    ) else [] in
+
+  (* Aggregate the msgs and references structures together.
+   * Note that references will be in the correct order (because of the
+   * 'order by' clause in the select statement above), with the parent
+   * message appearing first in the list.
+   *)
+  let msgs =
+    List.map (fun (id, (inet_message_id, subject, message_date)) ->
+		let references =
+		  List.filter (fun (i, _) -> i = id) references in
+		let references = List.map snd references in
+		id, (inet_message_id, references, subject, message_date))
+      msgs in
+
+  (* Get the base subject lines (removing Re:, etc.). *)
+  let msgs =
+    List.map (fun (id, (inet_message_id, references, subject, message_date)) ->
+		let rec loop subject =
+		  let n = String.length subject in
+		  if String.starts_with subject "Re: " then
+		    loop (String.sub subject 4 (n-4))
+		  else if String.starts_with subject "Re:" then
+		    loop (String.sub subject 3 (n-3))
+		  else if String.starts_with subject "RE: " then
+		    loop (String.sub subject 4 (n-4))
+		  else if String.starts_with subject "RE:" then
+		    loop (String.sub subject 3 (n-3))
+		  else if Pcre.pmatch ~rex:re_re subject then (
+		    let subs = Pcre.exec ~rex:re_re subject in
+		    let i = String.length (Pcre.get_substring subs 0) in
+		    loop (String.sub subject i (n-i))
+		  ) else
+		    subject
+		in
+		let base_subject = loop subject in
+		let is_reply = base_subject <> subject in
+		id, (inet_message_id, references,
+		     subject, base_subject, is_reply, message_date)) msgs in
+
+  (*--- Step 1. ---*)
+  (* Hash of inet_message_id -> container. *)
+  let id_table = Hashtbl 1024 in
+  List.iter
+    (fun ((id, (inet_message_id, references, _, _, _, _)) as message) ->
+       let container =
+	 try
+	   let container = Hashtbl.find id_table inet_message_id in
+	   if container#message = None then container#set_message message;
+	   container
+	 with
+	     Not_found ->
+	       let container = new container (Some message) in
+	       Hashtbl.add id_table inet_message_id container;
+	       container in
+
+       (* References. *)
+       let ref_containers =
+	 List.map
+	   (fun inet_message_id ->
+	      try
+		Hashtbl.find id_table inet_message_id
+	      with
+		  Not_found ->
+		    let container = new container None in
+		    Hashtbl.add id_table inet_message_id container;
+		    container) references in
+       (* Link the reference containers together. *)
+       iter_in_pairs
+	 (fun child parent ->
+	    if not (reachable parent child) && not (reachable child parent)
+	    then (
+	      if parent#child = None then parent#set_child = child;
+	      if child#parent = None then child#set_parent = parent;
+	    )) ref_containers;
+
+       (* Parent of this message is first element in references. *)
+       match ref_containers with
+	   [] ->
+	     let old_parent = container#parent in
+	     container#set_no_parent ();
+	     if old_parent <> 
+	 | parent :: _ when Oo.id parent <> my_parent_id ->
+	     container#set_parent 
+
+
+
+    ) msgs;
+*)
diff --git a/scripts/cocanwiki_mail.mli b/scripts/cocanwiki_mail.mli
new file mode 100644
index 0000000..23a569b
--- /dev/null
+++ b/scripts/cocanwiki_mail.mli
@@ -0,0 +1,25 @@
+(* COCANWIKI - a wiki written in Objective CAML.
+ * Written by Richard W.M. Jones <rich@merjis.com>.
+ * Copyright (C) 2004 Merjis Ltd.
+ * $Id: cocanwiki_mail.mli,v 1.1 2004/10/14 15:57:15 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.
+ *)
+
+val thread_mail : Dbi.connection -> int -> int -> int -> unit
+  (** [thread_mail dbh hostid year month] rebuilds the thread index
+    * for (year, month).
+    *)
diff --git a/scripts/invite_user.ml b/scripts/invite_user.ml
new file mode 100644
index 0000000..a2d3bab
--- /dev/null
+++ b/scripts/invite_user.ml
@@ -0,0 +1,111 @@
+(* COCANWIKI - a wiki written in Objective CAML.
+ * Written by Richard W.M. Jones <rich@merjis.com>.
+ * Copyright (C) 2004 Merjis Ltd.
+ * $Id: invite_user.ml,v 1.1 2004/10/14 15:57:15 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
+
+let split_re = Pcre.regexp "[\\s,;]+"
+
+let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user =
+  let template = _get_template "invite_user.txt" in
+  let template_exists = _get_template "invite_user_exists.txt" in
+
+  (* Get the email addresses. *)
+  let emails = q#param "emails" in
+  let emails = Pcre.split ~rex:split_re emails in
+
+  (* This guy's got no friends ... *)
+  if emails = [] then (
+    q#redirect ("http://" ^ hostname ^ "/");
+    return ()
+  );
+
+  let userid, username = match user with
+      User (userid, username, _) -> userid, username
+    | _ -> assert false in
+
+  let subject = username ^ " has invited you to join " ^ hostname in
+
+  (* Get user's own email address, which will be the return address
+   * for the email.
+   *)
+  let sth = dbh#prepare_cached "select email from users
+                                 where hostid = ? and id = ?" in
+  sth#execute [`Int hostid; `Int userid];
+
+  let from =
+    match sth#fetch1 () with
+	[ `String email ] -> email
+      | [ `Null ] -> "service@merjis.com"
+      | _ -> assert false in
+
+  (* Add user accounts for these new users.  For users who are already
+   * registered, we'll send reminder emails.
+   *)
+  List.iter
+    (fun email ->
+       let sth = dbh#prepare_cached "select id from users
+                                      where hostid = ? and
+                                            (email = ? or name = ?)" in
+       sth#execute [`Int hostid; `String email; `String email];
+
+       let userid = try Some (sth#fetch1int ()) with Not_found -> None in
+
+       let body =
+	 match userid with
+	     Some userid ->
+	       (* Existing user account - send reminder. *)
+	       template_exists#set "username" username;
+	       template_exists#set "hostname" hostname;
+	       template_exists#to_string
+
+	   | None ->
+	       (* Add user account. *)
+	       let password = random_sessionid () in
+	       let sth = dbh#prepare_cached "insert into users (hostid, name,
+                 password, email) values (?, ?, ?, ?)" in
+	       sth#execute [`Int hostid; `String email; `String password;
+			    `String email];
+
+	       template#set "username" username;
+	       template#set "hostname" hostname;
+	       template#set "password" password;
+	       template#to_string in
+
+       (* Send the email. *)
+       Sendmail.send_mail ~subject ~to_addr:[email] ~from ~body ()
+    ) emails;
+
+  (* Finish off. *)
+  dbh#commit ();
+
+  let buttons = [ ok_button "/_users" ] in
+  ok ~buttons ~title:"Invitation emails sent"
+    q "We sent invitations emails to those address(es)."
+
+let () =
+  register_script ~restrict:[CanManageUsers] ~anonymous:false run
diff --git a/scripts/invite_user_confirm.ml b/scripts/invite_user_confirm.ml
new file mode 100644
index 0000000..3f45c34
--- /dev/null
+++ b/scripts/invite_user_confirm.ml
@@ -0,0 +1,106 @@
+(* COCANWIKI - a wiki written in Objective CAML.
+ * Written by Richard W.M. Jones <rich@merjis.com>.
+ * Copyright (C) 2004 Merjis Ltd.
+ * $Id: invite_user_confirm.ml,v 1.1 2004/10/14 15:57:15 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_strings
+open Cocanwiki_template
+
+let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ =
+  let template = _get_template "invite_user_confirm.txt" in
+
+  let username = q#param "username" in
+  let old_password = q#param "old_password" in
+
+  assert (String.length old_password = 32 &&
+	  string_for_all isxdigit old_password);
+
+  (* Verify the username, old_password combination. *)
+  let sth = dbh#prepare_cached "select email, id from users
+                                 where hostid = ? and
+                                       name = ? and password = ?" in
+  sth#execute [`Int hostid; `String username; `String old_password];
+
+  let email, userid =
+    try
+      match sth#fetch1 () with
+	  [ `String email; `Int userid ] -> Some email, userid
+	| [ `Null; `Int userid ] -> None, userid
+	| _ -> assert false
+    with Not_found ->
+      error ~title:"Bad password"
+        ~back_button:true
+        q "The password you gave is wrong.";
+      return () in
+
+  let password1 = q#param "password1" in
+  let password2 = q#param "password2" in
+
+  if password1 = "" || password2 = "" then (
+    error ~back_button:true ~title:"Bad password"
+      q "The password you gave is empty.";
+    return ()
+  );
+
+  if password1 <> password2 then (
+    error ~back_button:true ~title:"Passwords don't match"
+      q "The two passwords you gave aren't identical.";
+    return ()
+  );
+
+  let password = password1 in
+
+  (* Change the password. *)
+  let sth =
+    dbh#prepare_cached
+      "update users set password = ?, force_password_change = false
+        where hostid = ? and id = ?" in
+  sth#execute [`String password; `Int hostid; `Int userid];
+
+  (* Send email to this user. *)
+  (match email with
+       None -> ()
+     | Some email ->
+	 template#set "username" username;
+	 template#set "hostname" hostname;
+
+	 let body = template#to_string in
+
+	 let subject = "Your new account details" in
+	 Sendmail.send_mail ~to_addr:[email] ~subject ~body ());
+
+  dbh#commit ();
+
+  (* Redirect to the login page. *)
+  let redirect =
+    "http://" ^ hostname ^ "/_bin/login.cmo?" ^
+    "username=" ^ Cgi_escape.escape_url username ^ "&" ^
+    "password=" ^ Cgi_escape.escape_url password ^ "&" ^
+    "permanent=1" in
+  q#redirect redirect
+
+let () =
+  register_script run
diff --git a/scripts/invite_user_confirm_form.ml b/scripts/invite_user_confirm_form.ml
new file mode 100644
index 0000000..93e6dd8
--- /dev/null
+++ b/scripts/invite_user_confirm_form.ml
@@ -0,0 +1,56 @@
+(* COCANWIKI - a wiki written in Objective CAML.
+ * Written by Richard W.M. Jones <rich@merjis.com>.
+ * Copyright (C) 2004 Merjis Ltd.
+ * $Id: invite_user_confirm_form.ml,v 1.1 2004/10/14 15:57:15 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 _ _ =
+  let template = get_template dbh hostid "invite_user_confirm_form.html" in
+
+  (* Get the password.  It's supposed to be unique so we can look up the
+   * user by this.  Do a bit of sanity checking on it, however, to make
+   * sure we can't just use it to search for passwords, or some other type
+   * of strange exploit.
+   *)
+  let password = q#param "p" in
+  assert (String.length password = 32 && string_for_all isxdigit password);
+
+  let sth = dbh#prepare_cached "select name from users
+                                 where hostid = ? and password = ?" in
+  sth#execute [`Int hostid; `String password];
+
+  let username = sth#fetch1string () in
+
+  (* Update the template so that the user can set their preferred password. *)
+  template#set "username" username;
+  template#set "old_password" password;
+
+  q#template template
+
+let () =
+  register_script run
diff --git a/scripts/invite_user_form.ml b/scripts/invite_user_form.ml
new file mode 100644
index 0000000..c498230
--- /dev/null
+++ b/scripts/invite_user_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: invite_user_form.ml,v 1.1 2004/10/14 15:57:15 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 "invite_user_form.html" in
+
+  q#template template
+
+let () =
+  register_script ~restrict:[CanManageUsers] run
diff --git a/scripts/login.ml b/scripts/login.ml
index e316d64..0d802ad 100644
--- a/scripts/login.ml
+++ b/scripts/login.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: login.ml,v 1.4 2004/09/25 13:17:00 rich Exp $
+ * $Id: login.ml,v 1.5 2004/10/14 15:57:15 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
@@ -67,7 +67,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ =
 	Cookie.cookie ~name:"auth" ~value:cookie ~path:"/" () in
 
     ok ~title:"Logged in" ~buttons:[ok_button redirect] ~cookie
-      q ("Welcome back " ^ username ^ "." ^
+      q ("Welcome " ^ username ^ "." ^
 	 if force_password_change then "  Please change your password now."
 	 else "")
   with
diff --git a/scripts/mail_import.ml b/scripts/mail_import.ml
index 0cd7a67..1c4f709 100644
--- a/scripts/mail_import.ml
+++ b/scripts/mail_import.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: mail_import.ml,v 1.4 2004/10/12 10:00:38 rich Exp $
+ * $Id: mail_import.ml,v 1.5 2004/10/14 15:57:15 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
@@ -36,6 +36,7 @@ open Cocanwiki_template
 open Cocanwiki_date
 open Cocanwiki_strings
 open Cocanwiki_pages
+open Cocanwiki_mail
 
 let irt_re = Pcre.regexp "<.*?>"
 let ws_re = Pcre.regexp "\\s+"
@@ -348,6 +349,10 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ user =
    *)
   save_page dbh hostid ~user ~r model;
 
+  (* Rebuild threads? *)
+  if rebuild then
+    thread_mail dbh hostid date.Dbi.year date.Dbi.month;
+
   (* Commit to the database. *)
   dbh#commit ();
 
diff --git a/scripts/wikilib.ml b/scripts/wikilib.ml
index 9651aad..f4b309b 100644
--- a/scripts/wikilib.ml
+++ b/scripts/wikilib.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: wikilib.ml,v 1.12 2004/10/11 14:13:04 rich Exp $
+ * $Id: wikilib.ml,v 1.13 2004/10/14 15:57:15 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
@@ -218,9 +218,11 @@ let markup_link dbh hostid link =
     let url, clasz, title =
       if Pcre.pmatch ~rex:url_re url then
 	escape_html_tag url, "external", url (* http://.... *)
-      else if Pcre.pmatch ~rex:mailto_re url then (
+      else if Pcre.pmatch ~rex:mailto_re url then
 	obscure_mailto url, "mailto", url
-      ) else (
+      else if String.length url >= 1 && url.[0] = '/' then (* /index etc. *)
+	escape_html_tag url, "internal", url
+      else (
 	let title = url in
 	(* Look up the 'URL' against the titles in the database and
 	 * obtain the real URL.
@@ -437,7 +439,7 @@ let allowed_elements =
     "br", [];
   ] in
   let headers = [ "h3", []; "h4", []; "h5", []; "h6", [] ] in
-  let links = [ "a", ["href"] ] in
+  let links = [ "a", ["href"; "name"] ] in
   let images = [ "img", ["src"; "alt"; "width"; "height"; "longdesc"] ] in
 
   let forms = [
diff --git a/templates/invite_user.txt b/templates/invite_user.txt
new file mode 100644
index 0000000..9a7f58a
--- /dev/null
+++ b/templates/invite_user.txt
@@ -0,0 +1,6 @@
+::username:: has invited you to join the Team Notepad at
+::hostname::.
+
+To accept this invitation, click here:
+
+http://::hostname::/_invite?p=::password::
\ No newline at end of file
diff --git a/templates/invite_user_confirm.txt b/templates/invite_user_confirm.txt
new file mode 100644
index 0000000..4105993
--- /dev/null
+++ b/templates/invite_user_confirm.txt
@@ -0,0 +1,10 @@
+Thanks for creating a new account.  Please save this email for your
+records.
+
+Your site:	http://::hostname::/
+Username:	::username::
+
+To get you started, we've created a tutorial which you can read online
+or print out.  You can get the tutorial here:
+
+http://www.team-notepad.com/tutorial
diff --git a/templates/invite_user_confirm_form.html b/templates/invite_user_confirm_form.html
new file mode 100644
index 0000000..57d1618
--- /dev/null
+++ b/templates/invite_user_confirm_form.html
@@ -0,0 +1,64 @@
+<!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>Invitation to join</title>
+<meta name="author" content="http://www.merjis.com/" />
+<link rel="stylesheet" href="::theme_css_html_tag::" type="text/css" title="Standard"/>
+</head><body>
+
+<h1>Invitation to join</h1>
+
+<p>
+Thanks for accepting our invitation.
+Please choose a password for your account:
+</p>
+
+<form method="post" action="/_bin/invite_user_confirm.cmo">
+<input type="hidden" name="username" value="::username_html_tag::"/>
+<input type="hidden" name="old_password" value="::old_password_html_tag::"/>
+<table class="left_table">
+<tr>
+<th> Username: </th>
+<td> ::username_html:: </td>
+</tr>
+<tr>
+<th> Password: </th>
+<td> <input type="password" name="password1" value="" size="32"/> </td>
+</tr>
+<tr>
+<th> Password (again to verify): </th>
+<td> <input type="password" name="password2" value="" size="32"/> </td>
+</tr>
+<tr>
+<td></td>
+<td> <input type="submit" value="Set password"/> </td>
+</tr>
+</table>
+</form>
+
+<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/invite_user_exists.txt b/templates/invite_user_exists.txt
new file mode 100644
index 0000000..aba4d6b
--- /dev/null
+++ b/templates/invite_user_exists.txt
@@ -0,0 +1,11 @@
+::username:: has invited you to join the Team Notepad at
+::hostname:: again.
+
+To accept this invitation, please log in at:
+
+http://::hostname::/_login
+
+If you have lost your password, please go here and type in your email
+address:
+
+http://::hostname::/_bin/forgot_password_form.cmo
diff --git a/templates/invite_user_form.html b/templates/invite_user_form.html
new file mode 100644
index 0000000..5196e1f
--- /dev/null
+++ b/templates/invite_user_form.html
@@ -0,0 +1,53 @@
+<!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>Invite someone to join</title>
+<meta name="author" content="http://www.merjis.com/" />
+<link rel="stylesheet" href="::theme_css_html_tag::" type="text/css" title="Standard"/>
+</head><body>
+
+<h1>Invite someone to join</h1>
+
+<p>
+NB. The people you invite will be able to view and
+edit this site.
+</p>
+
+<form method="post" action="invite_user.cmo">
+<p>
+Their e-mail address(es):
+</p>
+<p>
+<textarea name="emails" cols="50" rows="5"></textarea>
+</p>
+<p>
+<input type="submit" value="Invite them"/>
+</p>
+</form>
+
+<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/login_form.html b/templates/login_form.html
index d8f5da1..f13e5b7 100644
--- a/templates/login_form.html
+++ b/templates/login_form.html
@@ -81,10 +81,9 @@
 ::else::
 
 <p>
-Sorry, but the administrator of this site has stopped
-people from anonymously creating accounts.  You will have
-to contact the administrator and ask them to create an
-account for you.
+This site is only available for use to registered members.  If you
+believe that you should be a member of this site, please contact the
+administrator with your email address and reason for joining.
 </p>
 
 ::end::
diff --git a/templates/users.html b/templates/users.html
index bc0d823..8ccff7e 100644
--- a/templates/users.html
+++ b/templates/users.html
@@ -10,7 +10,8 @@
 <h1>Users</h1>
 
 <ul class="menu">
-<li class="first"><a href="/_bin/create_user_form.cmo">Create a user account</a></li>
+<li class="first"><a href="/_bin/invite_user_form.cmo">Invite someone to join</a></li>
+<li><a href="/_bin/create_user_form.cmo">Create a user account</a></li>
 </ul>
 
 <table id="users">
-- 
1.8.3.1