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
);
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
);
--
+-- 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
--
--
--- 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
--
+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
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
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
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
# 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 := \
cocanwiki_emailnotify.cmo \
wikilib.cmo \
cocanwiki_links.cmo \
+ cocanwiki_pages.cmo \
cocanwiki_create_host.cmo \
cocanwiki_ext_calendar.cmo
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 \
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* 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
* 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. *)
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.
*
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];
[ `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 =
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
--- /dev/null
+(* COCANWIKI - a wiki written in Objective CAML.
+ * Written by Richard W.M. Jones <rich@merjis.com>.
+ * Copyright (C) 2004 Merjis Ltd.
+ * $Id: cocanwiki_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 = [ "", "", "<b>" ^ title ^ "</b> 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
--- /dev/null
+(* COCANWIKI - a wiki written in Objective CAML.
+ * Written by Richard W.M. Jones <rich@merjis.com>.
+ * Copyright (C) 2004 Merjis Ltd.
+ * $Id: cocanwiki_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)
+ *)
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* 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
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 ();
(* 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.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
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
* 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
q "The page name supplied is too short or invalid.";
return () in
- (* Initial page contents. *)
- let contents =
- match pt with
- Page url -> []
- | Title title ->
- [ "", "",
- "<b>" ^ title ^ "</b> 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
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 ();
(* 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.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
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
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. *)
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* 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
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)
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);
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);
--- /dev/null
+(* COCANWIKI - a wiki written in Objective CAML.
+ * Written by Richard W.M. Jones <rich@merjis.com>.
+ * Copyright (C) 2004 Merjis Ltd.
+ * $Id: mail_import.ml,v 1.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
--- /dev/null
+(* COCANWIKI - a wiki written in Objective CAML.
+ * Written by Richard W.M. Jones <rich@merjis.com>.
+ * 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
(* 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.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
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];
`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;
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;
(* COCANWIKI - a wiki written in Objective CAML.
* Written by Richard W.M. Jones <rich@merjis.com>.
* Copyright (C) 2004 Merjis Ltd.
- * $Id: wikilib.ml,v 1.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
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. *)
</tr>
<tr>
+<th> Force password change: </th>
+<td> <input type="checkbox" name="force_password_change" value="1" id="force_password_change"/><label for="force_password_change">Force password change at first login</label> </td>
+</tr>
+
+<tr>
<th> Email: </th>
<td> <input name="email" value="" size="40"/> </td>
</tr>
<input id="can_manage_site" type="checkbox" name="can_manage_site" value="1"/><label for="can_manage_site">Manage site</label>
<br/>
<input id="can_edit_global_css" type="checkbox" name="can_edit_global_css" value="1"/><label for="can_edit_global_css">Edit global stylesheet</label>
+<br/>
+<input id="can_import_mail" type="checkbox" name="can_import_mail" value="1"/><label for="can_import_mail">Import mail</label>
</td>
</tr>
<tr>
<input id="can_manage_site" type="checkbox" name="can_manage_site" value="1" ::if(can_manage_site)::checked="checked"::end::/><label for="can_manage_site">Manage site</label>
<br/>
<input id="can_edit_global_css" type="checkbox" name="can_edit_global_css" value="1" ::if(can_edit_global_css)::checked="checked"::end::/><label for="can_edit_global_css">Edit global stylesheet</label>
+<br/>
+<input id="can_import_mail" type="checkbox" name="can_import_mail" value="1" ::if(can_import_mail)::checked="checked"::end::/><label for="can_import_mail">Import mail</label>
</td>
</tr>
<tr>
--- /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>Import mail</title>
+<meta name="author" content="http://www.merjis.com/" />
+<link rel="stylesheet" href="::theme_css_html_tag::" type="text/css" title="Standard"/>
+</head><body>
+
+<h1>Import mail</h1>
+
+<form method="post" action="/_bin/mail_import.cmo" enctype="multipart/form-data">
+<table class="left_table">
+<tr>
+<th> File: </th>
+<td> <input type="file" name="file" value=""/> </td>
+</tr>
+<tr>
+<th> Flags: </th>
+<td>
+<input type="checkbox" name="overwrite" value="1" id="overwrite"/><label for="overwrite">Overwrite message if it already imported? <strong>(Dangerous)</strong></label>
+<br/>
+<input type="checkbox" name="rebuild" value="1" checked="checked" id="rebuild"/><label for="rebuild">Rebuild indexes after import.</label>
+</td>
+</tr>
+<tr>
+<td></td>
+<td> <input type="submit" value="Import"/> </td>
+</tr>
+</table>
+</form>
+
+<ul id="topmenu" class="menu">
+<li class="first"> <a href="/">Home page</a> </li>
+<li> <a href="/_sitemap">Sitemap</a> </li>
+<li> <a href="/_recent">Recent changes</a> </li>
+</ul>
+
+<div id="menu_div">
+<ul id="bottommenu" class="menu">
+<li class="first"> <a href="/">Home page</a> </li>
+::table(sitemenu)::<li> <a href="/::url_html_tag::">::label_html::</a> </li>
+::end::
+<li> <a href="/_sitemap">Sitemap</a> </li>
+</ul>
+</div>
+
+<div id="footer_div">
+<hr/>
+
+<ul id="footer" class="menu">
+<li class="first"> <a href="/copyright">Copyright © ::year::</a> </li>
+<li> Powered by <a href="http://sandbox.merjis.com/">::cocanwiki_package_html:: ::cocanwiki_version_html::</a> </li>
+</ul>
+</div>
+
+</body>
+</html>
\ No newline at end of file
--- /dev/null
+[[::subject::]] | [[Previous]] | [[Next]] | [[Thread]]
+
+<b>Date:</b> [[::yyyy::/::mm::/::dd::|::dd:: ::short_month:: ::yyyy::]]
+| <small>[[::yyyy::/::mm::|see more email from ::short_month:: ::yyyy::]]</small>
+<br>
+<b>From:</b> [[::from::]]
+<br>
+<b>To:</b> ...
+<br>
+<b>Cc:</b> ...
+
+<small><b>Message ID:</b> ::inet_message_id::</small>
<th rowspan="2"> Username </th>
<th rowspan="2"> Email address </th>
<th rowspan="2"> Registration </th>
-<th colspan="5"> Permissions </th>
+<th colspan="6"> Permissions </th>
</tr>
<tr>
<th> Edit </th>
<th> Manage contacts </th>
<th> Manage site </th>
<th> Edit global stylesheet </th>
+<th> Import mail </th>
</tr>
::table(users)::
<td> ::if(can_manage_contacts)::<img src="/_graphics/tick.png" width="10" height="10" alt="Can manage contacts"/>::end:: </td>
<td> ::if(can_manage_site)::<img src="/_graphics/tick.png" width="10" height="10" alt="Can manage site"/>::end:: </td>
<td> ::if(can_edit_global_css)::<img src="/_graphics/tick.png" width="10" height="10" alt="Can edit global stylesheet"/>::end:: </td>
+<td> ::if(can_import_mail)::<img src="/_graphics/tick.png" width="10" height="10" alt="Can import mail"/>::end:: </td>
</tr>
::end::
</dd>
+<dt> <strong>Import mail</strong> </dt>
+<dd>
+
+<p>
+If set, user may import e-mail.
+</p>
+
+</dd>
+
</dl>
<ul id="topmenu" class="menu">
git.annexia.org / cocanwiki.git / commitdiff