From: rich Date: Mon, 11 Oct 2004 14:13:03 +0000 (+0000) Subject: BIG, experimental patch. X-Git-Url: http://git.annexia.org/?a=commitdiff_plain;h=6eacefcb7258db7b56fe796af84961cafac90eac;p=cocanwiki.git BIG, experimental patch. (1) Factored out the common page creation and editing code into a separate library. edit.ml now uses this library, although nothing else does (yet). (2) Import_mail script (first part of Mail2Wiki) imports mails and saves them in the database. Much missing at the moment. (3) Added a 'can_import_mail' permission. Code now depends on Netstring library (for mail and date parsing). --- diff --git a/cocanwiki.sql b/cocanwiki.sql index dbd87b2..b9ab1c3 100644 --- a/cocanwiki.sql +++ b/cocanwiki.sql @@ -265,7 +265,8 @@ CREATE TABLE users ( can_manage_contacts boolean DEFAULT false NOT NULL, 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 + force_password_change boolean DEFAULT false NOT NULL, + can_import_mail boolean DEFAULT false NOT NULL ); @@ -585,7 +586,8 @@ GRANT ALL ON TABLE messages_id_seq TO "www-data"; CREATE TABLE msg_references ( message_id integer NOT NULL, - inet_message_id text NOT NULL + inet_message_id text NOT NULL, + ordering integer NOT NULL ); @@ -759,6 +761,14 @@ CREATE UNIQUE INDEX recently_visited_uq ON recently_visited USING btree (userid, -- +-- TOC entry 85 (OID 552155) +-- Name: messages_inet_message_id_uq; Type: INDEX; Schema: public; Owner: rich +-- + +CREATE UNIQUE INDEX messages_inet_message_id_uq ON messages USING btree (hostid, inet_message_id); + + +-- -- TOC entry 57 (OID 536012) -- Name: pages_pkey; Type: CONSTRAINT; Schema: public; Owner: rich -- @@ -840,15 +850,6 @@ ALTER TABLE ONLY messages -- --- TOC entry 85 (OID 551683) --- Name: messages_inet_message_id_key; Type: CONSTRAINT; Schema: public; Owner: rich --- - -ALTER TABLE ONLY messages - ADD CONSTRAINT messages_inet_message_id_key UNIQUE (inet_message_id); - - --- -- TOC entry 91 (OID 536029) -- Name: $1; Type: FK CONSTRAINT; Schema: public; Owner: rich -- diff --git a/scripts/.depend b/scripts/.depend index 6ade698..91da738 100644 --- a/scripts/.depend +++ b/scripts/.depend @@ -1,3 +1,4 @@ +cocanwiki_pages.cmi: cocanwiki.cmo 00-TEMPLATE.cmo: cocanwiki.cmo cocanwiki_template.cmi 00-TEMPLATE.cmx: cocanwiki.cmx cocanwiki_template.cmx broken_links.cmo: cocanwiki.cmo cocanwiki_template.cmi @@ -24,10 +25,12 @@ cocanwiki_links.cmo: cocanwiki.cmo wikilib.cmi cocanwiki_links.cmi cocanwiki_links.cmx: cocanwiki.cmx wikilib.cmx cocanwiki_links.cmi cocanwiki_ok.cmo: cocanwiki_template.cmi cocanwiki_ok.cmx: cocanwiki_template.cmx -cocanwiki_template.cmo: cocanwiki_files.cmo cocanwiki_version.cmo \ - cocanwiki_template.cmi -cocanwiki_template.cmx: cocanwiki_files.cmx cocanwiki_version.cmx \ - cocanwiki_template.cmi +cocanwiki_pages.cmo: cocanwiki.cmo cocanwiki_links.cmi cocanwiki_strings.cmo \ + wikilib.cmi cocanwiki_pages.cmi +cocanwiki_pages.cmx: cocanwiki.cmx cocanwiki_links.cmx cocanwiki_strings.cmx \ + wikilib.cmx cocanwiki_pages.cmi +cocanwiki_template.cmo: cocanwiki_files.cmo cocanwiki_template.cmi +cocanwiki_template.cmx: cocanwiki_files.cmx cocanwiki_template.cmi contact.cmo: cocanwiki.cmo cocanwiki_ok.cmo cocanwiki_template.cmi contact.cmx: cocanwiki.cmx cocanwiki_ok.cmx cocanwiki_template.cmx contact_show.cmo: cocanwiki.cmo cocanwiki_template.cmi @@ -65,10 +68,10 @@ delete_user_form.cmx: cocanwiki.cmx cocanwiki_ok.cmx cocanwiki_template.cmx diff.cmo: cocanwiki.cmo cocanwiki_diff.cmo cocanwiki_template.cmi diff.cmx: cocanwiki.cmx cocanwiki_diff.cmx cocanwiki_template.cmx edit.cmo: cocanwiki.cmo cocanwiki_diff.cmo cocanwiki_emailnotify.cmo \ - cocanwiki_links.cmi cocanwiki_ok.cmo cocanwiki_strings.cmo \ + cocanwiki_ok.cmo cocanwiki_pages.cmi cocanwiki_strings.cmo \ cocanwiki_template.cmi wikilib.cmi edit.cmx: cocanwiki.cmx cocanwiki_diff.cmx cocanwiki_emailnotify.cmx \ - cocanwiki_links.cmx cocanwiki_ok.cmx cocanwiki_strings.cmx \ + cocanwiki_ok.cmx cocanwiki_pages.cmx cocanwiki_strings.cmx \ cocanwiki_template.cmx wikilib.cmx edit_contact.cmo: cocanwiki.cmo cocanwiki_ok.cmo cocanwiki_strings.cmo edit_contact.cmx: cocanwiki.cmx cocanwiki_ok.cmx cocanwiki_strings.cmx @@ -128,6 +131,12 @@ login_form.cmo: cocanwiki.cmo cocanwiki_strings.cmo cocanwiki_template.cmi login_form.cmx: cocanwiki.cmx cocanwiki_strings.cmx cocanwiki_template.cmx logout.cmo: cocanwiki.cmo cocanwiki_ok.cmo logout.cmx: cocanwiki.cmx cocanwiki_ok.cmx +mail_import.cmo: cocanwiki.cmo cocanwiki_date.cmo cocanwiki_ok.cmo \ + cocanwiki_pages.cmi cocanwiki_template.cmi wikilib.cmi +mail_import.cmx: cocanwiki.cmx cocanwiki_date.cmx cocanwiki_ok.cmx \ + cocanwiki_pages.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 mailing_list_confirm.cmx: cocanwiki.cmx cocanwiki_ok.cmx mailing_list_form.cmo: cocanwiki.cmo cocanwiki_template.cmi diff --git a/scripts/Makefile b/scripts/Makefile index 9e92ca2..7698fd9 100644 --- a/scripts/Makefile +++ b/scripts/Makefile @@ -1,11 +1,13 @@ # Makefile for COCANWIKI. -# $Id: Makefile,v 1.37 2004/10/10 16:14:43 rich Exp $ +# $Id: Makefile,v 1.38 2004/10/11 14:13:04 rich Exp $ include ../Makefile.config OCAMLC := ocamlc # XXX Move GregorianDate out of +merjis. -OCAMLCFLAGS := -w s -I +apache -I +pcre -I +dbi -I +extlib -I +merjis +OCAMLCFLAGS := -w s \ + -I +apache -I +pcre -I +dbi -I +extlib -I +netstring \ + -I +merjis CPP := cpp LIB_OBJS := \ @@ -22,6 +24,7 @@ LIB_OBJS := \ cocanwiki_emailnotify.cmo \ wikilib.cmo \ cocanwiki_links.cmo \ + cocanwiki_pages.cmo \ cocanwiki_create_host.cmo \ cocanwiki_ext_calendar.cmo @@ -79,6 +82,8 @@ OBJS := \ mailing_list_send.cmo \ mailing_list_unsubscribe.cmo \ mailing_list_view.cmo \ + mail_import.cmo \ + mail_import_form.cmo \ page.cmo \ page_email_confirm.cmo \ page_email_form.cmo \ diff --git a/scripts/cocanwiki.ml b/scripts/cocanwiki.ml index 8cca6fb..7114c2c 100644 --- a/scripts/cocanwiki.ml +++ b/scripts/cocanwiki.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: cocanwiki.ml,v 1.16 2004/10/10 14:44:50 rich Exp $ + * $Id: cocanwiki.ml,v 1.17 2004/10/11 14:13:04 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 @@ -46,7 +46,7 @@ type host_t = { hostname : string; * register_script ~restrict:[CanEdit ; CanManageUsers] run *) type permissions_t = CanView | CanEdit | CanManageUsers | CanManageContacts - | CanManageSite | CanEditGlobalCSS + | CanManageSite | CanEditGlobalCSS | CanImportMail (* The "user object". *) type user_t = Anonymous (* Not logged in. *) @@ -65,6 +65,7 @@ let can_manage_users host = test_permission host CanManageUsers let can_manage_contacts host = test_permission host CanManageContacts let can_manage_site host = test_permission host CanManageSite let can_edit_global_css host = test_permission host CanEditGlobalCSS +let can_import_mail host = test_permission host CanImportMail (* Our wrapper around the standard [register_script] function. * @@ -150,7 +151,7 @@ let register_script ?(restrict = []) ?(anonymous = true) run = dbh#prepare_cached "select u.id, u.name, u.can_edit, u.can_manage_users, u.can_manage_contacts, u.can_manage_site, - u.can_edit_global_css + u.can_edit_global_css, u.can_import_mail from usercookies uc, users u where uc.cookie = ? and uc.userid = u.id and u.hostid = ?" in sth#execute [`String cookie; `Int hostid]; @@ -158,7 +159,7 @@ let register_script ?(restrict = []) ?(anonymous = true) run = [ `Int userid; `String name; `Bool can_edit; `Bool can_manage_users; `Bool can_manage_contacts; `Bool can_manage_site; - `Bool can_edit_global_css ] -> + `Bool can_edit_global_css; `Bool can_import_mail ] -> (* Every logged in user can view. *) let perms = [CanView] in let perms = @@ -176,6 +177,9 @@ let register_script ?(restrict = []) ?(anonymous = true) run = let perms = if can_edit_global_css then CanEditGlobalCSS :: perms else perms in + let perms = + if can_import_mail then CanImportMail :: perms + else perms in User (userid, name, perms) | _ -> assert false) with diff --git a/scripts/cocanwiki_pages.ml b/scripts/cocanwiki_pages.ml new file mode 100644 index 0000000..b3bf2a8 --- /dev/null +++ b/scripts/cocanwiki_pages.ml @@ -0,0 +1,270 @@ +(* COCANWIKI - a wiki written in Objective CAML. + * Written by Richard W.M. Jones . + * Copyright (C) 2004 Merjis Ltd. + * $Id: cocanwiki_pages.ml,v 1.1 2004/10/11 14:13:04 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 Cocanwiki +open Cocanwiki_strings + +type pt = Page of string | Title of string + +type model = { + id : int; (* Original page ID (0 = none). *) + pt : pt; (* Page of title (only used if id=0) *) + description : string; (* Description. *) + redirect : string; (* Redirect to ("" = none). *) + contents : (string * string * string) list; + (* (sectionname, divname, content) + * for each section. *) +} + +exception SaveURLError +exception SaveConflict of int * int * string * string + +let new_page pt = + let description = + match pt with + Page page -> page + | Title title -> title in + + let model = { id = 0; + pt = pt; + description = description; + redirect = ""; + contents = [] } in + model + +let new_page_with_title title = + (* Initial page contents. *) + let contents = [ "", "", "" ^ title ^ " is " ] in + let model = { id = 0; + pt = Title title; + description = title; + redirect = ""; + contents = contents } in + model + +let load_page (dbh : Dbi.connection) hostid ~url ?version () = + (* Pull out the page itself from the database. *) + let sth = + match version with + None -> + let sth = dbh#prepare_cached "select id, title, description, + coalesce (redirect, '') + from pages + where hostid = ? and url = ?" in + sth#execute [`Int hostid; `String url]; + sth + | Some version -> + let sth = dbh#prepare_cached "select id, title, description, + coalesce (redirect, '') + from pages + where hostid = ? and id = ? and + (url = ? or url_deleted = ?)" in + sth#execute [`Int hostid; `String url; `String url]; + sth in + + let pageid, title, description, redirect = + match sth#fetch1 () with + [`Int pageid; `String title; `String description; `String redirect] -> + pageid, title, description, redirect + | _ -> assert false in + + (* Get the sections. *) + let sth = dbh#prepare_cached "select coalesce (sectionname, ''), + content, + coalesce (divname, '') + from contents + where pageid = ? + order by ordering" in + sth#execute [`Int pageid]; + + let contents = + sth#map (function + | [`String sectionname; `String content; `String divname] -> + sectionname, divname, content + | _ -> assert false) in + + let model = { id = pageid; + pt = Page url; + description = description; + redirect = redirect; + contents = contents; } in + model + +let save_page (dbh : Dbi.connection) hostid ?user ?r model = + (* Logging information, if available. *) + let logged_user = + match user with + None -> `Null + | Some user -> + match user with + | User (id, _, _) -> `Int id + | _ -> `Null in + + let logged_ip = + match r with + None -> `Null + | Some r -> + try `String (Connection.remote_ip (Request.connection r)) + with Not_found -> `Null in + + (* Get redirect. *) + let redirect = + if model.redirect = "" then `Null + else `String model.redirect in + + let url, pageid = + (* Creating a new page (id = 0)? If so, we're just going to insert + * a new row, which is easy. + *) + if model.id = 0 then ( + (* Create the page title or URL. *) + let url, title = + match model.pt with + Page url -> url, url + | Title title -> + match Wikilib.generate_url_of_title dbh hostid title with + Wikilib.GenURL_OK url -> url, title + | _ -> + raise SaveURLError in + + let sth = dbh#prepare_cached "insert into pages (hostid, url, title, + description, logged_ip, logged_user, + redirect) + values (?, ?, ?, ?, ?, ?, ?)" in + sth#execute [`Int hostid; `String url; `String title; + `String model.description; logged_ip; logged_user; + redirect]; + + let pageid = sth#serial "pages_id_seq" in + + (* Create the page contents. *) + let sth = dbh#prepare_cached "insert into contents (pageid, + ordering, sectionname, divname, + content) + values (?, ?, ?, ?, ?)" in + let ordering = ref 0 in (* Creating new ordering. *) + List.iter (fun (sectionname, divname, content) -> + let divname = + if string_is_whitespace divname then `Null + else `String divname in + let sectionname = + if string_is_whitespace sectionname then `Null + else `String sectionname in + incr ordering; let ordering = !ordering in + sth#execute [`Int pageid; `Int ordering; + sectionname; divname; + `String content]) + model.contents; + + url, pageid + ) + (* Otherwise it's an old page which we're updating. *) + else ( + (* Pull out fields from the database. *) + let sth = dbh#prepare_cached "select creation_date, + coalesce (url, url_deleted), + title, css + from pages + where hostid = ? and id = ?" in + sth#execute [`Int hostid; `Int model.id]; + + let creation_date, url, title, css = + match sth#fetch1 () with + [ creation_date; `String url; `String title; css ] -> + creation_date, url, title, css + | _ -> assert false in + + (* Has someone else edited this page in the meantime? *) + let sth = dbh#prepare_cached "select max(id) from pages + where hostid = ? and url = ?" in + sth#execute [`Int hostid; `String url]; + + let max_id = sth#fetch1int () in + let edited = max_id <> model.id in + + if edited then ( + let css = match css with + `Null -> "" | `String css -> css + | _ -> assert false in + raise (SaveConflict (max_id, model.id, url, css)) + ); + + (* Defer the pages_redirect_cn constraint because that would + * temporarily fail on the next UPDATE. + *) + let sth = + dbh#prepare_cached + "set constraints pages_redirect_cn, sitemenu_url_cn, + page_emails_url_cn, links_from_cn, recently_visited_url_cn + deferred" in + sth#execute []; + + (* Mark the old page as deleted. NB. There is a small race + * condition here because PostgreSQL doesn't do isolation + * properly. If a user tries to visit this page between the + * delete and the creation of the new page, then they'll get + * a page not found error. (XXX) + *) + let sth = dbh#prepare_cached "update pages set url_deleted = url, + url = null + where hostid = ? and id = ?" in + sth#execute [`Int hostid; `Int model.id]; + + (* Create the new page. *) + let sth = dbh#prepare_cached "insert into pages (hostid, url, title, + description, creation_date, logged_ip, + logged_user, redirect, css) + values (?, ?, ?, ?, ?, ?, ?, ?, ?)" in + sth#execute [`Int hostid; `String url; `String title; + `String model.description; creation_date; logged_ip; + logged_user; redirect; css]; + + (* New page ID <> old page ID model.id. *) + let pageid = sth#serial "pages_id_seq" in + + (* Create the page contents. *) + let sth = dbh#prepare_cached "insert into contents (pageid, + ordering, sectionname, divname, + content) + values (?, ?, ?, ?, ?)" in + let ordering = ref 0 in (* Creating new ordering. *) + List.iter (fun (sectionname, divname, content) -> + let divname = + if string_is_whitespace divname then `Null + else `String divname in + let sectionname = + if string_is_whitespace sectionname then `Null + else `String sectionname in + incr ordering; let ordering = !ordering in + sth#execute [`Int pageid; `Int ordering; + sectionname; divname; + `String content]) + model.contents; + + url, pageid + ) in + + (* Keep the links table in synch. *) + Cocanwiki_links.update_links_for_page dbh hostid url; + + url, pageid diff --git a/scripts/cocanwiki_pages.mli b/scripts/cocanwiki_pages.mli new file mode 100644 index 0000000..fc1dc71 --- /dev/null +++ b/scripts/cocanwiki_pages.mli @@ -0,0 +1,68 @@ +(* COCANWIKI - a wiki written in Objective CAML. + * Written by Richard W.M. Jones . + * Copyright (C) 2004 Merjis Ltd. + * $Id: cocanwiki_pages.mli,v 1.1 2004/10/11 14:13:04 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 Cocanwiki + +(* Page (URL) or title. *) +type pt = Page of string | Title of string + +type model = { + id : int; (* Original page ID (0 = none). *) + pt : pt; (* Page of title (only used if id=0) *) + description : string; (* Description. *) + redirect : string; (* Redirect to ("" = none). *) + contents : (string * string * string) list; + (* (sectionname, divname, content) + * for each section. *) +} + +exception SaveURLError +exception SaveConflict of int * int * string * string + +val new_page : pt -> model + (** Create a new, blank page. *) + +val new_page_with_title : string -> model + (** Friendlier version of {!new_page} which creates a new page from + * a title and begins an introductory paragraph for the user. + *) + +val load_page : Dbi.connection -> int -> url:string -> ?version:int -> unit -> model + (** Load a page from the database. A non-current version can be + * specified with the optional [?version] parameter, otherwise the + * latest version is loaded. + * + * @raise Not_found If the page cannot be found. + *) + +val save_page : Dbi.connection -> int -> ?user:user_t -> ?r:Apache.Request.t -> model -> string * int + (** Save a page. If the page is new, this creates a new page in the + * database. If the page is old, then the page is edited. + * + * Notification emails are not sent. + * + * @raise SaveURLError Duplicate URL or bad URL (happens only when creating + * new pages). + * + * @raise SaveConflict If there was an editing conflict. + * + * @return (url, pageid) + *) diff --git a/scripts/create_user.ml b/scripts/create_user.ml index 5f6be27..2767434 100644 --- a/scripts/create_user.ml +++ b/scripts/create_user.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: create_user.ml,v 1.3 2004/09/23 11:56:47 rich Exp $ + * $Id: create_user.ml,v 1.4 2004/10/11 14:13:04 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 @@ -73,17 +73,21 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = let can_manage_contacts = q#param_true "can_manage_contacts" in let can_manage_site = q#param_true "can_manage_site" in let can_edit_global_css = q#param_true "can_edit_global_css" in + let can_import_mail = q#param_true "can_import_mail" in + let force_password_change = q#param_true "force_password_change" in (* Create the user account. *) let sth = dbh#prepare_cached "insert into users (name, password, email, hostid, can_edit, can_manage_users, can_manage_contacts, can_manage_site, - can_edit_global_css) - values (?, ?, ?, ?, ?, ?, ?, ?, ?)" in + can_edit_global_css, can_import_mail, + force_password_change) + values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)" in sth#execute [`String username; `String password; email; `Int hostid; `Bool can_edit; `Bool can_manage_users; `Bool can_manage_contacts; `Bool can_manage_site; - `Bool can_edit_global_css]; + `Bool can_edit_global_css; `Bool can_import_mail; + `Bool force_password_change]; dbh#commit (); diff --git a/scripts/edit.ml b/scripts/edit.ml index df0242e..2e4a6cd 100644 --- a/scripts/edit.ml +++ b/scripts/edit.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit.ml,v 1.19 2004/10/10 16:14:43 rich Exp $ + * $Id: edit.ml,v 1.20 2004/10/11 14:13:04 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 @@ -32,22 +32,7 @@ open Cocanwiki_ok open Cocanwiki_emailnotify open Cocanwiki_diff open Cocanwiki_strings - -(* Page of title. *) -type pt_t = Page of string | Title of string - -(* We keep an "internal model" of the page - see build_internal_model () - * below. - *) -type model_t = { - id : int; (* Original page ID (0 = none). *) - pt : pt_t; (* Page of title (only used if id=0) *) - description : string; (* Description. *) - redirect : string; (* Redirect to ("" = none). *) - contents : (string * string * string) list; - (* (sectionname, divname, content) - * for each section. *) -} +open Cocanwiki_pages let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = let template = get_template dbh hostid "edit.html" in @@ -270,40 +255,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = * a model from it. *) let begin_editing page = - (* Pull out the page itself from the database. *) - let sth = dbh#prepare_cached "select id, title, description, - coalesce (redirect, '') - from pages - where hostid = ? and url = ?" in - sth#execute [`Int hostid; `String page]; - - let pageid, title, description, redirect = - match sth#fetch1 () with - [`Int pageid; `String title; `String description; `String redirect]-> - pageid, title, description, redirect - | _ -> assert false in - - (* Get the sections. *) - let sth = dbh#prepare_cached "select coalesce (sectionname, ''), - content, - coalesce (divname, '') - from contents - where pageid = ? - order by ordering" in - sth#execute [`Int pageid]; - - let contents = - sth#map (function - | [`String sectionname; `String content; `String divname] -> - sectionname, divname, content - | _ -> assert false) in - - let model = { id = pageid; - pt = Page page; - description = description; - redirect = redirect; - contents = contents; } in - + let model = load_page dbh hostid ~url:page () in model_to_template model template in @@ -323,19 +275,9 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = q "The page name supplied is too short or invalid."; return () in - (* Initial page contents. *) - let contents = - match pt with - Page url -> [] - | Title title -> - [ "", "", - "" ^ title ^ " is " ] in - - let model = { id = 0; - pt = pt; - description = title; - redirect = ""; - contents = contents } in + let model = match pt with + Page url -> new_page pt + | Title title -> new_page_with_title title in model_to_template model template in @@ -404,222 +346,78 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid {hostname = hostname} user = if no_errors then ( (* No errors, so we can save the page ... *) - (* Get the IP address of the user, if available. *) - let logged_ip = - try `String (Connection.remote_ip (Request.connection r)) - with Not_found -> `Null in + let url, pageid = + try + save_page dbh hostid ~user ~r model + with + SaveURLError -> + error ~back_button:true ~title:"Page exists" + q ("While you were editing that page, it looks " ^ + "like another user created the same page."); + return () + + | SaveConflict (new_version, old_version, url, css) -> + (* Edited by someone else ... Get the other's changes. *) + let other_diff, _ = + get_diff dbh hostid url + ~old_version ~version:new_version () in + + (* Synthesize our own changes. *) + let old_page = get_version_for_diff dbh old_version in + let new_page = + page_for_diff css (List.map (fun (sectionname, _, content) -> + sectionname, content) model.contents) in + let our_diff = diff_cmd old_page new_page in - let logged_user = - match user with - | User (id, _, _) -> `Int id - | _ -> `Null in + (* Fill out the conflict template. *) + template_conflict#set "other_diff" other_diff; + template_conflict#set "our_diff" our_diff; + template_conflict#set "old_version" (string_of_int old_version); + template_conflict#set "new_version" (string_of_int new_version); + template_conflict#set "url" url; - (* Get redirect. *) - let redirect = - if model.redirect = "" then `Null - else `String model.redirect in + q#template template_conflict; + return () in - let url, pageid = - (* Creating a new page (id = 0)? If so, we're just going to insert - * a new row, which is easy. + (* General email notification of page edits. Send an email to + * anyone in the page_emails table who has a confirmed address + * and who hasn't received an email already today. + *) + let sth = dbh#prepare_cached "select email, opt_out from page_emails + where hostid = ? and url = ? + and pending is null + and last_sent < current_date" in + sth#execute [`Int hostid; `String url]; + + let addrs = sth#map (function [`String email; `String opt_out] -> + email, opt_out + | _ -> assert false) in + + if addrs <> [] then ( + (* Construct the email. *) + template_email#set "hostname" hostname; + template_email#set "page" url; + + let subject = + "Site notice: " ^ hostname ^ "/" ^ url ^ " has been updated" in + + (* Send each email individually (they all have different opt out + * links). *) - if model.id = 0 then ( - (* Create the page title or URL. *) - let url, title = - match model.pt with - Page url -> url, url - | Title title -> - match Wikilib.generate_url_of_title dbh hostid title with - Wikilib.GenURL_OK url -> url, title - | Wikilib.GenURL_Duplicate url -> - error ~back_button:true ~title:"Page exists" - q ("While you were editing that page, it looks " ^ - "like another user created the same page."); - return () - | _ -> - assert false (* This should have been detected in - * begin_editing_new. - *) in - - let sth = dbh#prepare_cached "insert into pages (hostid, url, title, - description, logged_ip, logged_user, - redirect) - values (?, ?, ?, ?, ?, ?, ?)" in - sth#execute [`Int hostid; `String url; `String title; - `String model.description; logged_ip; logged_user; - redirect]; - - let pageid = sth#serial "pages_id_seq" in - - (* Create the page contents. *) - let sth = dbh#prepare_cached "insert into contents (pageid, - ordering, sectionname, divname, - content) - values (?, ?, ?, ?, ?)" in - let ordering = ref 0 in (* Creating new ordering. *) - List.iter (fun (sectionname, divname, content) -> - let divname = - if string_is_whitespace divname then `Null - else `String divname in - let sectionname = - if string_is_whitespace sectionname then `Null - else `String sectionname in - incr ordering; let ordering = !ordering in - sth#execute [`Int pageid; `Int ordering; - sectionname; divname; - `String content]) - model.contents; - - url, pageid - ) - (* Otherwise it's an old page which we're updating. *) - else ( - (* Pull out fields from the database. *) - let sth = dbh#prepare_cached "select creation_date, - coalesce (url, url_deleted), - title, css - from pages - where hostid = ? and id = ?" in - sth#execute [`Int hostid; `Int model.id]; - - let creation_date, url, title, css = - match sth#fetch1 () with - [ creation_date; `String url; `String title; css ] -> - creation_date, url, title, css - | _ -> assert false in - - (* Has someone else edited this page in the meantime? *) - let sth = dbh#prepare_cached "select max(id) from pages - where hostid = ? and url = ?" in - sth#execute [`Int hostid; `String url]; - - let max_id = sth#fetch1int () in - let edited = max_id <> model.id in - - if edited then ( - (* Edited by someone else ... Get the other's changes. *) - let other_diff, _ = - get_diff dbh hostid url - ~old_version:model.id ~version:max_id () in - - (* Synthesize our own changes. *) - let old_page = get_version_for_diff dbh model.id in - let new_page = - let css = match css with - `Null -> "" | `String css -> css - | _ -> assert false in - page_for_diff css (List.map (fun (sectionname, _, content) -> - sectionname, content) model.contents) in - let our_diff = diff_cmd old_page new_page in - - (* Fill out the conflict template. *) - template_conflict#set "other_diff" other_diff; - template_conflict#set "our_diff" our_diff; - template_conflict#set "old_version" (string_of_int model.id); - template_conflict#set "new_version" (string_of_int max_id); - template_conflict#set "url" url; - - q#template template_conflict; - return () - ); - - (* Defer the pages_redirect_cn constraint because that would - * temporarily fail on the next UPDATE. - *) - let sth = - dbh#prepare_cached - "set constraints pages_redirect_cn, sitemenu_url_cn, - page_emails_url_cn, links_from_cn, recently_visited_url_cn - deferred" in - sth#execute []; - - (* Mark the old page as deleted. NB. There is a small race - * condition here because PostgreSQL doesn't do isolation - * properly. If a user tries to visit this page between the - * delete and the creation of the new page, then they'll get - * a page not found error. (XXX) - *) - let sth = dbh#prepare_cached "update pages set url_deleted = url, - url = null - where hostid = ? and id = ?" in - sth#execute [`Int hostid; `Int model.id]; - - (* Create the new page. *) - let sth = dbh#prepare_cached "insert into pages (hostid, url, title, - description, creation_date, logged_ip, - logged_user, redirect, css) - values (?, ?, ?, ?, ?, ?, ?, ?, ?)" in - sth#execute [`Int hostid; `String url; `String title; - `String model.description; creation_date; logged_ip; - logged_user; redirect; css]; - - (* New page ID <> old page ID model.id. *) - let pageid = sth#serial "pages_id_seq" in - - (* Create the page contents. *) - let sth = dbh#prepare_cached "insert into contents (pageid, - ordering, sectionname, divname, - content) - values (?, ?, ?, ?, ?)" in - let ordering = ref 0 in (* Creating new ordering. *) - List.iter (fun (sectionname, divname, content) -> - let divname = - if string_is_whitespace divname then `Null - else `String divname in - let sectionname = - if string_is_whitespace sectionname then `Null - else `String sectionname in - incr ordering; let ordering = !ordering in - sth#execute [`Int pageid; `Int ordering; - sectionname; divname; - `String content]) - model.contents; - - (* General email notification of page edits. Send an email to - * anyone in the page_emails table who has a confirmed address - * and who hasn't received an email already today. - *) - let sth = dbh#prepare_cached "select email, opt_out from page_emails - where hostid = ? and url = ? - and pending is null - and last_sent < current_date" in - sth#execute [`Int hostid; `String url]; - - let addrs = sth#map (function [`String email; `String opt_out] -> - email, opt_out - | _ -> assert false) in - - if addrs <> [] then ( - (* Construct the email. *) - template_email#set "hostname" hostname; - template_email#set "page" url; - - let subject = - "Site notice: " ^ hostname ^ "/" ^ url ^ " has been updated" in - - (* Send each email individually (they all have different opt out - * links). - *) - List.iter (fun (to_addr, opt_out) -> - template_email#set "opt_out" opt_out; - let body = template_email#to_string in - Sendmail.send_mail ~subject - ~to_addr:[to_addr] ~body ()) - addrs - ); - - (* Update the database to record when these emails were sent. *) - let sth = dbh#prepare_cached "update page_emails - set last_sent = current_date - where hostid = ? and url = ? - and pending is null" in - sth#execute [`Int hostid; `String url]; - - url, pageid - ) in - - (* Keep the links table in synch. *) - Cocanwiki_links.update_links_for_page dbh hostid url; + List.iter (fun (to_addr, opt_out) -> + template_email#set "opt_out" opt_out; + let body = template_email#to_string in + Sendmail.send_mail ~subject + ~to_addr:[to_addr] ~body ()) + addrs + ); + + (* Update the database to record when these emails were sent. *) + let sth = dbh#prepare_cached "update page_emails + set last_sent = current_date + where hostid = ? and url = ? + and pending is null" in + sth#execute [`Int hostid; `String url]; (* Commit changes to the database. *) dbh#commit (); diff --git a/scripts/edit_user.ml b/scripts/edit_user.ml index fb1da46..2f861c7 100644 --- a/scripts/edit_user.ml +++ b/scripts/edit_user.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit_user.ml,v 1.6 2004/09/23 11:56:47 rich Exp $ + * $Id: edit_user.ml,v 1.7 2004/10/11 14:13:04 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 @@ -75,6 +75,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ self = let can_manage_contacts = q#param_true "can_manage_contacts" in let can_manage_site = q#param_true "can_manage_site" in let can_edit_global_css = q#param_true "can_edit_global_css" in + let can_import_mail = q#param_true "can_import_mail" in (* Trying to remove manage users permission from self? *) (match can_manage_users, self with @@ -90,11 +91,12 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ self = can_edit = ?, can_manage_users = ?, can_manage_contacts = ?, can_manage_site = ?, - can_edit_global_css = ? + can_edit_global_css = ?, + can_import_mail = ? where hostid = ? and id = ?" in sth#execute [email; `Bool can_edit; `Bool can_manage_users; `Bool can_manage_contacts; `Bool can_manage_site; - `Bool can_edit_global_css; + `Bool can_edit_global_css; `Bool can_import_mail; `Int hostid; `Int userid]; (* Finish up. *) diff --git a/scripts/edit_user_form.ml b/scripts/edit_user_form.ml index 26e0a2f..d8eb82a 100644 --- a/scripts/edit_user_form.ml +++ b/scripts/edit_user_form.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: edit_user_form.ml,v 1.6 2004/09/22 10:19:26 rich Exp $ + * $Id: edit_user_form.ml,v 1.7 2004/10/11 14:13:04 rich Exp $ * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -37,7 +37,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = dbh#prepare_cached "select u.name, u.email, u.registration_date, u.can_edit, u.can_manage_users, u.can_manage_contacts, - u.can_manage_site, u.can_edit_global_css, + u.can_manage_site, u.can_edit_global_css, u.can_import_mail, (select count(*) from pages where logged_user = u.id), (select count(*) from pages where logged_user = u.id and url_deleted is null) @@ -46,16 +46,17 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = let name, email, registration_date, can_edit, can_manage_users, can_manage_contacts, can_manage_site, can_edit_global_css, - nr_edits, nr_edits_live = + can_import_mail, nr_edits, nr_edits_live = match sth#fetch1 () with [`String name; (`Null | `String _) as email; `Date registration_date; `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 nr_edits; `Int nr_edits_live] -> name, email, registration_date, can_edit, can_manage_users, can_manage_contacts, can_manage_site, can_edit_global_css, - nr_edits, nr_edits_live + can_import_mail, nr_edits, nr_edits_live | _ -> assert false in template#set "userid" (string_of_int userid); @@ -67,6 +68,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = template#conditional "can_manage_contacts" can_manage_contacts; template#conditional "can_manage_site" can_manage_site; template#conditional "can_edit_global_css" can_edit_global_css; + template#conditional "can_import_mail" can_import_mail; template#set "nr_edits" (string_of_int nr_edits); template#set "nr_edits_live" (string_of_int nr_edits_live); diff --git a/scripts/mail_import.ml b/scripts/mail_import.ml new file mode 100644 index 0000000..dce9f5a --- /dev/null +++ b/scripts/mail_import.ml @@ -0,0 +1,261 @@ +(* COCANWIKI - a wiki written in Objective CAML. + * Written by Richard W.M. Jones . + * Copyright (C) 2004 Merjis Ltd. + * $Id: mail_import.ml,v 1.1 2004/10/11 14:13:04 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 Netmime +open Netchannels +open Netstream + +open Cocanwiki +open Cocanwiki_ok +open Cocanwiki_template +open Cocanwiki_date +open Cocanwiki_pages + +let irt_re = Pcre.regexp "<.*?>" +let ws_re = Pcre.regexp "\\S+" + +let run r (q : cgi) (dbh : Dbi.connection) hostid _ user = + let hdr_template = get_template dbh hostid "mail_import_header.txt" in + + (* Overwrite old messages? *) + let overwrite = q#param_true "overwrite" in + (* Rebuild index after importing this one message? *) + let rebuild = q#param_true "rebuild" in + + (* Get the uploaded file. *) + let file = + try + let upload = q#upload "file" in + upload.upload_value + with + Not_found -> + (* Force an error status which a script can detect. *) + Request.set_status r cHTTP_BAD_REQUEST; + error ~back_button:true ~title:"No message" + q "No message was uploaded."; + return () in + + (* Parse the message. *) + let msg = + with_in_obj_channel + (new input_string file) + (fun ch -> + let stm = new input_stream ch in + read_mime_message stm) in + + (* Get the mail header for easy access. *) + let hdr = fst msg in + + (* Get the interesting headers which will go into the database. *) + let get_hdr name = try hdr#field name with Not_found -> "" in + let subject = get_hdr "subject" in + let inet_message_id = get_hdr "message-id" in + let date = get_hdr "date" in + let references = get_hdr "references" in + let in_reply_to = get_hdr "in-reply-to" in + + (* If the message doesn't have a Date or Message-ID header, then we + * cannot thread it, so give up. + *) + if date = "" || inet_message_id = "" then ( + Request.set_status r cHTTP_BAD_REQUEST; + error ~back_button:true ~title:"Headers missing" + q "Date or Message-ID header missing. Cannot handle this message. "; + return () + ); + + (* Parse the date field. *) + let date, time = + try + let date = Netdate.parse date in + let date, time = + { Dbi.year = date.Netdate.year; + Dbi.month = date.Netdate.month; + Dbi.day = date.Netdate.day; }, + { Dbi.hour = date.Netdate.hour; + Dbi.min = date.Netdate.minute; + Dbi.sec = date.Netdate.second; + Dbi.microsec = 0; + Dbi.timezone = Some (date.Netdate.zone / 60); } in + date, time + with + Invalid_argument _ -> + failwith ("cannot parse date: " ^ date) in + + (* Find the first thing in the In-Reply-To field which looks like a + * message ID. + *) + let in_reply_to = + try + let subs = Pcre.exec ~rex:irt_re in_reply_to in + Some (Pcre.get_substring subs 0) + with + Not_found -> None in + + (* References is a space-separated list of message IDs. Parse that up. *) + let references = Pcre.split ~rex:ws_re references in + + (* Reverse the references list, because we most often want to see the + * head element (ie. the most immediate parent message). + *) + let references = List.rev references in + + (* If the head element of references != the in-reply-to message ID, then + * prepend it. + *) + let references = + match in_reply_to with + | None -> references + | Some msgid -> + match references with + | [] -> [msgid] + | m :: ms when m <> msgid -> msgid :: m :: ms + | ms -> ms in + + (* Does this message exist in the database already? If so, and overwrite + * is not specified, then silently skip this message. 'overwrite' becomes + * 'Some id' if we need to overwrite an existing message id in the database, + * else 'None' if this is a never-seen-before message. + *) + let overwrite = + let sth = dbh#prepare_cached "select id from messages + where hostid = ? and inet_message_id = ?" in + sth#execute [`Int hostid; `String inet_message_id]; + try + let id = sth#fetch1int () in + if not overwrite then ( + ok ~title:"Message exists" + q "Message already imported"; + return () + ); + Some id + with + Not_found -> None in + + (* Save all of this in the database. *) + let msgid = + match overwrite with + None -> (* Never-seen-before message. *) + let sth = + dbh#prepare_cached + "insert into messages (hostid, subject, inet_message_id, + message_date) values (?, ?, ?, ?)" in + sth#execute [`Int hostid; `String subject; `String inet_message_id; + `Timestamp (date, time)]; + let msgid = sth#serial "messages_id_seq" in + + let sth = + dbh#prepare_cached + "insert into msg_references (message_id, inet_message_id, + ordering) values (?, ?, ?)" in + let ordering = ref 0 in + List.iter (fun inet_message_id -> + incr ordering; let ordering = !ordering in + sth#execute [`Int msgid; `String inet_message_id; + `Int ordering]) references; + + msgid + + | Some msgid -> (* Overwrite an existing message. *) + (* All the fields in the messages table should be identical to + * last time we imported this message. Just return the msgid. + *) + msgid in + + (* The message is referred to by a unique title: *) + let title = sprintf "Mail/%s (%d)" subject msgid in + + (* Choose a suitable URL. *) + let url = + match Wikilib.generate_url_of_title dbh hostid title with + (* Duplicate URL is OK - eg. in the case where we are overwriting + * an already imported message. + *) + Wikilib.GenURL_OK url | Wikilib.GenURL_Duplicate url -> url + | Wikilib.GenURL_TooShort | Wikilib.GenURL_BadURL -> + failwith "generate_url_of_title returned 'TooShort' or 'BadURL'" in + + (* To create the page, we need a few more headers ... *) + let from = get_hdr "from" in + let to_hdr = get_hdr "to" in + let cc = get_hdr "cc" in + + (* Create the page. Or edit it (if we're overwriting ...). *) + let model = + match overwrite with + | None -> new_page (Title title) + | Some _ -> load_page dbh hostid ~url () in + let model = { model with redirect = "" } in + + (* Create the first section (mail header). *) + let section0 = + let content = + (* XXX Escaping! *) + hdr_template#set "subject" subject; + let yyyy, mm, dd = date.Dbi.year, date.Dbi.month, date.Dbi.day in + hdr_template#set "yyyy" (sprintf "%04d" yyyy); + hdr_template#set "mm" (sprintf "%02d" mm); + hdr_template#set "dd" (sprintf "%02d" dd); + hdr_template#set "short_month" (short_month mm); + hdr_template#set "from" from; + hdr_template#set "inet_message_id" inet_message_id; + hdr_template#to_string + in + "", "mail_header", content in + + (* Create the second section (mail body). *) + let section1 = + let content = "(mail body should go here XXX)" in + "Message", "mail_body", content in + + (* Overwrite the first two sections of the current page, regardless of + * what they contain. + * XXX We might consider more advanced strategies here: for example, + * use the divname to identify the old mail_header and mail_body and + * overwrite those, or insert them if they don't exist. + *) + let contents = model.contents in + let contents = + match contents with + [] | [_] -> [ section0; section1 ] + | _ :: _ :: xs -> section0 :: section1 :: xs in + let model = { model with contents = contents } in + + (* Write the page back. This can throw several exceptions, but we ignore + * them because we want to script to fail abruptly if any of these + * unexpected conditions arises. + *) + save_page dbh hostid ~user ~r model; + + (* Commit to the database. *) + dbh#commit (); + + (* Finish off. *) + ok ~title:"Imported" + q ("Message " ^ inet_message_id ^ " was imported.") + +let () = + register_script ~restrict:[CanImportMail] run diff --git a/scripts/mail_import_form.ml b/scripts/mail_import_form.ml new file mode 100644 index 0000000..470be78 --- /dev/null +++ b/scripts/mail_import_form.ml @@ -0,0 +1,36 @@ +(* COCANWIKI - a wiki written in Objective CAML. + * Written by Richard W.M. Jones . + * Copyright (C) 2004 Merjis Ltd. + * $Id: mail_import_form.ml,v 1.1 2004/10/11 14:13:04 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 "mail_import_form.html" in + + q#template template + +let () = + register_script ~restrict:[CanImportMail] run diff --git a/scripts/users.ml b/scripts/users.ml index 120998d..b16d817 100644 --- a/scripts/users.ml +++ b/scripts/users.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: users.ml,v 1.6 2004/09/22 10:19:26 rich Exp $ + * $Id: users.ml,v 1.7 2004/10/11 14:13:04 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 @@ -34,7 +34,8 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = let sth = dbh#prepare_cached "select id, name, email, registration_date, can_edit, can_manage_users, - can_manage_contacts, can_manage_site, can_edit_global_css + can_manage_contacts, can_manage_site, can_edit_global_css, + can_import_mail from users where hostid = ? order by name" in sth#execute [`Int hostid]; @@ -45,7 +46,7 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = `Date registration_date; `Bool can_edit; `Bool can_manage_users; `Bool can_manage_contacts; `Bool can_manage_site; - `Bool can_edit_global_css] -> + `Bool can_edit_global_css; `Bool can_import_mail] -> let email = match email with `Null -> "" | `String s -> s in [ "userid", Template.VarString (string_of_int userid); "name", Template.VarString name; @@ -58,7 +59,9 @@ let run r (q : cgi) (dbh : Dbi.connection) hostid _ _ = Template.VarConditional can_manage_contacts; "can_manage_site", Template.VarConditional can_manage_site; "can_edit_global_css", - Template.VarConditional can_edit_global_css; ] + Template.VarConditional can_edit_global_css; + "can_import_mail", + Template.VarConditional can_import_mail;] | _ -> assert false) in template#table "users" table; diff --git a/scripts/wikilib.ml b/scripts/wikilib.ml index b11b590..9651aad 100644 --- a/scripts/wikilib.ml +++ b/scripts/wikilib.ml @@ -1,7 +1,7 @@ (* COCANWIKI - a wiki written in Objective CAML. * Written by Richard W.M. Jones . * Copyright (C) 2004 Merjis Ltd. - * $Id: wikilib.ml,v 1.11 2004/10/09 11:03:58 rich Exp $ + * $Id: wikilib.ml,v 1.12 2004/10/11 14:13:04 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 @@ -43,7 +43,9 @@ let nontrivial_re = Pcre.regexp ~flags:[`CASELESS] "[a-z0-9]" let generate_url_of_title (dbh : Dbi.connection) hostid title = (* Create a suitable URL from this title. *) let url = - String.map (function '\000' .. ' ' | '<' | '>' | '&' | '"' | '+' -> '_' + String.map (function + '\000' .. ' ' | '<' | '>' | '&' | '"' | '+' | '#' | '%' + -> '_' | c -> Char.lowercase c) title in (* Check URL is not too trivial. *) diff --git a/templates/create_user_form.html b/templates/create_user_form.html index c1e46f9..70b360a 100644 --- a/templates/create_user_form.html +++ b/templates/create_user_form.html @@ -28,6 +28,11 @@ + Force password change: + Force password change at first login + + + Email: @@ -44,6 +49,8 @@ Manage site
Edit global stylesheet +
+Import mail diff --git a/templates/edit_user_form.html b/templates/edit_user_form.html index 35b325f..a415c58 100644 --- a/templates/edit_user_form.html +++ b/templates/edit_user_form.html @@ -40,6 +40,8 @@ Manage site
Edit global stylesheet +
+Import mail diff --git a/templates/mail_import_form.html b/templates/mail_import_form.html new file mode 100644 index 0000000..e98db46 --- /dev/null +++ b/templates/mail_import_form.html @@ -0,0 +1,57 @@ + + + +Import mail + + + + +

