Ticket #107: SMTP.pm

File SMTP.pm, 14.6 KB (added by naoki iimura, 14 years ago)

Replacement of SMTP.pm

Line 
1# POPFILE LOADABLE MODULE
2package Proxy::SMTP;
3
4use Proxy::Proxy;
5@ISA = ("Proxy::Proxy");
6
7# ----------------------------------------------------------------------------
8#
9# This module handles proxying the SMTP protocol for POPFile.
10#
11# Copyright (c) 2001-2009 John Graham-Cumming
12#
13# This file is part of POPFile
14#
15# POPFile is free software; you can redistribute it and/or modify it
16# under the terms of version 2 of the GNU General Public License as
17# published by the Free Software Foundation.
18#
19# POPFile is distributed in the hope that it will be useful,
20# but WITHOUT ANY WARRANTY; without even the implied warranty of
21# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22# GNU General Public License for more details.
23#
24# You should have received a copy of the GNU General Public License
25# along with POPFile; if not, write to the Free Software
26# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
27#
28# ----------------------------------------------------------------------------
29
30use strict;
31use warnings;
32use locale;
33
34# A handy variable containing the value of an EOL for networks
35my $eol = "\015\012";
36
37#----------------------------------------------------------------------------
38# new
39#
40# Class new() function
41#----------------------------------------------------------------------------
42sub new
43{
44 my $type = shift;
45 my $self = Proxy::Proxy->new();
46
47 # Must call bless before attempting to call any methods
48
49 bless $self, $type;
50
51 $self->name( 'smtp' );
52
53 $self->{child_} = \&child__;
54 $self->{connection_timeout_error_} = '554 Transaction failed';
55 $self->{connection_failed_error_} = '554 Transaction failed, can\'t connect to';
56 $self->{good_response_} = '^[23]';
57
58 return $self;
59}
60
61# ----------------------------------------------------------------------------
62#
63# initialize
64#
65# Called to initialize the SMTP proxy module
66#
67# ----------------------------------------------------------------------------
68sub initialize
69{
70 my ( $self ) = @_;
71
72 # By default we don't fork on Windows
73 $self->config_( 'force_fork', ($^O eq 'MSWin32')?0:1 );
74
75 # Default port for SMTP service
76 $self->config_( 'port', 25 );
77
78 # Where to forward on to
79 $self->config_( 'chain_server', '' );
80 $self->config_( 'chain_port', 25 );
81
82 # Forward on to unix socket
83 $self->config_( 'chain_unix_socket', '' );
84
85 # Only accept connections from the local machine for smtp
86 $self->config_( 'local', 1 );
87
88 # The welcome string from the proxy is configurable
89 $self->config_( 'welcome_string', "SMTP POPFile ($self->{version_}) welcome" );
90
91 if ( !$self->SUPER::initialize() ) {
92 return 0;
93 }
94
95 $self->config_( 'enabled', 0 );
96
97 return 1;
98}
99
100# ----------------------------------------------------------------------------
101#
102# start
103#
104# Called to start the SMTP proxy module
105#
106# ----------------------------------------------------------------------------
107sub start
108{
109 my ( $self ) = @_;
110
111 # If we are not enabled then no further work happens in this module
112
113 if ( $self->config_( 'enabled' ) == 0 ) {
114 return 2;
115 }
116
117 # Tell the user interface module that we having a configuration
118 # item that needs a UI component
119
120 $self->register_configuration_item_( 'configuration',
121 'smtp_fork_and_port',
122 'smtp-configuration.thtml',
123 $self );
124
125 $self->register_configuration_item_( 'security',
126 'smtp_local',
127 'smtp-security-local.thtml',
128 $self );
129
130 $self->register_configuration_item_( 'chain',
131 'smtp_server',
132 'smtp-chain-server.thtml',
133 $self );
134
135 $self->register_configuration_item_( 'chain',
136 'smtp_server_port',
137 'smtp-chain-server-port.thtml',
138 $self );
139
140 if ( $self->config_( 'welcome_string' ) =~ /^SMTP POPFile \(v\d+\.\d+\.\d+\) welcome$/ ) { # PROFILE BLOCK START
141 $self->config_( 'welcome_string', "SMTP POPFile ($self->{version_}) welcome" ); # PROFILE BLOCK STOP
142 }
143
144 return $self->SUPER::start();;
145}
146
147# ----------------------------------------------------------------------------
148#
149# child__
150#
151# The worker method that is called when we get a good connection from
152# a client
153#
154# $client - an open stream to a SMTP client
155# $session - API session key
156#
157# ----------------------------------------------------------------------------
158sub child__
159{
160 my ( $self, $client, $session ) = @_;
161
162 # Number of messages downloaded in this session
163
164 my $count = 0;
165
166 # The handle to the real mail server gets stored here
167
168 my $mail;
169
170 # Tell the client that we are ready for commands and identify our
171 # version number
172
173 $self->tee_( $client, "220 " . $self->config_( 'welcome_string' ) . "$eol" );
174
175 # Retrieve commands from the client and process them until the
176 # client disconnects or we get a specific QUIT command
177
178 while ( <$client> ) {
179 my $command;
180
181 $command = $_;
182
183 # Clean up the command so that it has a nice clean $eol at the end
184 $command =~ s/(\015|\012)//g;
185
186 $self->log_( 2, "Command: --$command--" );
187
188 if ( $command =~ /HELO/i ) {
189 if ( $self->config_( 'chain_server' ) || # PROFILE BLOCK START
190 $self->config_( 'chain_unix_socket' ) ) { # PROFILE BLOCK STOP
191 if ( $mail = $self->verify_connected_( # PROFILE BLOCK START
192 $mail,
193 $client,
194 $self->config_( 'chain_server' ),
195 $self->config_( 'chain_port' ),
196 0,
197 $self->config_( 'chain_unix_socket' ) ) ) { # PROFILE BLOCK STOP
198
199 $self->smtp_echo_response_( $mail, $client, $command );
200 } else {
201 last;
202 }
203 } else {
204 $self->tee_( $client, "421 service not available$eol" );
205 }
206
207 next;
208 }
209
210 # Handle EHLO specially so we can control what ESMTP extensions are negotiated
211
212 if ( $command =~ /EHLO/i ) {
213 if ( $self->config_( 'chain_server' ) || # PROFILE BLOCK START
214 $self->config_( 'chain_unix_socket' ) ) { # PROFILE BLOCK STOP
215 if ( $mail = $self->verify_connected_( # PROFILE BLOCK START
216 $mail,
217 $client,
218 $self->config_( 'chain_server' ),
219 $self->config_( 'chain_port' ),
220 0,
221 $self->config_( 'chain_unix_socket' ) ) ) { # PROFILE BLOCK STOP
222
223 # TODO: Make this user-configurable (-smtp_add_unsupported, -smtp_remove_unsupported)
224
225 # Stores a list of unsupported ESMTP extensions
226
227 my $unsupported;
228
229 # RFC 1830, http://www.faqs.org/rfcs/rfc1830.html
230 # CHUNKING and BINARYMIME both require the support of the "BDAT" command
231 # support of BDAT requires extensive changes to POPFile's internals and
232 # will not be implemented at this time
233
234 $unsupported .= "CHUNKING|BINARYMIME|XEXCH50";
235
236 # append unsupported ESMTP extensions to $unsupported here, important to maintain
237 # format of OPTION|OPTION2|OPTION3
238
239 $unsupported = qr/250\-$unsupported/;
240
241 $self->smtp_echo_response_( $mail, $client, $command, $unsupported );
242
243
244 } else {
245 last;
246 }
247 } else {
248 $self->tee_( $client, "421 service not available$eol" );
249 }
250
251 next;
252 }
253
254 if ( ( $command =~ /MAIL FROM:/i ) || # PROFILE BLOCK START
255 ( $command =~ /RCPT TO:/i ) ||
256 ( $command =~ /VRFY/i ) ||
257 ( $command =~ /EXPN/i ) ||
258 ( $command =~ /NOOP/i ) ||
259 ( $command =~ /HELP/i ) ||
260 ( $command =~ /RSET/i ) ) { # PROFILE BLOCK STOP
261 $self->smtp_echo_response_( $mail, $client, $command );
262 next;
263 }
264
265 if ( $command =~ /DATA/i ) {
266 # Get the message from the remote server, if there's an error then we're done, but if not then
267 # we echo each line of the message until we hit the . at the end
268 if ( $self->smtp_echo_response_( $mail, $client, $command ) ) {
269 $count += 1;
270
271 my ( $class, $history_file ) = $self->{classifier__}->classify_and_modify( $session, $client, $mail, 0, '', 0 );
272
273 my $response = $self->slurp_( $mail );
274 $self->tee_( $client, $response );
275 next;
276 }
277 }
278
279 # The mail client wants to stop using the server, so send that message through to the
280 # real mail server, echo the response back up to the client and exit the while. We will
281 # close the connection immediately
282 if ( $command =~ /QUIT/i ) {
283 if ( $mail ) {
284 $self->smtp_echo_response_( $mail, $client, $command );
285 close $mail;
286 } else {
287 $self->tee_( $client, "221 goodbye$eol" );
288 }
289 last;
290 }
291
292 # Don't know what this is so let's just pass it through and hope for the best
293 if ( $mail && $mail->connected ) {
294 $self->smtp_echo_response_( $mail, $client, $command );
295 next;
296 } else {
297 $self->tee_( $client, "500 unknown command or bad syntax$eol" );
298 last;
299 }
300 }
301
302 if ( defined( $mail ) ) {
303 $self->done_slurp_( $mail );
304 close $mail;
305 }
306
307 close $client;
308 $self->mq_post_( 'CMPLT', $$ );
309 $self->log_( 0, "SMTP proxy done" );
310}
311
312# ----------------------------------------------------------------------------
313#
314# smtp_echo_response_
315#
316# $mail The stream (created with IO::) to send the message to (the remote mail server)
317# $client The local mail client (created with IO::) that needs the response
318# $command The text of the command to send (we add an EOL)
319# $suppress (OPTIONAL) suppress any lines that match, compile using qr/pattern/
320#
321# Send $command to $mail, receives the response and echoes it to the $client and the debug
322# output.
323#
324# This subroutine returns responses from the server as defined in appendix E of
325# RFC 821, allowing multi-line SMTP responses.
326#
327# Returns true if the initial response is a 2xx or 3xx series (as defined by {good_response_}
328#
329# ----------------------------------------------------------------------------
330sub smtp_echo_response_
331{
332 my ($self, $mail, $client, $command, $suppress) = @_;
333 my ( $response, $ok ) = $self->get_response_( $mail, $client, $command );
334
335 if ( $response =~ /^\d\d\d-/ ) {
336 $self->echo_to_regexp_($mail, $client, qr/^\d\d\d /, 1, $suppress);
337 }
338 return ( $response =~ /$self->{good_response_}/ );
339}
340
341# ----------------------------------------------------------------------------
342#
343# configure_item
344#
345# $name Name of this item
346# $templ The loaded template that was passed as a parameter
347# when registering
348# $language Current language
349#
350# ----------------------------------------------------------------------------
351
352sub configure_item
353{
354 my ( $self, $name, $templ, $language ) = @_;
355
356 if ( $name eq 'smtp_fork_and_port' ) {
357 $templ->param( 'smtp_port' => $self->config_( 'port' ) );
358 $templ->param( 'smtp_force_fork_on' => $self->config_( 'force_fork' ) );
359 }
360
361 if ( $name eq 'smtp_local' ) {
362 $templ->param( 'smtp_local_on' => $self->config_( 'local' ) );
363 }
364
365 if ( $name eq 'smtp_server' ) {
366 $templ->param( 'smtp_chain_server' => $self->config_( 'chain_server' ) );
367 }
368
369 if ( $name eq 'smtp_server_port' ) {
370 $templ->param( 'smtp_chain_port' => $self->config_( 'chain_port' ) );
371 }
372
373
374 #$self->SUPER::configure_item( $name, $templ, $language );
375}
376
377# ----------------------------------------------------------------------------
378#
379# validate_item
380#
381# $name The name of the item being configured, was passed in by the call
382# to register_configuration_item
383# $templ The loaded template
384# $language The language currently in use
385# $form Hash containing all form items
386#
387# ----------------------------------------------------------------------------
388
389sub validate_item
390{
391 my ( $self, $name, $templ, $language, $form ) = @_;
392
393 if ( $name eq 'smtp_fork_and_port' ) {
394
395 if ( defined($$form{smtp_force_fork}) ) {
396 $self->config_( 'force_fork', $$form{smtp_force_fork} );
397 }
398
399 if ( defined($$form{smtp_port}) ) {
400 if ( ( $$form{smtp_port} >= 1 ) && ( $$form{smtp_port} < 65536 ) ) {
401 $self->config_( 'port', $$form{smtp_port} );
402 $templ->param( 'smtp_port_feedback' => sprintf( $$language{Configuration_SMTPUpdate}, $self->config_( 'port' ) ) );
403 } else {
404 $templ->param( 'smtp_port_feedback' => "<div class=\"error01\">$$language{Configuration_Error3}</div>" );
405 }
406 }
407 }
408
409 if ( $name eq 'smtp_local' ) {
410 if ( defined $$form{smtp_local} ) {
411 $self->config_( 'local', $$form{smtp_local} );
412 }
413 }
414
415 if ( $name eq 'smtp_server' ) {
416 if ( defined $$form{smtp_chain_server} ) {
417 $self->config_( 'chain_server', $$form{smtp_chain_server} );
418 $templ->param( 'smtp_server_feedback' => sprintf $$language{Security_SMTPServerUpdate}, $self->config_( 'chain_server' ) ) ;
419 }
420 }
421
422 if ( $name eq 'smtp_server_port' ) {
423 if ( defined $$form{smtp_chain_server_port} ) {
424
425 if ( ( $$form{smtp_chain_server_port} >= 1 ) && ( $$form{smtp_chain_server_port} < 65536 ) ) {
426 $self->config_( 'chain_port', $$form{smtp_chain_server_port} );
427 $templ->param( 'smtp_port_feedback' => sprintf $$language{Security_SMTPPortUpdate}, $self->config_( 'chain_port' ) );
428 }
429 else {
430 $templ->param( 'smtp_port_feedback' => "<div class=\"error01\">$$language{Security_Error1}</div>" );
431 }
432 }
433 }
434
435
436 #$self->SUPER::validate_item( $name, $templ, $language, $form );
437}
438
4391;