User preferences.
User can change their email address, and it is verified.
User can change their email notification status.
Invite user to join is now much less of a hack.
This option has moved to the front page.
Don't send email notifications to non-accepting users.
Administrator can see who has not yet accepted their invitations.
Delete user works again.
Stylesheet fixes throughout user management.
In the database:
Added users.invite
Added pending_email_changes table.
Updated MANIFEST.
scripts/edit_sitemenu.ml
scripts/edit_user.ml
scripts/edit_user_form.ml
+scripts/email_change.ml
scripts/file.ml
scripts/files.ml
scripts/forgot_password.ml
scripts/upload_file_form.ml
scripts/upload_image.ml
scripts/upload_image_form.ml
+scripts/user_prefs.ml
+scripts/user_prefs_form.ml
scripts/users.ml
scripts/visualise_links.ml.
scripts/what_links_here.ml
templates/undelete_image_form.html
templates/upload_file_form.html
templates/upload_image_form.html
+templates/user_prefs_email_change.txt
+templates/user_prefs_form.html
templates/users.html
templates/visualise_links.html
templates/what_links_here.html
-# $Id: Makefile.config,v 1.11 2004/10/22 17:18:12 rich Exp $
+# $Id: Makefile.config,v 1.12 2004/10/23 15:00:13 rich Exp $
PACKAGE := cocanwiki
-VERSION := 1.3.1
+VERSION := 1.3.2
# Normally ignored. However, if you are installing centrally (using
# 'make pkg-install'), then the components are installed in the
--
--- TOC entry 48 (OID 536004)
+-- TOC entry 50 (OID 536004)
-- Name: pages_id_seq; Type: ACL; Schema: public; Owner: rich
--
--
--- TOC entry 49 (OID 536021)
+-- TOC entry 51 (OID 536021)
-- Name: contents_id_seq; Type: ACL; Schema: public; Owner: rich
--
--
--- TOC entry 50 (OID 536371)
+-- TOC entry 52 (OID 536371)
-- Name: hosts_id_seq; Type: ACL; Schema: public; Owner: rich
--
--
--- TOC entry 51 (OID 537151)
+-- TOC entry 53 (OID 537151)
-- Name: images_id_seq; Type: ACL; Schema: public; Owner: rich
--
--
--- TOC entry 52 (OID 537166)
+-- TOC entry 54 (OID 537166)
-- Name: files_id_seq; Type: ACL; Schema: public; Owner: rich
--
can_edit_global_css boolean DEFAULT false NOT NULL,
force_password_change boolean DEFAULT false NOT NULL,
can_import_mail boolean DEFAULT false NOT NULL,
- email_notify boolean DEFAULT true NOT NULL
+ email_notify boolean DEFAULT true NOT NULL,
+ invite text
);
--
--- TOC entry 53 (OID 540816)
+-- TOC entry 55 (OID 540816)
-- Name: users_id_seq; Type: ACL; Schema: public; Owner: rich
--
--
--- TOC entry 54 (OID 542605)
+-- TOC entry 56 (OID 542605)
-- Name: contacts_id_seq; Type: ACL; Schema: public; Owner: rich
--
--
--- TOC entry 55 (OID 547939)
+-- TOC entry 57 (OID 547939)
-- Name: templates_id_seq; Type: ACL; Schema: public; Owner: rich
--
--
--- TOC entry 56 (OID 551675)
+-- TOC entry 58 (OID 551675)
-- Name: messages_id_seq; Type: ACL; Schema: public; Owner: rich
--
--
--- TOC entry 63 (OID 536388)
+-- TOC entry 48 (OID 607136)
+-- Name: pending_email_changes; Type: TABLE; Schema: public; Owner: rich
+--
+
+CREATE TABLE pending_email_changes (
+ "key" text NOT NULL,
+ change_date date DEFAULT ('now'::text)::date NOT NULL,
+ userid integer NOT NULL,
+ email text NOT NULL
+);
+
+
+--
+-- TOC entry 49 (OID 607136)
+-- Name: pending_email_changes; Type: ACL; Schema: public; Owner: rich
+--
+
+REVOKE ALL ON TABLE pending_email_changes FROM PUBLIC;
+GRANT ALL ON TABLE pending_email_changes TO "www-data";
+
+
+--
+-- TOC entry 65 (OID 536388)
-- Name: hostnames_hostid_name_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 64 (OID 536389)
+-- TOC entry 66 (OID 536389)
-- Name: hostnams_name_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 60 (OID 536419)
+-- TOC entry 62 (OID 536419)
-- Name: pages_url_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 65 (OID 540251)
+-- TOC entry 67 (OID 540251)
-- Name: images_name_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 67 (OID 540252)
+-- TOC entry 69 (OID 540252)
-- Name: files_name_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 70 (OID 540831)
+-- TOC entry 72 (OID 540831)
-- Name: users_name_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 69 (OID 540946)
+-- TOC entry 71 (OID 540946)
-- Name: users_id_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 72 (OID 540970)
+-- TOC entry 74 (OID 540970)
-- Name: sitemenu_ordering_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 73 (OID 540971)
+-- TOC entry 75 (OID 540971)
-- Name: sitemenu_url_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 76 (OID 542626)
+-- TOC entry 78 (OID 542626)
-- Name: contact_emails_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 77 (OID 543505)
+-- TOC entry 79 (OID 543505)
-- Name: themes_theme_css_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 78 (OID 543763)
+-- TOC entry 80 (OID 543763)
-- Name: page_emails_email_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 79 (OID 543795)
+-- TOC entry 81 (OID 543795)
-- Name: mailing_lists_email_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 74 (OID 543880)
+-- TOC entry 76 (OID 543880)
-- Name: contacts_name_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 80 (OID 544454)
+-- TOC entry 82 (OID 544454)
-- Name: links_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 81 (OID 547951)
+-- TOC entry 83 (OID 547951)
-- Name: templates_ext_ord_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 83 (OID 547952)
+-- TOC entry 85 (OID 547952)
-- Name: templates_title_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 84 (OID 547953)
+-- TOC entry 86 (OID 547953)
-- Name: templates_url_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 85 (OID 551151)
+-- TOC entry 87 (OID 551151)
-- Name: recently_visited_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 86 (OID 552155)
+-- TOC entry 88 (OID 552155)
-- Name: messages_inet_message_id_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 59 (OID 552684)
+-- TOC entry 61 (OID 552684)
-- Name: pages_url_ix; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 58 (OID 552685)
+-- TOC entry 60 (OID 552685)
-- Name: pages_redirect_ix; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 57 (OID 536012)
+-- TOC entry 59 (OID 536012)
-- Name: pages_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 61 (OID 536027)
+-- TOC entry 63 (OID 536027)
-- Name: contents_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 62 (OID 536377)
+-- TOC entry 64 (OID 536377)
-- Name: hosts_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 66 (OID 537158)
+-- TOC entry 68 (OID 537158)
-- Name: images_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 68 (OID 537173)
+-- TOC entry 70 (OID 537173)
-- Name: files_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 71 (OID 540825)
+-- TOC entry 73 (OID 540825)
-- Name: users_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 75 (OID 542611)
+-- TOC entry 77 (OID 542611)
-- Name: contacts_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 82 (OID 547945)
+-- TOC entry 84 (OID 547945)
-- Name: templates_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 87 (OID 551681)
+-- TOC entry 89 (OID 551681)
-- Name: messages_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 88 (OID 607081)
+-- TOC entry 90 (OID 607081)
-- Name: powered_by_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 93 (OID 536029)
+-- TOC entry 91 (OID 607141)
+-- Name: pending_email_changes_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
+--
+
+ALTER TABLE ONLY pending_email_changes
+ ADD CONSTRAINT pending_email_changes_pkey PRIMARY KEY ("key");
+
+
+--
+-- TOC entry 96 (OID 536029)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 97 (OID 536384)
+-- TOC entry 100 (OID 536384)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 94 (OID 536394)
+-- TOC entry 97 (OID 536394)
-- Name: hosts_hostname_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 89 (OID 536404)
+-- TOC entry 92 (OID 536404)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 98 (OID 537160)
+-- TOC entry 101 (OID 537160)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 99 (OID 537175)
+-- TOC entry 102 (OID 537175)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 90 (OID 539155)
+-- TOC entry 93 (OID 539155)
-- Name: pages_redirect_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 100 (OID 540827)
+-- TOC entry 103 (OID 540827)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 101 (OID 540837)
+-- TOC entry 104 (OID 540837)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 91 (OID 540942)
+-- TOC entry 94 (OID 540942)
-- Name: $2; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 92 (OID 540947)
+-- TOC entry 95 (OID 540947)
-- Name: pages_user_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 102 (OID 540966)
+-- TOC entry 105 (OID 540966)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 103 (OID 540972)
+-- TOC entry 106 (OID 540972)
-- Name: sitemenu_url_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 104 (OID 542613)
+-- TOC entry 107 (OID 542613)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 105 (OID 542622)
+-- TOC entry 108 (OID 542622)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 95 (OID 543506)
+-- TOC entry 98 (OID 543506)
-- Name: hosts_theme_css_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 106 (OID 543759)
+-- TOC entry 109 (OID 543759)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 107 (OID 543764)
+-- TOC entry 110 (OID 543764)
-- Name: page_emails_url_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 108 (OID 543791)
+-- TOC entry 111 (OID 543791)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 109 (OID 544450)
+-- TOC entry 112 (OID 544450)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 110 (OID 544455)
+-- TOC entry 113 (OID 544455)
-- Name: links_from_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 111 (OID 551129)
+-- TOC entry 114 (OID 551129)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 112 (OID 551133)
+-- TOC entry 115 (OID 551133)
-- Name: $2; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 113 (OID 551137)
+-- TOC entry 116 (OID 551137)
-- Name: recently_visited_url_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 114 (OID 551141)
+-- TOC entry 117 (OID 551141)
-- Name: recently_visited_userid_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 116 (OID 551690)
+-- TOC entry 119 (OID 551690)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 115 (OID 551694)
+-- TOC entry 118 (OID 551694)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 96 (OID 607083)
+-- TOC entry 99 (OID 607083)
-- Name: hosts_powered_by_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
+-- TOC entry 120 (OID 607143)
+-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
+--
+
+ALTER TABLE ONLY pending_email_changes
+ ADD CONSTRAINT "$1" FOREIGN KEY (userid) REFERENCES users(id);
+
+
+--
-- TOC entry 3 (OID 2200)
-- Name: SCHEMA public; Type: COMMENT; Schema: -; Owner: postgres
--
# Apache configuration for COCANWIKI.
-# $Id: cocanwiki.conf,v 1.15 2004/10/18 13:34:21 rich Exp $
+# $Id: cocanwiki.conf,v 1.16 2004/10/23 15:00:14 rich Exp $
# Uncomment the following lines if necessary. You will probably need
# to adjust the paths to reflect where cocanwiki is really installed.
# Global scripts.
RewriteRule ^/_admin$ /_bin/admin/admin.cmo [PT,L,QSA]
RewriteRule ^/_contact$ /_bin/contact.cmo [PT,L,QSA]
+RewriteRule ^/_email_change$ /_bin/email_change.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 ^/_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 ^/_userprefs$ /_bin/user_prefs_form.cmo [PT,L,QSA]
RewriteRule ^/_users$ /_bin/users.cmo [PT,L,QSA]
# Image and file downloads.
-cocanwiki (1.3.1-1) unstable; urgency=low
+cocanwiki (1.3.2-1) unstable; urgency=low
* Initial Release.
Source: cocanwiki
Priority: optional
Maintainer: Richard W.M. Jones <rich@annexia.org>
-Build-Depends: debhelper (>= 4.0.0), libpcre-ocaml-dev, libpgsql-ocaml-dev, libextlib-ocaml-dev, ocaml-findlib, ocaml-nox-3.08, libapache-mod-caml, libtemplate-ocaml-dev, ocamldsort (>= 0.14.2)
+Build-Depends: debhelper (>= 4.0.0), libpcre-ocaml-dev, libpgsql-ocaml-dev, libextlib-ocaml-dev, ocaml-findlib, ocaml-nox-3.08, libapache-mod-caml (>= 1.3.2), libtemplate-ocaml-dev (>= 1.3.2), ocamldsort (>= 0.14.2)
Standards-Version: 3.6.1
Package: cocanwiki
Section: web
Architecture: all
Depends: libpgsql-ocaml, libdbi-ocaml (>= 0.9.9), libpcre-ocaml,
- ocaml-base-nox-3.08, libapache-mod-caml, libtemplate-ocaml-dev,
+ ocaml-base-nox-3.08, libapache-mod-caml (>= 1.3.2),
+ libtemplate-ocaml-dev (>= 1.3.2),
libocamlnet-ocaml-dev (>= 0.98),
imagemagick, curl (>= 7.12.1)
Suggests: apache
/* Stylesheet for COCANWIKI, derived from EWM.
- * $Id: users.css,v 1.3 2004/09/08 12:45:37 rich Exp $
+ * $Id: users.css,v 1.4 2004/10/23 15:00:14 rich Exp $
*/
-table#users {
- border-collapse: collapse;
-}
-
-table#users th {
- border: 1px solid #000;
- vertical-align: top;
- text-align: center;
- padding: 6px;
-}
-
-table#users td {
- border: 1px solid #eee;
- padding: 6px;
-}
-
-table#edit_user th {
- vertical-align: top;
- text-align: right;
+span.pending {
+ font-weight: bold;
+ color: #f00;
}
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: delete_user.ml,v 1.2 2004/09/23 11:56:47 rich Exp $
+ * $Id: delete_user.ml,v 1.3 2004/10/23 15:00:14 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
| _ -> () in
(* Delete the user. *)
+ let sth =
+ dbh#prepare_cached "delete from recently_visited
+ where userid = ? and hostid = ?" in
+ sth#execute [`Int userid; `Int hostid];
+
+ let sth =
+ dbh#prepare_cached "delete from pending_email_changes
+ where userid = ?" in
+ sth#execute [`Int userid];
+
+
let sth = dbh#prepare_cached "delete from usercookies where userid = ?" in
sth#execute [`Int userid];
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_user.ml,v 1.7 2004/10/11 14:13:04 rich Exp $
+ * $Id: edit_user.ml,v 1.8 2004/10/23 15:00:14 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
sth#execute [`String name; `Int hostid; `Int userid]
);
- (* Change email address and permissions. *)
- let email = trim (q#param "email") in
- let email = if email = "" then `Null else `String email in
-
+ (* Change permissions. *)
let can_edit = q#param_true "can_edit" in
let can_manage_users = q#param_true "can_manage_users" in
let can_manage_contacts = q#param_true "can_manage_contacts" in
return ()
| _ -> ());
- let sth = dbh#prepare_cached "update users set email = ?,
+ let sth = dbh#prepare_cached "update users set
can_edit = ?, can_manage_users = ?,
can_manage_contacts = ?,
can_manage_site = ?,
can_edit_global_css = ?,
can_import_mail = ?
where hostid = ? and id = ?" in
- sth#execute [email; `Bool can_edit; `Bool can_manage_users;
+ sth#execute [`Bool can_edit; `Bool can_manage_users;
`Bool can_manage_contacts; `Bool can_manage_site;
`Bool can_edit_global_css; `Bool can_import_mail;
`Int hostid; `Int userid];
--- /dev/null
+(* COCANWIKI - a wiki written in Objective CAML.
+ * Written by Richard W.M. Jones <rich@merjis.com>.
+ * Copyright (C) 2004 Merjis Ltd.
+ * $Id: email_change.ml,v 1.1 2004/10/23 15:00:14 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 _ _ =
+ (* Get the key in the pending_email_changes table. *)
+ let key = q#param "key" in
+
+ let sth = dbh#prepare_cached "select userid, email from pending_email_changes
+ where key = ?" in
+ sth#execute [`String key];
+
+ let userid, email =
+ try
+ (match sth#fetch1 () with
+ [ `Int userid; `String email ] -> userid, email
+ | _ -> assert false)
+ with
+ Not_found ->
+ error ~title:"Already verified"
+ q ("It looks like you have already verified this email address.");
+ return () in
+
+ (* Update the database. *)
+ let sth = dbh#prepare_cached "delete from pending_email_changes
+ where key = ?" in
+ sth#execute [`String key];
+
+ let sth = dbh#prepare_cached "update users set email = ? where id = ?" in
+ sth#execute [`String email; `Int userid];
+
+ dbh#commit ();
+
+ ok ~title:"Email address verified"
+ q "Thank you for verifying your new email address."
+
+let () =
+ register_script run
(* 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 $
+ * $Id: invite_user.ml,v 1.2 2004/10/23 15:00: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
*)
List.iter
(fun email ->
- let sth = dbh#prepare_cached "select id from users
+ let sth = dbh#prepare_cached "select id, invite 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 ->
+ try
+ (match sth#fetch1 () with
+ [ `Int userid; `Null ] ->
+ (* Existing user account - send reminder. *)
+ template_exists#set "username" username;
+ template_exists#set "hostname" hostname;
+ template_exists#to_string
+
+ | [ `Int userid; `String invite ] ->
+ (* Existing user account - resend the invite. *)
+ template#set "username" username;
+ template#set "hostname" hostname;
+ template#set "invite" invite;
+ template#to_string
+
+ | _ -> assert false)
+ with
+ Not_found ->
(* Add user account. *)
- let password = random_sessionid () in
+ let invite = 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];
+ password, email, invite) values (?, ?, ?, ?, ?)" in
+ sth#execute [`Int hostid; `String email; `String invite;
+ `String email; `String invite];
template#set "username" username;
template#set "hostname" hostname;
- template#set "password" password;
+ template#set "invite" invite;
template#to_string in
(* Send the email. *)
(* 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 $
+ * $Id: invite_user_confirm.ml,v 1.2 2004/10/23 15:00: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 template = _get_template "invite_user_confirm.txt" in
let username = q#param "username" in
- let old_password = q#param "old_password" in
+ let invite = q#param "invite" in
- assert (String.length old_password = 32 &&
- string_for_all isxdigit old_password);
-
- (* Verify the username, old_password combination. *)
+ (* Verify the username, invite 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];
+ name = ? and invite = ?" in
+ sth#execute [`Int hostid; `String username; `String invite];
let email, userid =
try
| [ `Null; `Int userid ] -> None, userid
| _ -> assert false
with Not_found ->
- error ~title:"Bad password"
- ~back_button:true
- q "The password you gave is wrong.";
+ error ~title:"Already signed up"
+ q "It looks like you have already used your invitation.";
return () in
let password1 = q#param "password1" in
(* Change the password. *)
let sth =
dbh#prepare_cached
- "update users set password = ?, force_password_change = false
+ "update users set password = ?, invite = null,
+ force_password_change = false
where hostid = ? and id = ?" in
sth#execute [`String password; `Int hostid; `Int userid];
(* 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 $
+ * $Id: invite_user_confirm_form.ml,v 1.2 2004/10/23 15:00: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
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);
+ (* Get the invite ID. *)
+ let invite = q#param "p" in
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
+ where hostid = ? and invite = ?" in
+ sth#execute [`Int hostid; `String invite];
+
+ let username =
+ try sth#fetch1string ()
+ with
+ Not_found ->
+ error ~title:"Already signed up"
+ q ("It looks like you have already used your invitation. If " ^
+ "you cannot get to your account, please contact the " ^
+ "administrator.");
+ return () in
(* Update the template so that the user can set their preferred password. *)
template#set "username" username;
- template#set "old_password" password;
+ template#set "invite" invite;
q#template template
(* 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.2 2004/10/21 19:54:29 rich Exp $
+ * $Id: cocanwiki_emailnotify.ml,v 1.3 2004/10/23 15:00:16 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
(* Send a change email to everyone who hasn't opted out using
* their preferences. This behaviour replaces the old
- * 'email_notify' table.
+ * 'email_notify' table. Don't send email to invited accounts
+ * who have not yet confirmed.
*)
let sth = dbh#prepare_cached "select email, name from users
where hostid = ? and id <> ? and email_notify
- and email is not null" in
+ and email is not null
+ and invite is null" in
sth#execute [`Int hostid; `Int own_userid];
let to_addr = sth#map (function
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: page.ml,v 1.35 2004/10/23 12:00:23 rich Exp $
+ * $Id: page.ml,v 1.36 2004/10/23 15:00: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
navigation
| _ -> assert false in
- (* Can the user edit? *)
+ (* User permissions. *)
let can_edit = can_edit host user in
+ let can_manage_users = can_manage_users host user in
(* Do we have a stats page set up? *)
let has_stats = server_settings_stats_page dbh <> None in
t#conditional "navigation" navigation;
t#conditional "can_edit" can_edit;
+ t#conditional "can_manage_users" can_manage_users;
t#conditional "has_stats" has_stats;
(* Pull out the sections in this page. *)
t#conditional "has_host_css" has_host_css;
t#conditional "can_edit" can_edit;
+ t#conditional "can_manage_users" can_manage_users;
t#conditional "has_stats" has_stats;
q#template t
--- /dev/null
+(* COCANWIKI - a wiki written in Objective CAML.
+ * Written by Richard W.M. Jones <rich@merjis.com>.
+ * Copyright (C) 2004 Merjis Ltd.
+ * $Id: user_prefs.ml,v 1.1 2004/10/23 15:00:16 rich Exp $
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; see the file COPYING. If not, write to
+ * the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ * Boston, MA 02111-1307, USA.
+ *)
+
+open Apache
+open Registry
+open Cgi
+open Printf
+
+open Cocanwiki
+open Cocanwiki_ok
+open Cocanwiki_template
+open Cocanwiki_strings
+
+let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname=hostname} user =
+ let email_change_template = _get_template "user_prefs_email_change.txt" in
+
+ (* Get the fields. *)
+ let new_email = trim (q#param "email") in
+ let email_notify = q#param_true "email_notify" in
+
+ let userid =
+ match user with
+ Anonymous -> assert false
+ | User (userid, _, _) -> userid in
+
+ (* Update the email notify field. *)
+ let sth =
+ dbh#prepare_cached "update users set email_notify = ?
+ where hostid = ? and id = ?" in
+ sth#execute [`Bool email_notify; `Int hostid; `Int userid];
+
+ (* Have we changed the email address? *)
+ let confirm_needed =
+ if new_email = "" then (
+ (* Set the email field in the database to null. No need for
+ * any confirmation.
+ *)
+ let sth = dbh#prepare_cached "update users set email = null
+ where hostid = ? and id = ?" in
+ sth#execute [`Int hostid; `Int userid];
+
+ false
+ ) else (
+ (* Is the new email address different from the one currently recorded
+ * in the database?
+ *)
+ let sth = dbh#prepare_cached "select ? = coalesce (email, '')
+ from users where hostid = ? and id = ?" in
+ sth#execute [`Int hostid; `Int userid];
+
+ let changed =
+ match sth#fetch1 () with [ `Bool b ] -> b | _ -> assert false in
+
+ if changed then (
+ let key = random_sessionid () in
+ (* Changed, so we add to the pending_email_changes table. *)
+ let sth = dbh#prepare_cached "insert into pending_email_changes
+ (key, userid, email) values (?, ?, ?)" in
+ sth#execute [`String key; `Int userid; `String new_email];
+
+ (* Send the confirm email. *)
+ email_change_template#set "hostname" hostname;
+ email_change_template#set "key" key;
+ let body = email_change_template#to_string in
+
+ let subject = "Please verify your new email address at " ^ hostname in
+ Sendmail.send_mail ~subject ~to_addr:[new_email] ~body ()
+ );
+
+ changed
+ ) in
+
+ (* Good place to remove old rows in the pending_email_changes table. *)
+ let sth = dbh#prepare_cached "delete from pending_email_changes
+ where change_date - current_date > 7" in
+ sth#execute [];
+
+ (* Commit and finish off. *)
+ dbh#commit ();
+
+ ok ~title:"Preferences updated"
+ q ("Your user preferences were updated. " ^
+ if confirm_needed then
+ ("Because you changed your email address, we have sent a " ^
+ "confirmation email to your new address. You will need to " ^
+ "click on the link in that email to verify your new address.")
+ else
+ "")
+
+let () =
+ register_script ~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: user_prefs_form.ml,v 1.1 2004/10/23 15:00:16 rich Exp $
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; see the file COPYING. If not, write to
+ * the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+ * Boston, MA 02111-1307, USA.
+ *)
+
+open Apache
+open Registry
+open Cgi
+open Printf
+
+open Cocanwiki
+open Cocanwiki_template
+open Cocanwiki_date
+
+let run r (q : cgi) (dbh : Dbi.connection) hostid _ user =
+ let template = get_template dbh hostid "user_prefs_form.html" in
+
+ let userid =
+ match user with
+ | Anonymous -> assert false
+ | User (userid, _, _) -> userid in
+
+ (* Pull out the preferences. *)
+ let sth =
+ dbh#prepare_cached
+ "select name, email, registration_date, can_edit, email_notify
+ from users where hostid = ? and id = ?" in
+ sth#execute [`Int hostid; `Int userid];
+
+ let name, email, has_email, registration_date, can_edit, email_notify =
+ match sth#fetch1 () with
+ [ `String name; (`Null | `String _) as email;
+ `Date registration_date; `Bool can_edit; `Bool email_notify ] ->
+ let email, has_email =
+ match email with
+ `Null -> "", false
+ | `String email -> email, true in
+ name, email, has_email, registration_date,
+ can_edit, email_notify
+ | _ -> assert false in
+
+ template#set "name" name;
+ template#set "email" email;
+ template#conditional "has_email" has_email;
+ template#set "registration_date" (printable_date' registration_date);
+ template#conditional "can_edit" can_edit;
+ template#conditional "email_notify" email_notify;
+
+ q#template template
+
+let () =
+ register_script ~anonymous:false run
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: users.ml,v 1.7 2004/10/11 14:13:04 rich Exp $
+ * $Id: users.ml,v 1.8 2004/10/23 15:00:16 rich Exp $
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
let sth =
dbh#prepare_cached
- "select id, name, email, registration_date, can_edit, can_manage_users,
+ "select id, name, email, registration_date, invite is not null,
+ can_edit, can_manage_users,
can_manage_contacts, can_manage_site, can_edit_global_css,
can_import_mail
from users where hostid = ? order by name" in
sth#map
(function
[`Int userid; `String name; (`Null | `String _) as email;
- `Date registration_date;
+ `Date registration_date; `Bool invite_pending;
`Bool can_edit; `Bool can_manage_users;
`Bool can_manage_contacts; `Bool can_manage_site;
`Bool can_edit_global_css; `Bool can_import_mail] ->
"email", Template.VarString email;
"registration_date",
Template.VarString (printable_date' registration_date);
+ "invite_pending",
+ Template.VarConditional invite_pending;
"can_edit", Template.VarConditional can_edit;
"can_manage_users", Template.VarConditional can_manage_users;
"can_manage_contacts",
<meta name="author" content="http://www.merjis.com/" />
<link rel="stylesheet" href="::theme_css_html_tag::" type="text/css" title="Standard"/>
<link rel="alternate stylesheet" href="/_css/easytoread.css" type="text/css" title="High contrast, big fonts"/>
-<link rel="stylesheet" href="/_css/users.css" type="text/css" title="Standard"/>
</head><body>
<h1>Create a user account</h1>
<form method="post" action="/_bin/create_user.cmo">
-<table id="edit_user">
+<table class="left_table">
<tr>
<th> Username: </th>
<meta name="author" content="http://www.merjis.com/" />
<link rel="stylesheet" href="::theme_css_html_tag::" type="text/css" title="Standard"/>
<link rel="alternate stylesheet" href="/_css/easytoread.css" type="text/css" title="High contrast, big fonts"/>
-<link rel="stylesheet" href="/_css/users.css" type="text/css" title="Standard"/>
</head><body>
<h1>Delete user: ::username_html::</h1>
Are you sure you want to delete this user?
</p>
-<table id="edit_user">
+<table class="left_table">
<tr>
<th> Username: </th>
<td> ::username_html:: </td>
<head>
<title>User: ::name_html::</title>
<meta name="author" content="http://www.merjis.com/" />
-<link rel="stylesheet" href="/_css/standard.css" type="text/css" title="Standard"/>
-<link rel="stylesheet" href="/_css/users.css" type="text/css" title="Standard"/>
+<link rel="stylesheet" href="::theme_css_html_tag::" type="text/css" title="Standard"/>
+<link rel="alternate stylesheet" href="/_css/easytoread.css" type="text/css" title="High contrast, big fonts"/>
</head><body>
<h1>User: ::name_html::</h1>
<form method="post" action="/_bin/edit_user.cmo">
<input type="hidden" name="userid" value="::userid::"/>
-<table id="edit_user">
+<table class="left_table">
<tr>
<th> Username: </th>
</tr>
<tr>
<th> Email: </th>
-<td> <input name="email" value="::email_html_tag::" size="40"/> </td>
+<td> ::email_html:: </td>
</tr>
<tr>
<th> Permissions: </th>
To accept this invitation, click here:
-http://::hostname::/_invite?p=::password::
\ No newline at end of file
+http://::hostname::/_invite?p=::invite::
\ No newline at end of file
<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::"/>
+<input type="hidden" name="invite" value="::invite_html_tag::"/>
<table class="left_table">
<tr>
<th> Username: </th>
<ul id="editmenu" class="menu">
-<li class="first login_li"> ::if(user_logged_in):: ::username_html:: (<a href="/_prefs">prefs</a>, <a href="/_logout">logout</a>) ::else:: <a href="/_login">Create account or log in</a> ::end:: </li>
+<li class="first login_li"> ::if(user_logged_in):: ::username_html:: (<a href="/_
userprefs">prefs</a>, <a href="/_logout">logout</a>) ::else:: <a href="/_login">Create account or log in</a> ::end:: </li>
::if(can_edit)::
<li class="edit_li"> <a href="/::page_html_tag::/edit"><strong>Edit this page</strong></a> </li>
<li class="maillist_li"> <a href="/_bin/mailing_list_form.cmo">Join our mailing list</a> </li>
::end::
-::if(can_edit)::
-<li> <a href="/_bin/host_menu.cmo">Sitewide settings</a> </li>
+::if(can_manage_users)::
+<li class="invite_li"> <a href="/_bin/invite_user_form.cmo">Invite someone to join</a> </li>
::end::
-::if(user_logged_in)::
-<li> <a href="/_bin/change_password_form.cmo">Change password</a> (XXX TEMP XXX) </li>
+::if(can_edit)::
+<li> <a href="/_bin/host_menu.cmo">Sitewide settings</a> </li>
::end::
</ul>
<meta name="author" content="http://www.merjis.com/" />
<link rel="stylesheet" href="::theme_css_html_tag::" type="text/css" title="Standard"/>
<link rel="alternate stylesheet" href="/_css/easytoread.css" type="text/css" title="High contrast, big fonts"/>
-<link rel="stylesheet" href="/_css/users.css" type="text/css" title="Standard"/>
</head><body>
<h1>Set password for this user</h1>
<form method="post" action="/_bin/set_password.cmo">
<input type="hidden" name="userid" value="::userid::"/>
-<table id="edit_user">
+<table class="left_table">
<tr>
<th> Username: </th>
--- /dev/null
+You (or someone claiming to be you) requested a change of email
+address at ::hostname::.
+
+To proceed with this change of email address, please verify by
+clicking on the link below:
+
+http://::hostname::/_email_change?key=::invite::
\ No newline at end of file
--- /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>Your preferences</title>
+<meta name="author" content="http://www.merjis.com/" />
+<link rel="stylesheet" href="::theme_css_html_tag::" type="text/css" title="Standard"/>
+<link rel="alternate stylesheet" href="/_css/easytoread.css" type="text/css" title="High contrast, big fonts"/>
+</head><body>
+
+<h1>Your preferences</h1>
+
+<form method="post" action="/_bin/user_prefs.cmo">
+<table class="left_table">
+<tr>
+ <th> Username: </th>
+ <td> ::name_html:: </td>
+</tr>
+<tr>
+ <th> Password: </th>
+ <td> <a href="/_bin/change_password_form.cmo">Change your password ...</a> </td>
+</tr>
+<tr>
+ <th> Email address: </th>
+ <td> <input name="email" value="::email_html_tag::" size="40"/> </td>
+</tr>
+<tr>
+ <th> User since: </th>
+ <td> ::registration_date_html:: </td>
+</tr>
+<tr>
+ <th> Edit permission: </th>
+ <td> ::if(can_edit)::Yes::else::No::end:: </td>
+</tr>
+<tr>
+ <td></td>
+ <td> <input type="checkbox" id="email_notify" name="email_notify" value="1" ::if(email_notify)::checked="checked"::end::/> <label for="email_notify">Receive email notifications <small>when the site is edited</small></label> </td>
+</tr>
+<tr>
+ <td></td>
+ <td> <input type="submit" value="Update preferences"/> </td>
+</tr>
+</table>
+</form>
+
+::include(footer.html)::
+</body>
+</html>
\ No newline at end of file
<li><a href="/_bin/create_user_form.cmo">Create a user account</a></li>
</ul>
-<table id="users">
+<table class="top_table">
<tr>
-<th rowspan="2"> Username </th>
-<th rowspan="2"> Email address </th>
+<th rowspan="2"> Username, email address </th>
<th rowspan="2"> Registration </th>
<th colspan="6"> Permissions </th>
</tr>
::table(users)::
<tr>
-<td> <a href="/_bin/edit_user_form.cmo?userid=::userid::" title="Modify details, permissions, set password, or delete this user"><strong>::name_html::</strong></a> </td>
-<td> ::email_html:: </td>
-<td> ::registration_date_html:: </td>
+<td>
+ <a href="/_bin/edit_user_form.cmo?userid=::userid::" title="Modify details, permissions, set password, or delete this user"><strong>::name_html::</strong></a> <br/>
+ <small> ::email_html:: </small>
+</td>
+<td>
+ ::registration_date_html::::if(invite_pending)::<span class="pending">*</span>::end::
+</td>
<td> ::if(can_edit)::<img src="/_graphics/tick.png" width="10" height="10" alt="Can edit"/>::end:: </td>
<td> ::if(can_manage_users)::<img src="/_graphics/tick.png" width="10" height="10" alt="Can manage users"/>::end:: </td>
<td> ::if(can_manage_contacts)::<img src="/_graphics/tick.png" width="10" height="10" alt="Can manage contacts"/>::end:: </td>
<td> ::if(can_import_mail)::<img src="/_graphics/tick.png" width="10" height="10" alt="Can import mail"/>::end:: </td>
</tr>
::end::
-
</table>
+<p>
+<span class="pending">*</span> User has been invited, but has not yet
+accepted the invitation.
+</p>
+
<h2>Explanation of permissions</h2>
<dl>
git.annexia.org / cocanwiki.git / commitdiff