line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
=head1 NAME |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
POE::Component::Server::SMTP - SMTP Protocol Implementation |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 SYNOPSIS |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
use POE; |
8
|
|
|
|
|
|
|
use POE::Component::Server::SMTP; |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
POE::Component::Server::SMTP->spawn( |
11
|
|
|
|
|
|
|
Port => 2525, |
12
|
|
|
|
|
|
|
InlineStates => { |
13
|
|
|
|
|
|
|
HELO => \&smtp_helo, |
14
|
|
|
|
|
|
|
QUIT => \&smtp_quit, |
15
|
|
|
|
|
|
|
}, |
16
|
|
|
|
|
|
|
); |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
sub smtp_helo { |
19
|
|
|
|
|
|
|
my ($heap) = $_[HEAP]; |
20
|
|
|
|
|
|
|
my $client = $heap->{client}; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
$client->put( SMTP_OK, 'Welcome.' ); |
23
|
|
|
|
|
|
|
} |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
sub smtp_quit { |
26
|
|
|
|
|
|
|
my ($heap) = $_[HEAP]; |
27
|
|
|
|
|
|
|
my $client = $heap->{client}; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
$client->put( SMTP_QUIT, 'Good bye!' ); |
30
|
|
|
|
|
|
|
$heap->{shutdown_now} = 1; |
31
|
|
|
|
|
|
|
} |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
$poe_kernel->run; |
34
|
|
|
|
|
|
|
exit 0; |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
=head1 DESCRIPTION |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
POE::Component::Server::TCP implements the SMTP protocol for the server. |
39
|
|
|
|
|
|
|
I won't lie, this is very low level. If you want to support any command |
40
|
|
|
|
|
|
|
other than HELO and QUIT, you'll have to implement it yourself, and define |
41
|
|
|
|
|
|
|
it in your C, C, or C. |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
This module uses L |
44
|
|
|
|
|
|
|
to allow for "Plugins" using C and C. |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
Also, as of this release, L version 0.24 is out. This module |
47
|
|
|
|
|
|
|
relies on a CVS version of POE. |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
=cut |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
package POE::Component::Server::SMTP; |
52
|
1
|
|
|
1
|
|
29680
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
36
|
|
53
|
|
|
|
|
|
|
|
54
|
1
|
|
|
1
|
|
5
|
use Exporter; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
42
|
|
55
|
1
|
|
|
1
|
|
506
|
use Mail::Internet; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
use Sys::Hostname qw[hostname]; |
57
|
|
|
|
|
|
|
use POE qw[ |
58
|
|
|
|
|
|
|
Wheel::ReadWrite |
59
|
|
|
|
|
|
|
Driver::SysRW |
60
|
|
|
|
|
|
|
Filter::SMTP |
61
|
|
|
|
|
|
|
Filter::Line |
62
|
|
|
|
|
|
|
Session::MultiDispatch |
63
|
|
|
|
|
|
|
Component::Server::TCP |
64
|
|
|
|
|
|
|
]; |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
use vars qw[$VERSION @ISA @EXPORT]; |
67
|
|
|
|
|
|
|
$VERSION = '1.6'; |
68
|
|
|
|
|
|
|
@ISA = qw[Exporter]; |
69
|
|
|
|
|
|
|
@EXPORT = qw[ |
70
|
|
|
|
|
|
|
SMTP_SYTEM_STATUS SMTP_SYSTEM_HELP SMTP_SERVICE_READY SMTP_QUIT |
71
|
|
|
|
|
|
|
SMTP_OK SMTP_WILL_FORWARD SMTP_CANNOT_VRFY_USER |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
SMTP_START_MAIL_INPUT |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
SMTP_NOT_AVAILABLE SMTP_SERVICE_UNAVAILABLE |
76
|
|
|
|
|
|
|
SMTP_LOCAL_ERROR SMTP_NO_STORAGE |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
SMTP_SYNTAX_ERROR SMTP_ARG_SYNTAX_ERROR SMTP_NOT_IMPLEMENTED |
79
|
|
|
|
|
|
|
SMTP_BAD_SEQUENCE SMTP_ARG_NOT_IMPLEMENTED SMTP_UNAVAILABLE |
80
|
|
|
|
|
|
|
SMTP_USER_NOT_LOCAL SMTP_QUOTA_LIMIT SMTP_MAILBOX_ERROR |
81
|
|
|
|
|
|
|
SMTP_NO_SERVICE SMTP_TRANSACTION_FAILED |
82
|
|
|
|
|
|
|
]; |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
=head2 Constants |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
This module exports a bunch of constants by default. |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
SMTP_SYTEM_STATUS SMTP_SYSTEM_HELP SMTP_SERVICE_READY SMTP_QUIT |
89
|
|
|
|
|
|
|
SMTP_OK SMTP_WILL_FORWARD SMTP_CANNOT_VRFY_USER |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
SMTP_START_MAIL_INPUT |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
SMTP_NOT_AVAILABLE SMTP_SERVICE_UNAVAILABLE |
94
|
|
|
|
|
|
|
SMTP_LOCAL_ERROR SMTP_NO_STORAGE |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
SMTP_SYNTAX_ERROR SMTP_ARG_SYNTAX_ERROR SMTP_NOT_IMPLEMENTED |
97
|
|
|
|
|
|
|
SMTP_BAD_SEQUENCE SMTP_ARG_NOT_IMPLEMENTED SMTP_UNAVAILABLE |
98
|
|
|
|
|
|
|
SMTP_USER_NOT_LOCAL SMTP_QUOTA_LIMIT SMTP_MAILBOX_ERROR |
99
|
|
|
|
|
|
|
SMTP_NO_SERVICE SMTP_TRANSACTION_FAILED |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
If you don't know what these mean, see the source. |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
=cut |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
sub SMTP_SYTEM_STATUS { 211 } |
106
|
|
|
|
|
|
|
sub SMTP_SYSTEM_HELP { 211 } |
107
|
|
|
|
|
|
|
sub SMTP_SERVICE_READY { 220 } |
108
|
|
|
|
|
|
|
sub SMTP_QUIT { 221 } |
109
|
|
|
|
|
|
|
sub SMTP_OK { 250 } |
110
|
|
|
|
|
|
|
sub SMTP_WILL_FORWARD { 251 } |
111
|
|
|
|
|
|
|
sub SMTP_CANNOT_VRFY_USER { 252 } |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
sub SMTP_START_MAIL_INPUT { 354 } |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
sub SMTP_NOT_AVAILABLE { 421 } |
116
|
|
|
|
|
|
|
sub SMTP_SERVICE_UNAVAILABLE { 450 } |
117
|
|
|
|
|
|
|
sub SMTP_LOCAL_ERROR { 451 } |
118
|
|
|
|
|
|
|
sub SMTP_NO_STORAGE { 452 } |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
sub SMTP_SYNTAX_ERROR { 500 } |
121
|
|
|
|
|
|
|
sub SMTP_ARG_SYNTAX_ERROR { 501 } |
122
|
|
|
|
|
|
|
sub SMTP_NOT_IMPLEMENTED { 502 } |
123
|
|
|
|
|
|
|
sub SMTP_BAD_SEQUENCE { 503 } |
124
|
|
|
|
|
|
|
sub SMTP_ARG_NOT_IMPLEMENTED { 504 } |
125
|
|
|
|
|
|
|
sub SMTP_UNAVAILABLE { 550 } |
126
|
|
|
|
|
|
|
sub SMTP_USER_NOT_LOCAL { 551 } |
127
|
|
|
|
|
|
|
sub SMTP_QUOTA_LIMIT { 552 } |
128
|
|
|
|
|
|
|
sub SMTP_MAILBOX_ERROR { 553 } |
129
|
|
|
|
|
|
|
sub SMTP_NO_SERVICE { 554 } |
130
|
|
|
|
|
|
|
sub SMTP_TRANSACTION_FAILED { 554 } |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
=head2 spawn( %args ) |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
Create a new instance of the SMTP server. The argument list |
135
|
|
|
|
|
|
|
follows. |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
=over 4 |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
=item Alias |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
The alias name for this session. |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
=item Address |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
The address to bind to. If you don't do this you run the risk of |
146
|
|
|
|
|
|
|
becomming a relay. |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=item Hostname |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
The host name to use when identifying the SMTP server. |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
=item Port |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
The port to listen and accept connections on. |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
=item PackageStates |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
Passed directly to POE::Session::MultiDispatch. |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=item ObjectStates |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
Passed directly to POE::Session::MultiDispatch. |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
=item InlineStates |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
Passed directly to POE::Session::MultiDispatch. |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
=back |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
=cut |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
sub spawn { |
173
|
|
|
|
|
|
|
my ($class, %args) = @_; |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
$args{Alias} ||= 'smtpd'; |
176
|
|
|
|
|
|
|
$args{Hostname} ||= hostname(); |
177
|
|
|
|
|
|
|
$args{Port} ||= 25; |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
$args{PackageStates} ||= [ ]; |
180
|
|
|
|
|
|
|
$args{ObjectStates} ||= [ ]; |
181
|
|
|
|
|
|
|
$args{InlineStates} ||= { }; |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
POE::Component::Server::TCP->new( |
184
|
|
|
|
|
|
|
Address => $args{Address}, |
185
|
|
|
|
|
|
|
Alias => $args{Alias}, |
186
|
|
|
|
|
|
|
Port => $args{Port}, |
187
|
|
|
|
|
|
|
SessionType => 'POE::Session::MultiDispatch', |
188
|
|
|
|
|
|
|
# SessionParams => [ options => { debug => 1, trace => 1 } ], |
189
|
|
|
|
|
|
|
Error => \&smtpd_server_error, |
190
|
|
|
|
|
|
|
ClientConnected => \&smtpd_client_connected, |
191
|
|
|
|
|
|
|
ClientDisconnected => \&smtpd_client_disconnect, |
192
|
|
|
|
|
|
|
ClientInput => \&smtpd_client_input, |
193
|
|
|
|
|
|
|
ClientFlushed => \&smtpd_client_flushed, |
194
|
|
|
|
|
|
|
ClientError => \&smtpd_client_error, |
195
|
|
|
|
|
|
|
ClientFilter => [ 'POE::Filter::SMTP' ], |
196
|
|
|
|
|
|
|
PackageStates => $args{PackageStates}, |
197
|
|
|
|
|
|
|
ObjectStates => $args{ObjectStates}, |
198
|
|
|
|
|
|
|
InlineStates => { |
199
|
|
|
|
|
|
|
# these are shown below for reference and may move elsewhere |
200
|
|
|
|
|
|
|
# send_banner => \&smtpd_send_banner, |
201
|
|
|
|
|
|
|
# HELO => \&smtpd_HELO, |
202
|
|
|
|
|
|
|
# QUIT => \&smtpd_QUIT, |
203
|
|
|
|
|
|
|
# DATA => \&smtpd_DATA, |
204
|
|
|
|
|
|
|
# gotDATA => \&smtpd_gotDATA, |
205
|
|
|
|
|
|
|
_default => \&smtpd_default, |
206
|
|
|
|
|
|
|
%{$args{InlineStates}}, |
207
|
|
|
|
|
|
|
}, |
208
|
|
|
|
|
|
|
Args => [ \%args ], |
209
|
|
|
|
|
|
|
); |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
sub smtpd_client_connected { |
214
|
|
|
|
|
|
|
my ($kernel, $heap, $args) = @_[KERNEL, HEAP, ARG0]; |
215
|
|
|
|
|
|
|
my ($client) = $heap->{client}; |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
$heap->{args} = $args; |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
$kernel->yield( 'send_banner' ); |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
sub smtpd_client_disconnect { |
223
|
|
|
|
|
|
|
my ($kernel, $heap) = @_[KERNEL, HEAP]; |
224
|
|
|
|
|
|
|
$kernel->yield( 'do_disconnect' ); |
225
|
|
|
|
|
|
|
} |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
sub smtpd_client_input { |
228
|
|
|
|
|
|
|
my ($kernel, $heap, $input) = @_[KERNEL, HEAP, ARG0]; |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
if ( $heap->{+SMTP_START_MAIL_INPUT} ) { |
231
|
|
|
|
|
|
|
my $client = $heap->{client}; |
232
|
|
|
|
|
|
|
if ( $input eq '.' ) { |
233
|
|
|
|
|
|
|
$heap->{+SMTP_START_MAIL_INPUT} = 0; |
234
|
|
|
|
|
|
|
$client->set_input_filter( POE::Filter::SMTP->new() ); |
235
|
|
|
|
|
|
|
$kernel->yield( gotDATA => $heap->{data_input} ); |
236
|
|
|
|
|
|
|
} else { |
237
|
|
|
|
|
|
|
push @{$heap->{data_input}}, $input; |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
} else { |
240
|
|
|
|
|
|
|
my ($client, $command, $data) = ( $heap->{client}, @{$input} ); |
241
|
|
|
|
|
|
|
$kernel->yield( $command => $command => $data ); |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
sub smtpd_client_flushed { |
246
|
|
|
|
|
|
|
my ($kernel, $heap) = @_[KERNEL, HEAP]; |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
delete $heap->{client} if $heap->{shutdown_now}; |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
sub smtpd_client_error { |
252
|
|
|
|
|
|
|
my ($kernel, $heap, $syscall_name, $error_number, $error_string) = |
253
|
|
|
|
|
|
|
@_[KERNEL, HEAP, ARG0 .. ARG2]; |
254
|
|
|
|
|
|
|
} |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
sub smtpd_server_error { |
257
|
|
|
|
|
|
|
my ($kernel, $heap, $syscall_name, $error_number, $error_string) = |
258
|
|
|
|
|
|
|
@_[KERNEL, HEAP, ARG0 .. ARG2]; |
259
|
|
|
|
|
|
|
} |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
=head2 Events |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
There are only three builtin events. This way, the default |
264
|
|
|
|
|
|
|
POE::Component::Server::SMTP distribution is completley secure. Unless |
265
|
|
|
|
|
|
|
otherwise noted, event names corrispond to the uppercase version of the |
266
|
|
|
|
|
|
|
verb supplied from the client during an SMTP connection (HELO, VRFY, RCPT). |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
Any input supplied after the command verb will be available to the |
269
|
|
|
|
|
|
|
event handler in C<$_[ARG1]>, the command name itself is available in |
270
|
|
|
|
|
|
|
C<$_[ARG0]>. |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
=over 4 |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
=item send_banner |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
This event is triggered when a client connects and it's time to send |
277
|
|
|
|
|
|
|
a banner. This can be supplied in your own |
278
|
|
|
|
|
|
|
C event in your C. |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
=cut |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
sub smtpd_send_banner { |
283
|
|
|
|
|
|
|
my ($kernel, $heap) = |
284
|
|
|
|
|
|
|
@_[KERNEL, HEAP]; |
285
|
|
|
|
|
|
|
my $client = $heap->{client}; |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
my $banner = join( ' ', |
288
|
|
|
|
|
|
|
$heap->{args}->{Hostname}, |
289
|
|
|
|
|
|
|
'ESMTP', |
290
|
|
|
|
|
|
|
__PACKAGE__, |
291
|
|
|
|
|
|
|
'v'.$POE::Component::Server::SMTP::VERSION ); |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
$client->put( SMTP_SERVICE_READY, $banner ); |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
=item HELO |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
This event is triggered when a client sends a HELO command. |
299
|
|
|
|
|
|
|
This can be supplied in your own |
300
|
|
|
|
|
|
|
C event in your C. |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
=cut |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
sub smtpd_HELO { |
305
|
|
|
|
|
|
|
my ($kernel, $heap, $host) = |
306
|
|
|
|
|
|
|
@_[KERNEL, HEAP, ARG1]; |
307
|
|
|
|
|
|
|
my $client = $heap->{client}; |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
if ( $host && $host eq $heap->{args}->{Hostname} ) { |
310
|
|
|
|
|
|
|
$client->put( SMTP_OK, qq[$heap->{args}->{Hostname} Would you like to play a game?] ); |
311
|
|
|
|
|
|
|
} else { |
312
|
|
|
|
|
|
|
$client->put( SMTP_ARG_SYNTAX_ERROR, qq[Syntax: HELO hostname] ); |
313
|
|
|
|
|
|
|
} |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
=item QUIT |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
This event is triggered when a client sends a QUIT command. |
319
|
|
|
|
|
|
|
This can be supplied in your own |
320
|
|
|
|
|
|
|
C event in your C. |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
This event should always set C<$heap->{shutdown_now}> to a true value. |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
=back |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
=cut |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
sub smtpd_QUIT { |
329
|
|
|
|
|
|
|
my ($kernel, $heap) = |
330
|
|
|
|
|
|
|
@_[KERNEL, HEAP]; |
331
|
|
|
|
|
|
|
my $client = $heap->{client}; |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
$client->put( SMTP_QUIT, q[How about a nice game of chess?] ); |
334
|
|
|
|
|
|
|
$heap->{shutdown_now} = 1; |
335
|
|
|
|
|
|
|
} |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
=pod |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
In the source of this module there are two example handlers for handling |
340
|
|
|
|
|
|
|
the C event. The C event is kind of tricky, so refer to the |
341
|
|
|
|
|
|
|
C and C subroutines in the source. |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
=cut |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
sub smtpd_DATA { |
346
|
|
|
|
|
|
|
my ($kernel, $heap) = |
347
|
|
|
|
|
|
|
@_[KERNEL, HEAP]; |
348
|
|
|
|
|
|
|
my $client = $heap->{client}; |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
$heap->{+SMTP_START_MAIL_INPUT} = 1; |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
$client->put( SMTP_START_MAIL_INPUT, q[You selected Global Thermo Nuclear War.] ); |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
$client->set_input_filter( POE::Filter::Line->new( Literal => POE::Filter::SMTP::CRLF ) ); |
355
|
|
|
|
|
|
|
} |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
sub smtpd_gotDATA { |
358
|
|
|
|
|
|
|
my ($kernel, $heap) = |
359
|
|
|
|
|
|
|
@_[KERNEL, HEAP]; |
360
|
|
|
|
|
|
|
my $client = $heap->{client}; |
361
|
|
|
|
|
|
|
my $data = join POE::Filter::SMTP::CRLF, @{$heap->{data_input}}; |
362
|
|
|
|
|
|
|
print $data; |
363
|
|
|
|
|
|
|
$client->put( SMTP_OK, q[Got data.] ); |
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
=pod |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
=item on_disconnect |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
This event is called when the client disconnects. Specifically, when |
371
|
|
|
|
|
|
|
POE::Component::Server::TCP throws the C state. You |
372
|
|
|
|
|
|
|
can't always rely on an SMTP client calling C, so use this for |
373
|
|
|
|
|
|
|
garbage collection or handling an unexpected end of session. |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
=cut |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
=pod |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
Any event that it triggered from the client that the server doesn't know |
380
|
|
|
|
|
|
|
how to handle will be passed to the C<_default> handler. This handler |
381
|
|
|
|
|
|
|
will return C, unless you override it using |
382
|
|
|
|
|
|
|
C and do something else. |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
=cut |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
sub smtpd_default { |
387
|
|
|
|
|
|
|
my ($kernel, $heap) = |
388
|
|
|
|
|
|
|
@_[KERNEL, HEAP]; |
389
|
|
|
|
|
|
|
my $client = $heap->{client}; |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
$client->put( SMTP_NOT_IMPLEMENTED, q[Error: command not implemented] ); |
392
|
|
|
|
|
|
|
} |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
1; |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
__END__ |