Source file netascii_armor.ml
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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
type armor_type = [ `Plain | `Base64 | `OpenPGP ]
type armored_message =
[ `Plain of Netmime.mime_body
| `Base64 of Netmime.mime_body
| `OpenPGP of Netmime.mime_header * Netmime.mime_body * int
]
type armored_message_ro =
[ `Plain of Netmime.mime_body_ro
| `Base64 of Netmime.mime_body_ro
| `OpenPGP of Netmime.mime_header_ro * Netmime.mime_body_ro * int
]
type armor_spec = (string * armor_type) list
let begin_re =
Netstring_str.regexp "^-----BEGIN \\(.*\\)-----[ \t\r]*$"
let end_re =
Netstring_str.regexp "^-----END \\(.*\\)-----[ \t\r]*$"
let cksum_re =
Netstring_str.regexp "^=\\([A-Za-z0-9+/=]+\\)[ \t\r]*$"
let parse spec (ch : Netchannels.in_obj_channel) =
let rec next_begin_boundary() =
let line_opt = try Some(ch # input_line()) with End_of_file -> None in
match line_opt with
| None -> []
| Some line ->
if line <> "" && line.[0] = '-' then
match Netstring_str.string_match begin_re line 0 with
| None -> next_begin_boundary()
| Some m ->
let tag = Netstring_str.matched_group m 1 line in
let armor_type_opt =
try Some(List.assoc tag spec) with Not_found -> None in
( match armor_type_opt with
| None -> next_begin_boundary()
| Some armor_type ->
read_message tag armor_type
)
else
next_begin_boundary()
and read_message tag armor_type =
let body = new Netmime.memory_mime_body "" in
let body_ch = body # open_value_wr() in
match armor_type with
| `Plain ->
let followup code =
body_ch # close_out();
match code with
| `Error -> []
| `End ->
let body_ro = (body :> Netmime.mime_body_ro) in
(tag, `Plain body_ro) :: next_begin_boundary()
| `End_cksum _ -> assert false in
parse_message_body
~enable_checksum:false
~followup
tag armor_type body_ch
| `Base64 ->
let filter =
new Netencoding.Base64.decoding_pipe ~accept_spaces:true () in
let base64_ch =
new Netchannels.output_filter filter body_ch in
let followup code =
base64_ch # close_out();
body_ch # close_out();
match code with
| `Error -> []
| `End ->
let body_ro = (body :> Netmime.mime_body_ro) in
(tag, `Base64 body_ro) :: next_begin_boundary()
| `End_cksum _ -> assert false in
parse_message_body
~enable_checksum:false
~followup
tag armor_type base64_ch
| `OpenPGP ->
assert false
and is_expected_end_boundary line tag =
match Netstring_str.string_match end_re line 0 with
| None ->
false
| Some m ->
let real_tag = Netstring_str.matched_group m 1 line in
real_tag = tag
and parse_message_body ~enable_checksum ~followup
tag armor_type out_ch =
let rec parse() =
let line_opt = try Some(ch # input_line()) with End_of_file -> None in
match line_opt with
| None ->
followup `Error
| Some line ->
let checksum_opt =
if enable_checksum && line <> "" && line.[0] = '=' then
match Netstring_str.string_match cksum_re line 0 with
| Some m ->
let sum = Netstring_str.matched_group m 1 line in
if String.length sum = 4 then
try
Some(Netencoding.Base64.decode sum)
with _ -> None
else
None
| None ->
None
else
None in
match checksum_opt with
| None ->
if is_expected_end_boundary line tag then
followup `End
else (
out_ch # output_string line;
out_ch # output_string "\n";
parse()
)
| Some checksum ->
assert(String.length checksum = 3);
let v =
((Char.code checksum.[0]) lsl 16) lor
((Char.code checksum.[1]) lsl 8) lor
(Char.code checksum.[2]) in
let line_opt =
try Some(ch # input_line()) with End_of_file -> None in
( match line_opt with
| None ->
followup `Error
| Some line ->
if is_expected_end_boundary line tag then
followup (`End_cksum v)
else
followup `Error
)
in
parse()
in
next_begin_boundary()