Ticket #107: SMTP.pm

File SMTP.pm, 14.6 kB (added by amatubu, 3 years ago)

Replacement of SMTP.pm

Line 
1 # POPFILE LOADABLE MODULE
2 package Proxy::SMTP;
3
4 use 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
30 use strict;
31 use warnings;
32 use locale;
33
34 # A handy variable containing the value of an EOL for networks
35 my $eol = "\015\012";
36
37 #----------------------------------------------------------------------------
38 # new
39 #
40 #   Class new() function
41 #----------------------------------------------------------------------------
42 sub 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 # ----------------------------------------------------------------------------
68 sub 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 # ----------------------------------------------------------------------------
107 sub 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 # ----------------------------------------------------------------------------
158 sub 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 # ----------------------------------------------------------------------------
330 sub 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
352 sub 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
389 sub 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
439 1;