Import mail

File:
Flags:	+Overwrite message if it already imported? (Dangerous) + +Rebuild indexes after import. +

+ + + + + +

+ +

+ + +

+ + + \ No newline at end of file diff --git a/templates/mail_import_header.txt b/templates/mail_import_header.txt new file mode 100644 index 0000000..2b889b5 --- /dev/null +++ b/templates/mail_import_header.txt @@ -0,0 +1,12 @@ +[[::subject::]] | [[Previous]] | [[Next]] | [[Thread]] + +Date: [[::yyyy::/::mm::/::dd::|::dd:: ::short_month:: ::yyyy::]] +| [[::yyyy::/::mm::|see more email from ::short_month:: ::yyyy::]] +
+From: [[::from::]] +
+To: ... +
+Cc: ... + +Message ID: ::inet_message_id:: diff --git a/templates/users.html b/templates/users.html index 983e386..bc0d823 100644 --- a/templates/users.html +++ b/templates/users.html @@ -18,7 +18,7 @@ Username Email address Registration - Permissions + Permissions Edit @@ -26,6 +26,7 @@ Manage contacts Manage site Edit global stylesheet + Import mail ::table(users):: @@ -38,6 +39,7 @@ ::if(can_manage_contacts)::

::end:: ::if(can_manage_site)::

::end:: ::if(can_edit_global_css)::

::end:: + ::if(can_import_mail)::

::end:: ::end:: @@ -122,6 +124,15 @@ the look and feel of the site across all pages. +

Import mail

+ +

+If set, user may import e-mail. +

+ +