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.
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
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
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
# 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.
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]
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 \
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
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
# 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
cocanwiki_create_host.cmo \
cocanwiki_ext_calendar.cmo
+# cocanwiki_mail.cmo
+
OBJS := \
broken_links.cmo \
change_password.cmo \
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 \
what_links_here.cmo
# Not working:
+# mail_import.cmo
+# mail_import_form.cmo
# visualise_links.cmo
ADMIN_OBJS := \
(* 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
| 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 ()
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 ();
--- /dev/null
+(* 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;
+*)
--- /dev/null
+(* 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).
+ *)
--- /dev/null
+(* 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
--- /dev/null
+(* 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
--- /dev/null
+(* 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
--- /dev/null
+(* 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
(* 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
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
(* 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
open Cocanwiki_date
open Cocanwiki_strings
open Cocanwiki_pages
+open Cocanwiki_mail
let irt_re = Pcre.regexp "<.*?>"
let ws_re = Pcre.regexp "\\s+"
*)
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 ();
(* 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
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.
"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 = [
--- /dev/null
+::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
--- /dev/null
+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
--- /dev/null
+<!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 page</a> </li>
+<li> <a href="/_sitemap">Sitemap</a> </li>
+<li> <a href="/_recent">Recent changes</a> </li>
+</ul>
+
+<div id="menu_div">
+<ul id="bottommenu" class="menu">
+<li class="first"> <a href="/">Home 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 © ::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
--- /dev/null
+::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
--- /dev/null
+<!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 page</a> </li>
+<li> <a href="/_sitemap">Sitemap</a> </li>
+<li> <a href="/_recent">Recent changes</a> </li>
+</ul>
+
+<div id="menu_div">
+<ul id="bottommenu" class="menu">
+<li class="first"> <a href="/">Home 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 © ::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
::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::
<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">
git.annexia.org / cocanwiki.git / commitdiff