/pliant/protocol/smtp/mime.pli
1	module "/pliant/language/unsafe.pli"
2	module "/pliant/language/stream.pli"
3	module "/pliant/util/encoding/base64.pli"
4	module "/pliant/util/encoding/qp.pli"
5
6
7	function ms_decode l
8	arg_rw Str l
9	if (l eparse any:(var Str head) "=?" any:(var Str charset) "?" any:(var Str enc) "?" any:(var Str value) "?=" any:(var Str tail))
10	if lower:enc="q"
11	ms_decode tail
12	l := head+qp_decode:value+tail
13	eif lower:enc="b"
14	ms_decode tail
15	l := head+base64_decode:value+tail
16
17
18	type MimeStream
19	field Pointer:Stream stream
20	field Str name
21	field Str mime encoding
22	field CBool embedded <- false
23	field CBool html <- false
24	field CBool spam <- false
25	field Int encoding_model <- 0
26	field List:Str boundaries
27	field Str ready
28
29	method ms multipart -> c
30	arg MimeStream ms ; arg CBool c
31	c := (exists ms:boundaries:first) or ms:embedded
32
33	method ms bind s reset
34	arg_rw MimeStream ms ; arg_rw Stream s ; arg CBool reset
35	ms stream :> s
36	ms name := ""
37	ms mime := ""
38	ms embedded := false
39	ms html := false
40	ms encoding_model := 0
41	ms ready := ""
42	if reset
43	ms boundaries := var List:Str empty_list
44	ms spam := false
45
46	method ms header_line l -> c
47	arg_rw MimeStream ms ; arg_w Str l ; arg CBool c
48	l := ms:stream readline
49	if l=""
50	return false
51	while not ms:stream:atend and { var Char ch := ms:stream:stream_read_cur map Char ; ch=" " or ch="[tab]" }
52	l += ms:stream readline
53	if (l parse acword:"content-type" ":" any:(var Str value) ";" any)
54	ms mime := value
55	eif (l parse acword:"content-type" ":" any:(var Str value))
56	ms mime := value
57	if (l parse acword:"content-transfer-encoding" ":" any:(var Str value) ";" any)
58	ms encoding := value
59	eif (l parse acword:"content-transfer-encoding" ":" any:(var Str value))
60	ms encoding := value
61	if (l parse acword:"content-type" ":" acword:"message" any)
62	ms embedded := true
63	if (l parse acword:"content-type" ":" acword:"text" "/" word:"html" any)
64	ms html := true
65	if (l parse acword:"content-type" ":" acword:"multipart" any acword:"boundary" "=" "[dq]" any:(var Str value) "[dq]" any)
66	ms boundaries += value
67	eif (l parse acword:"content-type" ":" acword:"multipart" any acword:"boundary" "=" any:(var Str value))
68	ms boundaries += value
69	if (l parse acword:"content-transfer-encoding" ":" any acword:"8bit" any)
70	ms encoding_model := 0
71	eif (l parse acword:"content-transfer-encoding" ":" any acword:"base64" any)
72	ms encoding_model := 1
73	eif (l parse acword:"content-transfer-encoding" ":" any acword:"quoted-printable" any)
74	ms encoding_model := 2
75	eif (l parse acword:"content-transfer-encoding" ":" any)
76	ms encoding_model := undefined
77	if l="spam"
78	ms spam := true
79	# Novell unstandard encoding_model
80	if (l parse acword:"content-disposition" ":" any acword:"filename" "=" "[dq]" any:(var Str value) "[dq]" any)
81	ms_decode value
82	ms name := value
83	eif (l+";" parse acword:"content-disposition" ":" any acword:"filename" "=" any:(var Str value) ";" any)
84	ms name := value
85	if (l parse acword:"content-type" ":" any acword:"name" "=" "[dq]" any:(var Str value) "[dq]" any)
86	ms_decode value # cope with crazy Microsoft encoding_model
87	ms name := value
88	eif (l+";" parse acword:"content-type" ":" any acword:"name" "=" any:(var Str value) ";" any)
89	ms name := value
90	c := true
91
92
93	method ms body_line l -> c
94	arg_rw MimeStream ms ; arg_w Str l ; arg CBool c
95	if ms:ready:len>0
96	l := ms ready
97	ms ready := ""
98	return true
99	if ms:stream:atend
100	return false
101	l := ms:stream readline
102	if (l 0 2)="--"
103	var Pointer:Str b :> ms:boundaries first
104	while exists:b
105	if l="--"+b or l="--"+b+"--"
106	return false
107	b :> ms:boundaries next b
108	if ms:encoding_model=1 # base64
109	l := base64_decode l
110	eif ms:encoding_model=2 # quoted printable
111	if l:len>0 and (l l:len-1)="="
112	l := qp_decode (l 0 l:len-1)
113	else
114	l := qp_decode:l+"[lf]"
115	else
116	l += "[lf]"
117	if ms:embedded
118	while not ms:stream:atend and { var Char ch := ms:stream:stream_read_cur map Char ; ch=" " or ch="[tab]" }
119	l += ms:stream readline
120	if (l parse acword:"content-type" ":" acword:"multipart" any acword:"boundary" "=" "[dq]" any:(var Str value) "[dq]" any)
121	ms boundaries += value
122	eif (l parse acword:"content-type" ":" acword:"multipart" any acword:"boundary" "=" any:(var Str value))
123	ms boundaries += value
124	if l=""
125	ms embedded := false
126	c := true
127
128	method ms unread l
129	arg_rw MimeStream ms ; arg Str l
130	ms ready := l
131
132	export ms_decode
133	export MimeStream '. bind'
134	export '. name' '. mime' '. encoding' '. encoding_model' '. multipart' '. html' '. spam'
135	export '. header_line' '. body_line' '. unread'
136
137
138
139