[popfile-commit] engine/Proxy POP3.pm,1.40,1.41 SMTP.pm,1.3,1.4

[<jgr...@us...>]

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 ) {