Menu
▾
▴
[popfile-commit] engine/Proxy POP3.pm,1.40,1.41 SMTP.pm,1.3,1.4
|
From: <jgr...@us...> - 2003-03-03 15:22:24
|
Update of /cvsroot/popfile/engine/Proxy
In directory sc8-pr-cvs1:/tmp/cvs-serv12042/Proxy
Modified Files:
POP3.pm SMTP.pm
Log Message:
Partial and broken work on POPFile refactoring; READ ONLY at this point; do not bother running unless you are very brave
Index: POP3.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Proxy/POP3.pm,v
retrieving revision 1.40
retrieving revision 1.41
diff -C2 -d -r1.40 -r1.41
*** POP3.pm 26 Feb 2003 04:35:12 -0000 1.40
--- POP3.pm 3 Mar 2003 15:21:46 -0000 1.41
***************
*** 2,8 ****
package Proxy::POP3;
# ---------------------------------------------------------------------------------------------
#
! # This module handles proxying the POP3 protocol for POPFile.
#
# Copyright (c) 2001-2003 John Graham-Cumming
--- 2,11 ----
package Proxy::POP3;
[...1052 lines suppressed...]
! while( 1 ) {
! last unless () = $selector->can_read(0.01);
! last unless ( my $n = sysread( $mail, $buf, $max_length, length $buf ) );
!
! tee( $self, $client, $buf ) if ( $discard != 1 );
! return $buf;
! }
! }
! }
! return '';
! }
--- 411,418 ----
close $client;
close $pipe;
! $self->log_( "POP3 forked child done" );
}
! # TODO echo_response_ that calls echo_response_ with the extra parameters
! # required et al.
Index: SMTP.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Proxy/SMTP.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** SMTP.pm 13 Feb 2003 21:24:17 -0000 1.3
--- SMTP.pm 3 Mar 2003 15:21:48 -0000 1.4
***************
*** 1,8 ****
! # POPFILE LOADABLE MODULE
package Proxy::SMTP;
# ---------------------------------------------------------------------------------------------
#
! # This module handles proxying the SMTP protocol for POPFile.
#
# Copyright (c) 2001-2003 John Graham-Cumming
--- 1,11 ----
! # DISABLED POPFILE LOADABLE MODULE
package Proxy::SMTP;
+ use Proxy::Proxy;
+ @ISA = ("Proxy::Proxy");
+
# ---------------------------------------------------------------------------------------------
#
! # This module handles proxying the SMTP protocol for POPFile.
#
# Copyright (c) 2001-2003 John Graham-Cumming
***************
*** 10,30 ****
# ---------------------------------------------------------------------------------------------
- use IO::Socket;
- use IO::Select;
-
use strict;
use warnings;
use locale;
! # This is used to get the hostname of the current machine
! # in a cross platform way
! use Sys::Hostname;
!
! # A handy variable containing the value of an EOL for Unix systems
my $eol = "\015\012";
- # Constant used by the log rotation code
- my $seconds_per_day = 60 * 60 * 24;
-
#----------------------------------------------------------------------------
# new
--- 13,23 ----
# ---------------------------------------------------------------------------------------------
use strict;
use warnings;
use locale;
! # A handy variable containing the value of an EOL for networks
my $eol = "\015\012";
#----------------------------------------------------------------------------
# new
***************
*** 32,59 ****
# Class new() function
#----------------------------------------------------------------------------
! sub new
{
my $type = shift;
my $self;
-
- # A reference to the POPFile::Configuration module
- $self->{configuration} = 0;
! # A reference to the classifier
! $self->{classifier} = 0;
!
! # The name of the debug file
! $self->{debug_filename} = '';
!
! # The name of the last user to pass through POPFile
! $self->{lastuser} = 'none';
! # Used to tell any loops to terminate
! $self->{alive} = 1;
!
! # Just our hostname
! $self->{hostname} = '';
!
! return bless $self, $type;
}
--- 25,40 ----
# Class new() function
#----------------------------------------------------------------------------
! sub new
{
my $type = shift;
my $self;
! # Must call bless before attempting to call any methods
! bless $self, $type;
!
! $self->name( 'smtp' );
!
! return $self;
}
***************
*** 69,78 ****
my ( $self ) = @_;
- # Start with debugging to file
- $self->{configuration}->{configuration}{debug} = 1;
-
# Default ports for SMTP
$self->{configuration}->{configuration}{smtp_port} = 25;
!
# Where to forward on to
$self->{configuration}->{configuration}{smtp_chain_server} = '';
--- 50,56 ----
my ( $self ) = @_;
# Default ports for SMTP
$self->{configuration}->{configuration}{smtp_port} = 25;
!
# Where to forward on to
$self->{configuration}->{configuration}{smtp_chain_server} = '';
***************
*** 80,187 ****
# Only accept connections from the local machine for smtp
! $self->{configuration}->{configuration}{localsmtp} = 1;
!
! return 1;
! }
!
! # ---------------------------------------------------------------------------------------------
! #
! # start
! #
! # Called when the SMTP interface is allowed to start up
! #
! # ---------------------------------------------------------------------------------------------
! sub start
! {
! my ( $self ) = @_;
!
! # Ensure that the messages subdirectory exists
! mkdir( 'messages' );
!
! # Get the hostname for use in the X-POPFile-Link header
! $self->{hostname} = hostname;
!
! # Open the socket used to receive request for SMTP service
! $self->{server} = IO::Socket::INET->new( Proto => 'tcp',
! $self->{configuration}->{configuration}{localsmtp} == 1 ? (LocalAddr => 'localhost') : (),
! LocalPort => $self->{configuration}->{configuration}{smtp_port},
! Listen => SOMAXCONN,
! Reuse => 1 ) or return 0;
!
! # This is used to perform select calls on the $server socket so that we can decide when there is
! # a call waiting an accept it without having to block
! $self->{selector} = new IO::Select( $self->{server} );
!
! return 1;
! }
!
! # ---------------------------------------------------------------------------------------------
! #
! # stop
! #
! # Called when the SMTP interface must terminate
! #
! # ---------------------------------------------------------------------------------------------
! sub stop
! {
! my ( $self ) = @_;
!
! close $self->{server} if ( defined( $self->{server} ) );
! }
!
! # ---------------------------------------------------------------------------------------------
! #
! # name
! #
! # Called to get the simple name for this module
! #
! # ---------------------------------------------------------------------------------------------
! sub name
! {
! my ( $self ) = @_;
!
! return 'smtp';
! }
!
! # ---------------------------------------------------------------------------------------------
! #
! # service
! #
! # Called to handle SMTP requests
! #
! # ---------------------------------------------------------------------------------------------
! sub service
! {
! my ( $self ) = @_;
!
! # Accept a connection from a client trying to use us as the mail server. We service one client at a time
! # and all others get queued up to be dealt with later. We check the alive boolean here to make sure we
! # are still allowed to operate. See if there's a connection waiting on the $server by getting the list of
! # handles with data to read, if the handle is the server then we're off.
! my ($ready) = $self->{selector}->can_read(0);
!
! # If the $server is ready then we can go ahead and accept the connection
! if ( ( defined($ready) ) && ( $ready == $self->{server} ) ) {
! if ( my $client = $self->{server}->accept() ) {
! # Check that this is a connection from the local machine, if it's not then we drop it immediately
! # without any further processing. We don't want to act as a proxy for just anyone's email
! my ( $remote_port, $remote_host ) = sockaddr_in( $client->peername() );
!
! if ( ( $self->{configuration}->{configuration}{localpop} == 0 ) || ( $remote_host eq inet_aton( "127.0.0.1" ) ) ) {
! # Now that we have a good connection to the client fork a subprocess to handle the communication
! $self->{configuration}->{configuration}{download_count} += 1;
! my $pid = &{$self->{forker}};
!
! # If we fail to fork, or are in the child process then process this request
! if ( !defined( $pid ) || ( $pid == 0 ) ) {
! child( $self, $client, $self->{configuration}->{configuration}{download_count} );
! exit(0) if ( defined( $pid ) );
! }
! }
- close $client;
- }
- }
-
return 1;
}
--- 58,63 ----
# Only accept connections from the local machine for smtp
! $self->{configuration}->{configuration}{smtp} = 1;
return 1;
}
***************
*** 189,218 ****
# ---------------------------------------------------------------------------------------------
#
- # forked
- #
- # Called when someone forks POPFile
- #
- # ---------------------------------------------------------------------------------------------
- sub forked
- {
- my ( $self ) = @_;
-
- close $self->{server};
- }
-
- # ---------------------------------------------------------------------------------------------
- #
- # reaper
- #
- # Called to reap our dead children
- #
- # ---------------------------------------------------------------------------------------------
- sub reaper
- {
- my ( $self ) = @_;
- }
-
- # ---------------------------------------------------------------------------------------------
- #
# child
#
--- 65,68 ----
***************
*** 232,236 ****
# The handle to the real mail server gets stored here
my $mail;
!
# Tell the client that we are ready for commands and identify our version number
tee( $self, $client, "220 SMTP POPFile (v$self->{configuration}->{major_version}.$self->{configuration}->{minor_version}.$self->{configuration}->{build_version}) server ready$eol" );
--- 82,86 ----
# The handle to the real mail server gets stored here
my $mail;
!
# Tell the client that we are ready for commands and identify our version number
tee( $self, $client, "220 SMTP POPFile (v$self->{configuration}->{major_version}.$self->{configuration}->{minor_version}.$self->{configuration}->{build_version}) server ready$eol" );
***************
*** 267,271 ****
}
! if ( ( $command =~ /MAIL FROM:/i ) ||
( $command =~ /RCPT TO:/i ) ||
( $command =~ /VRFY/i ) ||
--- 117,121 ----
}
! if ( ( $command =~ /MAIL FROM:/i ) ||
( $command =~ /RCPT TO:/i ) ||
( $command =~ /VRFY/i ) ||
***************
*** 320,376 ****
# ---------------------------------------------------------------------------------------------
#
- # debug
- #
- # $message A string containing a debug message that may or may not be printed
- #
- # Prints the passed string if the global $debug is true
- #
- # ---------------------------------------------------------------------------------------------
- sub debug
- {
- my ( $self, $message ) = @_;
-
- if ( $self->{configuration}->{configuration}{debug} > 0 ) {
- # Check to see if we are handling the USER/PASS command and if we are then obscure the
- # account information
- $message = "$`$1$3 XXXXXX$4" if ( $message =~ /((--)?)(USER|PASS)\s+\S*(\1)/ );
- chomp $message;
- $message .= "\n";
-
- my $now = localtime;
- my $msg = "$now ($$): $message";
-
- if ( $self->{configuration}->{configuration}{debug} & 1 ) {
- open DEBUG, ">>$self->{debug_filename}";
- binmode DEBUG;
- print DEBUG $msg;
- close DEBUG;
- }
-
- print $msg if ( $self->{configuration}->{configuration}{debug} & 2 );
- }
- }
-
- # ---------------------------------------------------------------------------------------------
- #
- # tee
- #
- # $socket The stream (created with IO::) to send the string to
- # $text The text to output
- #
- # Sends $text to $socket and sends $text to debug output
- #
- # ---------------------------------------------------------------------------------------------
- sub tee
- {
- my ( $self, $socket, $text ) = @_;
-
- # Send the message to the debug output and then send it to the appropriate socket
- debug( $self, $text );
- print $socket $text if $socket->connected;
- }
-
- # ---------------------------------------------------------------------------------------------
- #
# get_response
#
--- 170,173 ----
***************
*** 379,390 ****
# $command The text of the command to send (we add an EOL)
#
! # Send $command to $mail, receives the response and echoes it to the $client and the debug
# output. Returns the response
#
# ---------------------------------------------------------------------------------------------
! sub get_response
{
my ( $self, $mail, $client, $command ) = @_;
!
unless ( $mail ) {
# $mail is undefined - return an error intead of crashing
--- 176,187 ----
# $command The text of the command to send (we add an EOL)
#
! # Send $command to $mail, receives the response and echoes it to the $client and the debug
# output. Returns the response
#
# ---------------------------------------------------------------------------------------------
! sub get_response
{
my ( $self, $mail, $client, $command ) = @_;
!
unless ( $mail ) {
# $mail is undefined - return an error intead of crashing
***************
*** 395,405 ****
# Send the command (followed by the appropriate EOL) to the mail server
tee( $self, $mail, $command. $eol );
!
my $response;
!
# Retrieve a single string containing the response
if ( $mail->connected ) {
$response = <$mail>;
!
if ( $response ) {
# Echo the response up to the mail client
--- 192,202 ----
# Send the command (followed by the appropriate EOL) to the mail server
tee( $self, $mail, $command. $eol );
!
my $response;
!
# Retrieve a single string containing the response
if ( $mail->connected ) {
$response = <$mail>;
!
if ( $response ) {
# Echo the response up to the mail client
***************
*** 411,415 ****
}
}
!
return $response;
}
--- 208,212 ----
}
}
!
return $response;
}
***************
*** 423,434 ****
# $command The text of the command to send (we add an EOL)
#
! # Send $command to $mail, receives the response and echoes it to the $client and the debug
# output. Returns true if the response was +OK and false if not
#
# ---------------------------------------------------------------------------------------------
! sub echo_response
{
my ( $self, $mail, $client, $command ) = @_;
!
# Determine whether the response began with the string +OK. If it did then return 1
# else return 0
--- 220,231 ----
# $command The text of the command to send (we add an EOL)
#
! # Send $command to $mail, receives the response and echoes it to the $client and the debug
# output. Returns true if the response was +OK and false if not
#
# ---------------------------------------------------------------------------------------------
! sub echo_response
{
my ( $self, $mail, $client, $command ) = @_;
!
# Determine whether the response began with the string +OK. If it did then return 1
# else return 0
***************
*** 438,468 ****
# ---------------------------------------------------------------------------------------------
#
- # echo_to_dot
- #
- # $mail The stream (created with IO::) to send the message to (the remote mail server)
- # $client The local mail client (created with IO::) that needs the response
- #
- # echo all information from the $mail server until a single line with a . is seen
- #
- # ---------------------------------------------------------------------------------------------
- sub echo_to_dot
- {
- my ( $self, $mail, $client ) = @_;
-
- while ( <$mail> ) {
- # Check for an abort
- last if ( $self->{alive} == 0 );
-
- print $client $_;
-
- # The termination has to be a single line with exactly a dot on it and nothing
- # else other than line termination characters. This is vital so that we do
- # not mistake a line beginning with . as the end of the block
- last if ( /^\.(\r\n|\r|\n)$/ );
- }
- }
-
- # ---------------------------------------------------------------------------------------------
- #
# verify_connected
#
--- 235,238 ----
***************
*** 476,486 ****
#
# ---------------------------------------------------------------------------------------------
! sub verify_connected
{
my ( $self, $mail, $client, $hostname, $port ) = @_;
!
# Check to see if we are already connected
return $mail if ( $mail && $mail->connected );
!
# Connect to the real mail server on the standard port
$mail = IO::Socket::INET->new(
--- 246,256 ----
#
# ---------------------------------------------------------------------------------------------
! sub verify_connected
{
my ( $self, $mail, $client, $hostname, $port ) = @_;
!
# Check to see if we are already connected
return $mail if ( $mail && $mail->connected );
!
# Connect to the real mail server on the standard port
$mail = IO::Socket::INET->new(
***************
*** 490,505 ****
# Check that the connect succeeded for the remote server
! if ( $mail ) {
if ( $mail->connected ) {
! # Wait 10 seconds for a response from the remote server and if
# there isn't one then give up trying to connect
my $selector = new IO::Select( $mail );
last unless () = $selector->can_read($self->{configuration}->{configuration}{timeout});
!
# Read the response from the real server and say OK
my $buf = '';
my $max_length = 8192;
my $n = sysread( $mail, $buf, $max_length, length $buf );
!
debug( $self, "Connection returned: $buf" );
if ( !( $buf =~ /[\r\n]/ ) ) {
--- 260,275 ----
# Check that the connect succeeded for the remote server
! if ( $mail ) {
if ( $mail->connected ) {
! # Wait 10 seconds for a response from the remote server and if
# there isn't one then give up trying to connect
my $selector = new IO::Select( $mail );
last unless () = $selector->can_read($self->{configuration}->{configuration}{timeout});
!
# Read the response from the real server and say OK
my $buf = '';
my $max_length = 8192;
my $n = sysread( $mail, $buf, $max_length, length $buf );
!
debug( $self, "Connection returned: $buf" );
if ( !( $buf =~ /[\r\n]/ ) ) {
***************
*** 514,518 ****
# Tell the client we failed
tee( $self, $client, "554 Transaction failed failed to connect to $hostname:$port$eol" );
!
return undef;
}
--- 284,288 ----
# Tell the client we failed
tee( $self, $client, "554 Transaction failed failed to connect to $hostname:$port$eol" );
!
return undef;
}
***************
*** 529,536 ****
#
# ---------------------------------------------------------------------------------------------
! sub flush_extra
{
my ( $self, $mail, $client, $discard ) = @_;
!
if ( $mail ) {
if ( $mail->connected ) {
--- 299,306 ----
#
# ---------------------------------------------------------------------------------------------
! sub flush_extra
{
my ( $self, $mail, $client, $discard ) = @_;
!
if ( $mail ) {
if ( $mail->connected ) {
|
