can_manage_site boolean DEFAULT false NOT NULL,
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
+ can_import_mail boolean DEFAULT false NOT NULL,
+ email_notify boolean DEFAULT true NOT NULL
);
--
--- TOC entry 61 (OID 536388)
+-- TOC entry 63 (OID 536388)
-- Name: hostnames_hostid_name_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 62 (OID 536389)
+-- TOC entry 64 (OID 536389)
-- Name: hostnams_name_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 58 (OID 536419)
+-- TOC entry 60 (OID 536419)
-- Name: pages_url_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 63 (OID 536924)
+-- TOC entry 65 (OID 536924)
-- Name: email_notify_email_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 64 (OID 540251)
+-- TOC entry 66 (OID 540251)
-- Name: images_name_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 66 (OID 540252)
+-- TOC entry 68 (OID 540252)
-- Name: files_name_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 69 (OID 540831)
+-- TOC entry 71 (OID 540831)
-- Name: users_name_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 68 (OID 540946)
+-- TOC entry 70 (OID 540946)
-- Name: users_id_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 71 (OID 540970)
+-- TOC entry 73 (OID 540970)
-- Name: sitemenu_ordering_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 72 (OID 540971)
+-- TOC entry 74 (OID 540971)
-- Name: sitemenu_url_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 75 (OID 542626)
+-- TOC entry 77 (OID 542626)
-- Name: contact_emails_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 76 (OID 543505)
+-- TOC entry 78 (OID 543505)
-- Name: themes_theme_css_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 77 (OID 543763)
+-- TOC entry 79 (OID 543763)
-- Name: page_emails_email_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 78 (OID 543795)
+-- TOC entry 80 (OID 543795)
-- Name: mailing_lists_email_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 73 (OID 543880)
+-- TOC entry 75 (OID 543880)
-- Name: contacts_name_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 79 (OID 544454)
+-- TOC entry 81 (OID 544454)
-- Name: links_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 80 (OID 547951)
+-- TOC entry 82 (OID 547951)
-- Name: templates_ext_ord_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 82 (OID 547952)
+-- TOC entry 84 (OID 547952)
-- Name: templates_title_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 83 (OID 547953)
+-- TOC entry 85 (OID 547953)
-- Name: templates_url_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 84 (OID 551151)
+-- TOC entry 86 (OID 551151)
-- Name: recently_visited_uq; Type: INDEX; Schema: public; Owner: rich
--
--
--- TOC entry 85 (OID 552155)
+-- TOC entry 87 (OID 552155)
-- Name: messages_inet_message_id_uq; Type: INDEX; Schema: public; Owner: rich
--
--
+-- TOC entry 59 (OID 552684)
+-- Name: pages_url_ix; Type: INDEX; Schema: public; Owner: rich
+--
+
+CREATE INDEX pages_url_ix ON pages USING btree (url);
+
+
+--
+-- TOC entry 58 (OID 552685)
+-- Name: pages_redirect_ix; Type: INDEX; Schema: public; Owner: rich
+--
+
+CREATE INDEX pages_redirect_ix ON pages USING btree (redirect);
+
+
+--
-- TOC entry 57 (OID 536012)
-- Name: pages_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 59 (OID 536027)
+-- TOC entry 61 (OID 536027)
-- Name: contents_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 60 (OID 536377)
+-- TOC entry 62 (OID 536377)
-- Name: hosts_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 65 (OID 537158)
+-- TOC entry 67 (OID 537158)
-- Name: images_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 67 (OID 537173)
+-- TOC entry 69 (OID 537173)
-- Name: files_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 70 (OID 540825)
+-- TOC entry 72 (OID 540825)
-- Name: users_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 74 (OID 542611)
+-- TOC entry 76 (OID 542611)
-- Name: contacts_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 81 (OID 547945)
+-- TOC entry 83 (OID 547945)
-- Name: templates_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 86 (OID 551681)
+-- TOC entry 88 (OID 551681)
-- Name: messages_pkey; Type: CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 91 (OID 536029)
+-- TOC entry 93 (OID 536029)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 94 (OID 536384)
+-- TOC entry 96 (OID 536384)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 92 (OID 536394)
+-- TOC entry 94 (OID 536394)
-- Name: hosts_hostname_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 87 (OID 536404)
+-- TOC entry 89 (OID 536404)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 95 (OID 536920)
+-- TOC entry 97 (OID 536920)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 96 (OID 537160)
+-- TOC entry 98 (OID 537160)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 97 (OID 537175)
+-- TOC entry 99 (OID 537175)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 88 (OID 539155)
+-- TOC entry 90 (OID 539155)
-- Name: pages_redirect_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 98 (OID 540827)
+-- TOC entry 100 (OID 540827)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 99 (OID 540837)
+-- TOC entry 101 (OID 540837)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 89 (OID 540942)
+-- TOC entry 91 (OID 540942)
-- Name: $2; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 90 (OID 540947)
+-- TOC entry 92 (OID 540947)
-- Name: pages_user_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 100 (OID 540966)
+-- TOC entry 102 (OID 540966)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 101 (OID 540972)
+-- TOC entry 103 (OID 540972)
-- Name: sitemenu_url_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 102 (OID 542613)
+-- TOC entry 104 (OID 542613)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 103 (OID 542622)
+-- TOC entry 105 (OID 542622)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 93 (OID 543506)
+-- TOC entry 95 (OID 543506)
-- Name: hosts_theme_css_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 104 (OID 543759)
+-- TOC entry 106 (OID 543759)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 105 (OID 543764)
+-- TOC entry 107 (OID 543764)
-- Name: page_emails_url_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 106 (OID 543791)
+-- TOC entry 108 (OID 543791)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 107 (OID 544450)
+-- TOC entry 109 (OID 544450)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 108 (OID 544455)
+-- TOC entry 110 (OID 544455)
-- Name: links_from_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 109 (OID 551129)
+-- TOC entry 111 (OID 551129)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 110 (OID 551133)
+-- TOC entry 112 (OID 551133)
-- Name: $2; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 111 (OID 551137)
+-- TOC entry 113 (OID 551137)
-- Name: recently_visited_url_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 112 (OID 551141)
+-- TOC entry 114 (OID 551141)
-- Name: recently_visited_userid_cn; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 114 (OID 551690)
+-- TOC entry 116 (OID 551690)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
--
--- TOC entry 113 (OID 551694)
+-- TOC entry 115 (OID 551694)
-- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich
--
COPY themes (theme_css, name, description) FROM stdin;
/_css/easyweb.css Merjis Easy Web Marketing This is the easy web marketing stylesheet developed by Merjis Ltd. Please see http://www.merjis.com/
+/_css/basic.css Basic styles only Only the most essential styles. This is a good starting point if you want to completely restyle pages using site-specific CSS.
\.
+++ /dev/null
-(* COCANWIKI - a wiki written in Objective CAML.
- * Written by Richard W.M. Jones <rich@merjis.com>.
- * Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_emails.ml,v 1.6 2004/09/23 11:56:47 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
-
-let split_re = Pcre.regexp "[\\r\\n,;]+"
-let email_re = Pcre.regexp "(.*)<(.*)>"
-
-let run r (q : cgi) (dbh : Dbi.connection) _ host' _ =
- let hostid = int_of_string (q#param "hostid") in
-
- if q#param_true "cancel" then (
- let { hostname = hostname } = host' in
- q#redirect ("http://" ^ hostname ^ "/_bin/admin/host.cmo?hostid=" ^
- string_of_int hostid);
- return ()
- );
-
- let emails = try q#param "emails" with Not_found -> "" in
-
- (* It's very hard to verify email addresses. Thus this script
- * should not be exposed to untrusted users.
- *)
- let check_email str =
- let name, email =
- try
- let subs = Pcre.exec ~rex:email_re str in
- Pcre.get_substring subs 1, Pcre.get_substring subs 2
- with
- Not_found ->
- "", str in
-
- (* Trim whitespace. *)
- trim name, trim email
- in
-
- let emails = Pcre.split ~rex:split_re emails in
- let emails = List.map check_email emails in
- let emails = List.filter ((<>) ("","")) emails in
-
- (* Update the database. *)
- let sth = dbh#prepare_cached
- "delete from email_notify where hostid = ?" in
- sth#execute [`Int hostid];
- let sth = dbh#prepare_cached "insert into email_notify (hostid, email, name)
- values (?, ?, ?)" in
- List.iter (fun (name, email) ->
- if name = "" then
- sth#execute [`Int hostid; `String email; `Null]
- else
- sth#execute [`Int hostid; `String email; `String name])
- emails;
-
- (* Commit to the database. *)
- dbh#commit ();
-
- (* Print confirmation page. *)
- let buttons = [
- { StdPages.label = "OK";
- StdPages.link = "/_bin/admin/host.cmo";
- StdPages.method_ = None;
- StdPages.params = [ "hostid", string_of_int hostid ] }
- ] in
-
- ok ~title:"Saved" ~buttons
- q "Email notifications updated."
-
-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: edit_emails_form.ml,v 1.5 2004/09/09 12:21:22 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 template = _get_template "admin/edit_emails_form.html"
-
-let run r (q : cgi) (dbh : Dbi.connection) _ _ _ =
- let hostid = int_of_string (q#param "hostid") in
-
- template#set "id" (string_of_int hostid);
-
- let sth = dbh#prepare_cached
- "select canonical_hostname from hosts where id = ?" in
- sth#execute [`Int hostid];
-
- let canonical_hostname = sth#fetch1string () in
- template#set "canonical_hostname" canonical_hostname;
-
- let sth = dbh#prepare_cached
- "select email, name from email_notify where hostid = ?" in
- sth#execute [`Int hostid];
-
- let emails = sth#map (function
- [`String email; `Null] ->
- email
- | [`String email; `String name] ->
- sprintf "%s <%s>" name email
- | _ -> assert false) in
-
- template#set "emails" (String.concat "\n" emails);
-
- q#template template
-
-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: host.ml,v 1.6 2004/09/09 12:21:22 rich Exp $
+ * $Id: host.ml,v 1.7 2004/10/21 19:54:29 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
| _ -> assert false) in
template#table "hostnames" table;
- (* Pull out any email notifications. *)
- let sth = dbh#prepare_cached "select email, name from email_notify
- where hostid = ?" in
- sth#execute [`Int hostid];
-
- let table = sth#map (function
- [`String email; `Null] ->
- [ "email", Template.VarString email;
- "name", Template.VarString "" ]
- | [ `String email; `String name] ->
- [ "email", Template.VarString email;
- "name", Template.VarString name ]
- | _ -> assert false) in
- template#table "emails" table;
-
q#template template
let () =
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: delete_file.ml,v 1.6 2004/09/09 12:21:22 rich Exp $
+ * $Id: delete_file.ml,v 1.7 2004/10/21 19:54:29 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_ok
open Cocanwiki_emailnotify
-let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ =
+let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } user=
let id = int_of_string (q#param "id") in
if q#param_true "yes" then (
let body = fun () ->
"Page: http://" ^ hostname ^ "/_files?deleted=1" in
- email_notify ~body ~subject dbh hostid;
+ email_notify ~body ~subject ~user dbh hostid;
(* Done. *)
let buttons = [ ok_button "/_files" ] in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: delete_image.ml,v 1.6 2004/09/09 12:21:22 rich Exp $
+ * $Id: delete_image.ml,v 1.7 2004/10/21 19:54:29 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_ok
open Cocanwiki_emailnotify
-let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ =
+let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } user=
let id = int_of_string (q#param "id") in
if q#param_true "yes" then (
let body = fun () ->
"Page: http://" ^ hostname ^ "/_images?deleted=1" in
- email_notify ~body ~subject dbh hostid;
+ email_notify ~body ~subject ~user dbh hostid;
(* Done. *)
let buttons = [ ok_button "/_images" ] in
ok ~title:"Image deleted" ~buttons
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit.ml,v 1.20 2004/10/11 14:13:04 rich Exp $
+ * $Id: edit.ml,v 1.21 2004/10/21 19:54:29 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
"Page: http://" ^ hostname ^ "/" ^ url ^ "\n\n" ^
diff in
- email_notify ~body ~subject dbh hostid;
+ email_notify ~body ~subject ~user dbh hostid;
(* Redirect back to the URL. *)
q#redirect ("http://" ^ hostname ^ "/" ^ url);
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_page_css.ml,v 1.12 2004/10/10 16:14:43 rich Exp $
+ * $Id: edit_page_css.ml,v 1.13 2004/10/21 19:54:29 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
"Page: http://" ^ hostname ^ "/" ^ page ^ "\n\n" ^
diff in
- email_notify ~subject ~body dbh hostid;
+ email_notify ~subject ~body ~user dbh hostid;
let buttons = [ ok_button ("/" ^ page);
{ StdPages.label = "Edit stylesheet again";
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_page_title.ml,v 1.4 2004/10/10 16:14:43 rich Exp $
+ * $Id: edit_page_title.ml,v 1.5 2004/10/21 19:54:29 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
"Old title: " ^ old_title ^ "\n" ^
"New title: " ^ new_title ^ "\n" in
- email_notify ~subject ~body dbh hostid;
+ email_notify ~subject ~body ~user dbh hostid;
let buttons = [ ok_button ("/" ^ page) ] in
ok ~title:"Title changed" ~buttons
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: edit_sitemenu.ml,v 1.5 2004/09/23 11:56:47 rich Exp $
+ * $Id: edit_sitemenu.ml,v 1.6 2004/10/21 19:54:29 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
*)
type model_t = (string * string) list (* label, url *)
-let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ =
+let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } user=
let template = get_template dbh hostid "edit_sitemenu.html" in
(* Workaround bugs in IE, specifically lack of support for <button>
let body = fun () -> "Site: http://" ^ hostname ^ "/\n\n" in
- email_notify ~body ~subject dbh hostid;
+ email_notify ~body ~subject ~user dbh hostid;
let buttons = [ ok_button "/" ] in
ok ~title:"Saved" ~buttons
(* 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.1 2004/10/21 11:42:05 rich Exp $
+ * $Id: cocanwiki_emailnotify.ml,v 1.2 2004/10/21 19:54:29 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 Cgi
open Printf
+open Cocanwiki
+
(* This is where we coordinate email notification from various
* scripts which create or update the wiki.
*)
-let email_notify ~subject ~body (dbh : Dbi.connection) hostid =
- (* Is anyone listed for email notification at this host? *)
- let sth = dbh#prepare_cached "select email, name from email_notify
- where hostid = ?" in
- sth#execute [`Int hostid];
+let email_notify ~subject ~body ?user (dbh : Dbi.connection) hostid =
+ (* Get own userid, if we have it. Don't want to send email
+ * notification back to the person who changed the page. If
+ * we don't have a userid, set it to 0, because no real user can
+ * have userid = 0.
+ *)
+ let own_userid =
+ match user with
+ | None
+ | Some Anonymous -> 0
+ | Some (User (userid, _, _)) -> userid in
+
+ (* Send a change email to everyone who hasn't opted out using
+ * their preferences. This behaviour replaces the old
+ * 'email_notify' table.
+ *)
+ let sth = dbh#prepare_cached "select email, name from users
+ where hostid = ? and id <> ? and email_notify
+ and email is not null" in
+ sth#execute [`Int hostid; `Int own_userid];
let to_addr = sth#map (function
| [`String email; `String name] ->
- name ^ " <" ^ email ^ ">"
- | [`String email; `Null] ->
- email
+ "\"" ^ name ^ "\" <" ^ email ^ ">"
| _ -> assert false) in
if to_addr <> [] then (
+ (* Get the from address of the user, if available. *)
+ let from =
+ match user with
+ | None
+ | Some Anonymous -> None
+ | Some (User (userid, _, _)) ->
+ let sth = dbh#prepare_cached "select email from users
+ where hostid = ? and id = ?" in
+ sth#execute [`Int hostid; `Int userid];
+
+ match sth#fetch1 () with
+ | [ `Null ] -> None
+ | [ `String email ] -> Some email
+ | _ -> assert false in
+
(* Prepare the body of the message. The assumption is that
* this takes time and database access, so we defer the creation
* of the body until we know that someone needs to be notified.
let subject = "Site notice: " ^ subject in
(* Send the email. *)
- Sendmail.send_mail ~subject ~to_addr ~body ()
+ Sendmail.send_mail ~subject ~to_addr ~body ?from ()
)
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: restore.ml,v 1.13 2004/10/10 16:14:43 rich Exp $
+ * $Id: restore.ml,v 1.14 2004/10/21 19:54:29 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
"Page: http://" ^ hostname ^ "/" ^ page ^ "\n\n" ^
diff in
- email_notify ~body ~subject dbh hostid;
+ email_notify ~body ~subject ~user dbh hostid;
(* Done. *)
let buttons = [ ok_button ("/" ^ page) ] in
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: upload_file.ml,v 1.7 2004/09/23 11:56:47 rich Exp $
+ * $Id: upload_file.ml,v 1.8 2004/10/21 19:54:29 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
(* Valid file names. *)
let file_ok_re = Pcre.regexp "^[a-z0-9][-._a-z0-9]*$"
-let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ =
+let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } user=
let name = q#param "name" in
let title = q#param "title" in
let body = fun () ->
"Page: http://" ^ hostname ^ "/_files" in
- email_notify ~body ~subject dbh hostid;
+ email_notify ~body ~subject ~user dbh hostid;
let buttons = [ ok_button "/_files" ] in
ok ~title:"File uploaded" ~buttons
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: upload_image.ml,v 1.7 2004/09/23 11:56:47 rich Exp $
+ * $Id: upload_image.ml,v 1.8 2004/10/21 19:54:29 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
(* Valid image names. *)
let image_ok_re = Pcre.regexp "^[a-z0-9][_a-z0-9]*\\.(jpg|jpeg|gif|ico|png)$"
-let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } _ =
+let run r (q : cgi) (dbh : Dbi.connection) hostid { hostname = hostname } user=
let name = q#param "name" in
let alt = q#param "alt" in
let title = q#param "title" in
let body = fun () ->
"Page: http://" ^ hostname ^ "/_images" in
- email_notify ~body ~subject dbh hostid;
+ email_notify ~body ~subject ~user dbh hostid;
let buttons = [ ok_button "/_images" ] in
ok ~title:"Image uploaded" ~buttons
+++ /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>Edit email change notification for ::canonical_hostname_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/admin.css" type="text/css" title="Standard"/>
-</head><body>
-
-<h1>Edit email change notification for ::canonical_hostname_html::</h1>
-
-<form action="edit_emails.cmo" method="post">
-<input type="hidden" name="hostid" value="::id::"/>
-<table id="host">
-<tr>
-<th> Email addresses: </th>
-<td> <textarea name="emails" rows="10" cols="40">::emails_html_textarea::</textarea> </td>
-</tr>
-<tr>
-<td></td>
-<td>
-<input type="submit" name="save" value="Save"/>
-<input type="submit" name="cancel" value="Cancel"/>
-</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>
-
-<ul id="bottommenu" 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>
-
-<hr/>
-
-<ul id="footer" class="menu">
-<li> <a href="/copyright">Copyright © 2004</a> </li>
-</ul>
-
-</body>
-</html>
\ No newline at end of file
<td> ::total_count_html:: </td>
</tr>
<tr>
- <th> Email notification: </th>
- <td>
- ::table(emails):: ::name_html:: <::email_html::> <br/> ::end::
- <a href="/_bin/admin/edit_emails_form.cmo?hostid=::id::">Edit
- email notification ...</a>
- </td>
-</tr>
-<tr>
<th> Global stylesheet: </th>
<td>
::if(has_css)::This wiki has a global stylesheet.::end::
git.annexia.org / cocanwiki.git / commitdiff