+ 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
+
+ (* Markup a plain text body. *)
+ let markup_body text =
+ (* Get all the titles from the database! We're going to exclude
+ * mail messages from this.
+ *)
+ let links =
+ PGSQL(dbh)
+ "select lower (title) from pages where hostid = $hostid
+ and url is not null and title not like 'Mail/%'" in
+ let links = List.map Option.get links in
+
+ (* This code cannot find titles which are split across multiple lines.
+ * XXX
+ *)
+ let lines = Pcre.split ~rex:lines_re text in
+
+ (* We don't want to mark up the same link twice, so keep track of the
+ * titles we've already used.
+ *)
+ let used = ref [] in
+ let lines =
+ List.map
+ (fun line ->
+ let find str sub_lc =
+ try
+ String.find (String.lowercase str) sub_lc
+ with
+ Invalid_string -> -1
+ in
+ let rec loop line = function
+ [] -> line
+ | link :: links ->
+ let i = find line link in
+ if i >= 0 && not (List.mem link !used) then (
+ used := link :: !used;
+ let n = String.length link in
+ let n' = String.length line in
+ let line =
+ String.sub line 0 i ^
+ "[[" ^ String.sub line i n ^
+ "]]" ^ loop (String.sub line (i+n) (n' - (i+n))) links
+ in
+ line
+ ) else
+ loop line links
+ in
+ loop line links) lines in
+
+ let lines = List.map trim lines in
+ let lines = List.map (fun line -> line ^ "<br>") lines in
+
+ String.concat "\n" lines
+ in
+
+ let content =
+ try
+ let text = find_body msg in
+ let content = markup_body text in
+ content
+ with
+ Not_found ->
+ "No plain text message body found" in
+ Some "Message", Some "mail_body", content in