/pliant/protocol/pop3/client.pli
1	# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
2	#
3	# This program is free software; you can redistribute it and/or
4	# modify it under the terms of the GNU General Public License version 2
5	# as published by the Free Software Foundation.
6	#
7	# This program is distributed in the hope that it will be useful,
8	# but WITHOUT ANY WARRANTY; without even the implied warranty of
9	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
10	# GNU General Public License for more details.
11	#
12	# You should have received a copy of the GNU General Public License
13	# version 2 along with this program; if not, write to the Free Software
14	# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
15
16	module "/pliant/language/unsafe.pli"
17	module "/pliant/language/stream.pli"
18	module "/pliant/language/stream/multi.pli"
19	module "/pliant/language/stream/filesystembase.pli"
20	module "/pliant/language/stream/openmode.pli"
21	module "/pliant/admin/md5.pli"
22
23	(gvar TraceSlot pop3_trace) configure "POP3 client"
24
25
26	function command s cmd timestamp log -> status
27	arg_rw Stream s ; arg Str cmd ; arg_w Str timestamp ; arg_rw TraceSession log ; arg Status status
28	if cmd<>""
29	s writeline cmd
30	log trace "query " cmd
31	var Str l := s readline
32	log trace "answer " cmd
33	if s=failure
34	return failure
35	status := shunt (upper:l parse "+OK" any) success failure
36	if (l parse any "<" any:(var Str stamp) ">")
37	timestamp := "<"+stamp+">"
38	else
39	timestamp := ""
40
41	function command s cmd log -> status
42	arg_rw Stream s ; arg Str cmd ; arg_rw TraceSession log ; arg Status status
43	status := command s cmd (var Str timestamp) log
44
45
46	type Pop3FileSystem
47	void
48	FileSystem maybe Pop3FileSystem
49
50	type Pop3StreamDriver
51	field Link:Stream tcp
52	field Link:TraceSession log
53	field Str buffer
54	field CBool atend
55	field CBool remove
56	StreamDriver maybe Pop3StreamDriver
57
58	method pop3 read buf mini maxi -> red
59	arg_rw Pop3StreamDriver pop3 ; arg Address buf ; arg Int mini maxi red
60	if pop3:tcp:stream_read_cur<>pop3:tcp:stream_read_stop
61	red := min (cast pop3:tcp:stream_read_stop Int).-.(cast pop3:tcp:stream_read_cur Int) maxi
62	memory_copy pop3:tcp:stream_read_cur buf red
63	pop3:tcp:stream_read_cur := pop3:tcp:stream_read_cur translate Byte red
64	else
65	red := pop3:tcp:stream_driver read buf mini maxi
66
67	if false
68	method pop3 close -> status
69	arg_rw Pop3StreamDriver pop3 ; arg ExtendedStatus status
70	pop3:tcp flush end
71	status := shunt pop3:tcp=success success failure
72	pop3:tcp close
73
74	method fs open name options flags stream support -> status
75	arg_rw Pop3FileSystem fs ; arg Str name options ; arg Int flags ; arg_rw Stream stream support ; arg ExtendedStatus status
76	if (flags .and. in_out)<>in
77	return failure
78	if (name eparse "//" any:(var Str server) "/" any:(var Str user) "/" any:(var Str password))
79	void
80	eif (name eparse "//" any:(var Str server))
81	user := "" ; password := ""
82	else
83	return failure
84	var Int port := options option "port" Int
85	if port=undefined
86	port := 110
87	if (options option "user" Str)<>""
88	user := options option "user" Str
89	if (options option "password" Str)<>""
90	password := options option "password" Str
91	var Link:Stream tcp :> new Stream
92	tcp open "tcp://"+server+"/client/110" in+out+safe
93	if tcp=failure
94	pop3_trace trace "Failed to connect to " tcp:name
95	return failure
96	var Link:TraceSession log :> new TraceSession
97	log bind pop3_trace
98	if (command tcp "" (var Str timestamp) log)=failure
99	return failure
100	part auth
101	if (timestamp eparse any "<" any:(var Str seed) ">")
102	if (command tcp "APOP "+user+" "+lower:(string_md5_hexa_signature "<"+seed+">"+password) log)=success
103	leave auth
104	tcp open "tcp://"+server+"/client/110" in+out+safe
105	if tcp=failure or (command tcp "" (var Str timestamp) log)=failure
106	return failure
107	if (command tcp "USER "+user log)=failure
108	return failure
109	if (command tcp "PASS "+password log)=failure
110	return failure
111	if (command tcp "RETR 1" log)=failure
112	return failure
113	var Link:Pop3StreamDriver drv :> new Pop3StreamDriver
114	stream stream_driver :> drv
115	drv tcp :> tcp
116	drv log :> log
117	drv atend := false
118	drv remove := true
119	status := success
120
121
122	method drv read buf mini maxi -> red
123	arg_rw Pop3StreamDriver drv ; arg Address buf ; arg Int mini maxi red
124	red := 0
125	while red<mini
126	if drv:buffer:len<>0
127	var Int step := min drv:buffer:len maxi
128	memory_copy drv:buffer:characters (buf translate Byte red) step
129	drv buffer := drv:buffer step drv:buffer:len
130	red += step
131	if drv:atend or drv:tcp:atend
132	return
133	var Str l := drv:tcp readline
134	if l="."
135	drv atend := true
136	return
137	if (l 0 2)=".."
138	l := l 1 l:len
139	if red+l:len+1<=maxi
140	memory_copy l:characters (buf translate Byte red) l:len
141	red += l:len
142	memory_copy "[lf]":characters (buf translate Byte red) 1
143	red += 1
144	else
145	drv buffer += l+"[lf]"
146
147
148	method drv close -> status
149	arg_rw Pop3StreamDriver drv ; arg Status status
150	if not drv:atend
151	while not drv:tcp:atend and drv:tcp:readline<>"."
152	void
153	if drv:remove
154	if (command drv:tcp "DELE 1" drv:log)=failure
155	return failure
156	if (command drv:tcp "QUIT" drv:log)=failure
157	return failure
158	return success
159
160
161	method drv configure command stream -> status
162	arg_rw Pop3StreamDriver drv ; arg Str command ; arg_rw Stream stream ; arg ExtendedStatus status
163	if command="keep"
164	drv remove := false
165	status :=success
166	else
167	status := failure
168
169	gvar Pop3FileSystem pop3_file_system
170	pliant_multi_file_system mount "pop3:" "" pop3_file_system