scripts/cocanwiki_links.ml
scripts/cocanwiki_links.mli
scripts/cocanwiki_ok.ml
+scripts/cocanwiki_pages.ml
+scripts/cocanwiki_pages.mli
scripts/cocanwiki_server_settings.ml
scripts/cocanwiki_strings.ml
scripts/cocanwiki_template.ml
scripts/login.ml
scripts/login_form.ml
scripts/logout.ml
+scripts/mail_import.ml
+scripts/mail_import_form.ml
scripts/mailing_list_confirm.ml
scripts/mailing_list_form.ml
scripts/mailing_list_send.ml
templates/images.html
templates/largest_pages.html
templates/login_form.html
+templates/mail_import_form.html
+templates/mail_import_header.txt
templates/mailing_list_form.html
templates/mailing_list_send.txt
templates/mailing_list_view.html
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
+cocanwiki_template.cmo: cocanwiki_files.cmo cocanwiki_version.cmo \
+ cocanwiki_template.cmi
+cocanwiki_template.cmx: cocanwiki_files.cmx cocanwiki_version.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
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
+ cocanwiki_pages.cmi cocanwiki_strings.cmo cocanwiki_template.cmi \
+ wikilib.cmi
mail_import.cmx: cocanwiki.cmx cocanwiki_date.cmx cocanwiki_ok.cmx \
- cocanwiki_pages.cmx cocanwiki_template.cmx wikilib.cmx
+ cocanwiki_pages.cmx cocanwiki_strings.cmx cocanwiki_template.cmx \
+ wikilib.cmx
mail_import_form.cmo: cocanwiki.cmo cocanwiki_template.cmi
mail_import_form.cmx: cocanwiki.cmx cocanwiki_template.cmx
mailing_list_confirm.cmo: cocanwiki.cmo cocanwiki_ok.cmo
(* 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 $
+ * $Id: mail_import.ml,v 1.2 2004/10/11 15:21:49 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 Netchannels
open Netstream
+open ExtString
+
open Cocanwiki
open Cocanwiki_ok
open Cocanwiki_template
open Cocanwiki_date
+open Cocanwiki_strings
open Cocanwiki_pages
let irt_re = Pcre.regexp "<.*?>"
-let ws_re = Pcre.regexp "\\S+"
+let ws_re = Pcre.regexp "\\s+"
+let comma_re = Pcre.regexp "\\s*,\\s*"
+let lines_re = Pcre.regexp "\\r?\\n"
let run r (q : cgi) (dbh : Dbi.connection) hostid _ user =
let hdr_template = get_template dbh hostid "mail_import_header.txt" in
let content =
(* XXX Escaping! *)
hdr_template#set "subject" subject;
+ hdr_template#set "from" from;
+ hdr_template#set "inet_message_id" inet_message_id;
+
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;
+
+ let get_table hdr =
+ List.map (fun addr -> [ "addr", Template.VarString addr ])
+ (Pcre.split ~rex:comma_re hdr)
+ in
+ let table = get_table to_hdr in
+ hdr_template#table "to" table;
+ hdr_template#conditional "has_to" (table <> []);
+ let table = get_table cc in
+ hdr_template#table "cc" table;
+ hdr_template#conditional "has_cc" (table <> []);
+
hdr_template#to_string
in
"", "mail_header", content in
- (* Create the second section (mail body). *)
+ (* Create the second section (mail body).
+ * XXX Very simple. Should be extended to understand attachments and
+ * convert them into file or image uploads.
+ *)
let section1 =
- let content = "(mail body should go here XXX)" in
+ let is_text_plain hdr =
+ try
+ let ct = hdr#field "content-type" in
+ String.starts_with ct "text/plain"
+ with
+ Not_found -> true in
+
+ (* Find the first text/plain body. *)
+ let rec find_body = function
+ (header, `Body mime_body) when is_text_plain header ->
+ mime_body#value
+ | (_, `Body _) -> raise Not_found
+ | (_, `Parts []) -> raise Not_found (* should never happen *)
+ | (_, `Parts (m :: _)) ->
+ find_body m in
+ let content =
+ try
+ let text = find_body msg in
+ let lines = Pcre.split ~rex:lines_re text in
+ let lines = List.map trim lines in
+ let lines = List.map (fun str -> str ^ "<br>") lines in
+ String.concat "\n" lines
+ with
+ Not_found ->
+ "No plain text message body found" in
"Message", "mail_body", content in
(* Overwrite the first two sections of the current page, regardless of