1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
type entry = { envelope : string; mail : Mail.t }
let quoted (line : string) : int option =
let n = String.length line in
let rec go i = if i < n && line.[i] = '>' then go (i + 1) else i in
let k = go 0 in
if n - k >= 5 && String.sub line k 5 = "From " then Some k else None
let map_lines f s = String.concat "\n" (List.map f (String.split_on_char '\n' s))
let escape = map_lines (fun l -> match quoted l with Some _ -> ">" ^ l | None -> l)
let unescape = map_lines (fun l -> match quoted l with Some k when k > 0 -> String.sub l 1 (String.length l - 1) | _ -> l)
let parse (text : string) : entry list =
let text = Mail.lf text in
let lines = String.split_on_char '\n' text in
let lines = match List.rev lines with "" :: rest -> List.rev rest | _ -> lines in
let entry envelope body =
let body = match body with "" :: rest -> List.rev rest | l -> List.rev l in
{ envelope; mail = Mail.parse (unescape (String.concat "\n" body ^ "\n")) }
in
let rec go lines current acc =
match (lines, current) with
| [], None -> List.rev acc
| [], Some (e, body) -> List.rev (entry e body :: acc)
| l :: rest, _ when quoted l = Some 0 ->
let acc = match current with Some (e, body) -> entry e body :: acc | None -> acc in
go rest (Some (String.sub l 5 (String.length l - 5), [])) acc
| l :: rest, Some (e, body) -> go rest (Some (e, l :: body)) acc
| _ :: rest, None -> go rest None acc
in
go lines None []
let to_string (entries : entry list) : string =
String.concat ""
(List.map
(fun e ->
let text = Mail.to_string e.mail in
let text = if text <> "" && text.[String.length text - 1] = '\n' then text else text ^ "\n" in
"From " ^ e.envelope ^ "\n" ^ escape text ^ "\n")
entries)
let envelope ~(sender : string) (d : Mail.date) : string =
let wd = Civil.weekday (Civil.days_from_civil d.day) in
Printf.sprintf "%s %s %s %2d %02d:%02d:%02d %d" sender
(String.sub (Civil.weekday_name wd) 0 3)
(String.sub (Civil.month_name d.day.month) 0 3)
d.day.day d.time.hour d.time.minute (int_of_float d.time.second) d.day.year
let sender (e : entry) : string = List.hd (String.split_on_char ' ' e.envelope)