/usr/share/popfile/Proxy/Proxy.pm

package Proxy::Proxy;

# ----------------------------------------------------------------------------
#
# This module implements the base class for all POPFile proxy Modules
#
# Copyright (c) 2001-2011 John Graham-Cumming
#
#   This file is part of POPFile
#
#   POPFile is free software; you can redistribute it and/or modify it
#   under the terms of version 2 of the GNU General Public License as
#   published by the Free Software Foundation.
#
#   POPFile is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with POPFile; if not, write to the Free Software
#   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
#   Modified by     Sam Schinke (sschinke@users.sourceforge.net)
#
# ----------------------------------------------------------------------------

use POPFile::Module;
@ISA = ( "POPFile::Module" );

use IO::Handle;
use IO::Socket;
use IO::Select;

# A handy variable containing the value of an EOL for networks
my $eol = "\015\012";

#----------------------------------------------------------------------------
# new
#
#   Class new() function, all real work gets done by initialize and
#   the things set up here are more for documentation purposes than
#   anything so that you know that they exists
#
#----------------------------------------------------------------------------
sub new
{
    my $type = shift;
    my $self = POPFile::Module->new();

    # A reference to the classifier and history

    $self->{classifier__}     = 0;
    $self->{history__}        = 0;

    # Reference to a child() method called to handle a proxy
    # connection

    $self->{child_}            = 0;

    # Holding variable for MSWin32 pipe handling

    $self->{pipe_cache__} = {};

    # This is where we keep the session with the Classifier::Bayes
    # module

    $self->{api_session__} = '';

    # This is the error message returned if the connection at any
    # time times out while handling a command
    #
    # $self->{connection_timeout_error_} = '';

    # This is the error returned (with the host and port appended)
    # if contacting the remote server fails
    #
    # $self->{connection_failed_error_}  = '';

    # This is a regular expression used by get_response_ to determine
    # if a response from the remote server is good or not (good being
    # that the last command succeeded)
    #
    # $self->{good_response_}            = '';

    $self->{ssl_not_supported_error_}  = '-ERR SSL connection is not supported since required modules are not installed';

    # Connect Banner returned by the real server
    $self->{connect_banner__} = '';

    return bless $self, $type;
}

# ----------------------------------------------------------------------------
#
# initialize
#
# Called to initialize the Proxy, most of this is handled by a subclass of this
# but here we set the 'enabled' flag
#
# ----------------------------------------------------------------------------
sub initialize
{
    my ( $self ) = @_;

    $self->config_( 'enabled', 1 );

    # The following parameters are for SOCKS proxy handling on outbound
    # connections

    $self->config_( 'socks_server', '' );
    $self->config_( 'socks_port',   1080 );

    return 1;
}

# ----------------------------------------------------------------------------
#
# start
#
# Called when all configuration information has been loaded from disk.
#
# The method should return 1 to indicate that it started correctly, if it returns
# 0 then POPFile will abort loading immediately
#
# ----------------------------------------------------------------------------
sub start
{
    my ( $self ) = @_;

    # Open the socket used to receive request for proxy service
    $self->log_( 1, "Opening listening socket on port " . $self->config_('port') . '.' );
    $self->{server__} = IO::Socket::INET->new( Proto     => 'tcp', # PROFILE BLOCK START
                                    ($self->config_( 'local' ) || 0) == 1 ? (LocalAddr => 'localhost') : (),
                                    LocalPort => $self->config_( 'port' ),
                                    Listen    => SOMAXCONN,
                                    Reuse     => 1 ); # PROFILE BLOCK STOP

    my $name = $self->name();

    if ( !defined( $self->{server__} ) ) {
        my $port = $self->config_( 'port' );
        $self->log_( 0, "Couldn't start the $name proxy because POPFile could not bind to the listen port $port" );
        print STDERR <<EOM; # PROFILE BLOCK START

\nCouldn't start the $name proxy because POPFile could not bind to the
listen port $port. This could be because there is another service
using that port or because you do not have the right privileges on
your system (On Unix systems this can happen if you are not root
and the port you specified is less than 1024).

EOM
# PROFILE BLOCK STOP
        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__} );

    # Tell the UI about the SOCKS parameters

    $self->register_configuration_item_( 'configuration',  # PROFILE BLOCK START
                                         $name . '_socks_configuration',
                                         'socks-widget.thtml',
                                         $self );          # PROFILE BLOCK STOP

    return 1;
}

# ----------------------------------------------------------------------------
#
# stop
#
# Called when POPFile is closing down, this is the last method that
# will get called before the object is destroyed.  There is no return
# value from stop().
#
# ----------------------------------------------------------------------------
sub stop
{
    my ( $self ) = @_;

    if ( $self->{api_session__} ne '' ) {
        $self->{classifier__}->release_session_key( $self->{api_session__} );
    }

    # Need to close all the duplicated file handles, this include the
    # POP3 listener and all the reading ends of pipes to active
    # children

    close $self->{server__} if ( defined( $self->{server__} ) );
}

# ----------------------------------------------------------------------------
#
# service
#
# service() is a called periodically to give the module a chance to do
# housekeeping work.
#
# If any problem occurs that requires POPFile to shutdown service()
# should return 0 and the top level process will gracefully terminate
# POPFile including calling all stop() methods.  In normal operation
# return 1.
#
# ----------------------------------------------------------------------------
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.

    if ( ( defined( $self->{selector__}->can_read(0) ) ) && # PROFILE BLOCK START
         ( $self->{alive_} ) ) {                            # PROFILE BLOCK STOP
        if ( my $client = $self->{server__}->accept() ) {

            # Check to see if we have obtained a session key yet

            if ( $self->{api_session__} eq '' ) {
                $self->{api_session__} =                                   # PROFILE BLOCK START
                    $self->{classifier__}->get_session_key( 'admin', '' ); # PROFILE BLOCK STOP
            }

            # 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(                # PROFILE BLOCK START
                                                    $client->peername() );  # PROFILE BLOCK STOP

            if  ( ( ( $self->config_( 'local' ) || 0 ) == 0 ) ||        # PROFILE BLOCK START
                    ( $remote_host eq inet_aton( "127.0.0.1" ) ) ) {    # PROFILE BLOCK STOP

                # If we have force_fork turned on then we will do a
                # fork, otherwise we will handle this inline, in the
                # inline case we need to create the two ends of a pipe
                # that will be used as if there was a child process

                binmode( $client );

                if ( $self->config_( 'force_fork' ) ) {
                    my ( $pid, $pipe ) = &{$self->{forker_}};

                    # If we fail to fork, or are in the child process
                    # then process this request

                    if ( !defined( $pid ) || ( $pid == 0 ) ) {
                        $self->{child_}( $self, $client,        # PROFILE BLOCK START
                            $self->{api_session__} );           # PROFILE BLOCK STOP
                        if ( defined( $pid ) ) {
                            &{$self->{childexit_}}( 0 );
                        }
                    }
                } else {
                    pipe my $reader, my $writer;

                    $self->{child_}( $self, $client, $self->{api_session__} );
                    close $reader;
                }
            }

            close $client;
        }
    }

    return 1;
}

# ----------------------------------------------------------------------------
#
# forked
#
# This is called when some module forks POPFile and is within the
# context of the child process so that this module can close any
# duplicated file handles that are not needed.
#
# There is no return value from this method
#
# ----------------------------------------------------------------------------
sub forked
{
    my ( $self ) = @_;

    close $self->{server__};
}

# ----------------------------------------------------------------------------
#
# 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
    $self->log_( 1, $text );
    print $socket $text; # don't print if $socket undef
}

# ----------------------------------------------------------------------------
#
# echo_to_regexp_
#
# $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
# $regexp   The pattern match to terminate echoing, compile using qr/pattern/
# $log      (OPTIONAL) log output if 1, defaults to 0 if unset
# $suppress (OPTIONAL) suppress any lines that match, compile using qr/pattern/
#
# echo all information from the $mail server until a single line matching $regexp is seen
#
# ----------------------------------------------------------------------------
sub echo_to_regexp_
{
    my ( $self, $mail, $client, $regexp, $log, $suppress ) = @_;

    $log = 0 if (!defined($log));

    while ( my $line = $self->slurp_( $mail ) ) {
        if (!defined($suppress) || !( $line =~ $suppress )) {
            if ( !$log ) {
                print $client $line;
            } else {
                $self->tee_( $client, $line );
            }
        } else {
            $self->log_( 2, "Suppressed: $line" );
        }

        if ( $line =~ $regexp ) {
            last;
        }
    }
}

# ----------------------------------------------------------------------------
#
# 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 ) = @_;

    # 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

    $self->echo_to_regexp_( $mail, $client, qr/^\.(\r\n|\r|\n)$/);
}

# ----------------------------------------------------------------------------
#
# get_response_
#
# $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
# $command  The text of the command to send (we add an EOL)
# $null_resp Allow a null response
# $suppress If set to 1 then the response does not go to the client
#
# Send $command to $mail, receives the response and echoes it to the $client and the debug
# output.  Returns the response and a failure code indicating false if there was a timeout
#
# ----------------------------------------------------------------------------
sub get_response_
{
    my ( $self, $mail, $client, $command, $null_resp, $suppress ) = @_;

    $null_resp = 0 if (!defined $null_resp);
    $suppress  = 0 if (!defined $suppress);

    unless ( defined($mail) && $mail->connected ) {
       # $mail is undefined - return an error intead of crashing
       $self->tee_(  $client, "$self->{connection_timeout_error_}$eol" );
       return ( $self->{connection_timeout_error_}, 0 );
    }

    # Send the command (followed by the appropriate EOL) to the mail server
    $self->tee_( $mail, $command. $eol );

    my $response;

    # Retrieve a single string containing the response

    my $can_read = 0;
    if ( $mail =~ /ssl/i ) {
        $can_read = ( $mail->pending() > 0 );
    }
    if ( !$can_read ) {
        my $selector = new IO::Select( $mail );
        my ( $ready ) = $selector->can_read(                             # PROFILE BLOCK START
            ( !$null_resp ? $self->global_config_( 'timeout' ) : .5 ) ); # PROFILE BLOCK STOP
        $can_read = defined( $ready ) && ( $ready == $mail );
    }

    if ( $can_read ) {
        $response = $self->slurp_( $mail );

        if ( $response ) {

            # Echo the response up to the mail client

            $self->tee_( $client, $response ) if ( !$suppress );
            return ( $response, 1 );
        }
    }

    if ( !$null_resp ) {
        # An error has occurred reading from the mail server

        $self->tee_(  $client, "$self->{connection_timeout_error_}$eol" );
        return ( $self->{connection_timeout_error_}, 0 );
    } else {
        $self->tee_($client, "");
        return ( "", 1 );
    }
}

# ----------------------------------------------------------------------------
#
# echo_response_
#
# $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
# $command  The text of the command to send (we add an EOL)
# $suppress If set to 1 then the response does not go to the client
#
# Send $command to $mail, receives the response and echoes it to the $client and the debug
# output.
#
# Returns one of three values
#
# 0 Successfully sent the command and got a positive response
# 1 Sent the command and got a negative response
# 2 Failed to send the command (e.g. a timeout occurred)
#
# ----------------------------------------------------------------------------
sub echo_response_
{
    my ( $self, $mail, $client, $command, $suppress ) = @_;

    # Determine whether the response began with the string +OK.  If it did then return 1
    # else return 0

    my ( $response, $ok ) = $self->get_response_( $mail, $client, $command, 0, $suppress );

    if ( $ok == 1 ) {
        if ( $response =~ /$self->{good_response_}/ ) {
            return 0;
        } else {
            return 1;
        }
    } else {
        return 2;
    }
}

# ----------------------------------------------------------------------------
#
# verify_connected_
#
# $mail        The handle of the real mail server
# $client      The handle to the mail client
# $hostname    The host name of the remote server
# $port        The port
# $ssl         If set to 1 then the connection to the remote is established 
#              using SSL
#
# Check that we are connected to $hostname on port $port putting the
# open handle in $mail.  Any messages need to be sent to $client
#
# ----------------------------------------------------------------------------
sub verify_connected_
{
    my ( $self, $mail, $client, $hostname, $port, $ssl ) = @_;

    $ssl = 0 if ( !defined( $ssl ) );

    # Check to see if we are already connected
    return $mail if ( $mail && $mail->connected );

    # Connect to the real mail server on the standard port, if we are using
    # SOCKS then go through the proxy server

    if ( $self->config_( 'socks_server' ) ne '' ) {
        require IO::Socket::Socks;
        $self->log_( 0, "Attempting to connect to socks server at " # PROFILE BLOCK START
                    . $self->config_( 'socks_server' ) . ":"
                    . ProxyPort => $self->config_( 'socks_port' ) ); # PROFILE BLOCK STOP

        $mail = IO::Socket::Socks->new( # PROFILE BLOCK START
                    ProxyAddr => $self->config_( 'socks_server' ),
                    ProxyPort => $self->config_( 'socks_port' ),
                    ConnectAddr  => $hostname,
                    ConnectPort  => $port ); # PROFILE BLOCK STOP
    } else {
        if ( $ssl ) {
            eval {
                require IO::Socket::SSL;
            };
            if ( $@ ) {
                # Cannot load IO::Socket::SSL

                $self->tee_( $client, "$self->{ssl_not_supported_error_}$eol" );
                return undef;
            }

            $self->log_( 0, "Attempting to connect to SSL server at " # PROFILE BLOCK START
                        . "$hostname:$port" );                        # PROFILE BLOCK STOP

            $mail = IO::Socket::SSL->new( # PROFILE BLOCK START
                        Proto    => "tcp",
                        PeerAddr => $hostname,
                        PeerPort => $port,
                        Timeout  => $self->global_config_( 'timeout' ),
                        Domain   => AF_INET,
            ); # PROFILE BLOCK STOP

        } else {
            $self->log_( 0, "Attempting to connect to POP server at " # PROFILE BLOCK START
                        . "$hostname:$port" ); # PROFILE BLOCK STOP

            $mail = IO::Socket::INET->new( # PROFILE BLOCK START
                        Proto    => "tcp",
                        PeerAddr => $hostname,
                        PeerPort => $port,
                        Timeout  => $self->global_config_( 'timeout' ),
            ); # PROFILE BLOCK STOP
        }
    }

    # Check that the connect succeeded for the remote server
    if ( $mail ) {
        if ( $mail->connected )  {

            $self->log_( 0, "Connected to $hostname:$port timeout " . $self->global_config_( 'timeout' ) );

            # Set binmode on the socket so that no translation of CRLF
            # occurs

            if ( !$ssl ) {
                binmode( $mail );
            }

            if ( !$ssl || ( $mail->pending() == 0 ) ) {
                # Wait 'timeout' 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->global_config_( '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 );

            if ( !( $buf =~ /[\r\n]/ ) ) {
                my $hit_newline = 0;
                my $temp_buf;

                # If we are on Windows, we will have to wait ourselves as
                # we are not going to call IO::Select::can_read.
                my $wait = ( ($^O eq 'MSWin32') && !($mail =~ /socket/i) ) ? 1 : 0;

                # Read until timeout or a newline (newline _should_ be immediate)

                for my $i ( 0..($self->global_config_( 'timeout' ) * 100) ) {
                    if ( !$hit_newline ) {
                        $temp_buf = $self->flush_extra_( $mail, $client, 1 );
                        $hit_newline = ( $temp_buf =~ /[\r\n]/ );
                        $buf .= $temp_buf;
                        if ( $wait && ! length $temp_buf ) {
                            select undef, undef, undef, 0.01;
                        }
                    }
                    else {
                        last;
                    }
                }
            }

            $self->log_( 1, "Connection returned: $buf" );

            # If we cannot read any response from server, close the connection

            if ( $buf eq '' ) {
                close $mail;
                last;
            }

            $self->{connect_banner__} = $buf;

            # Clean up junk following a newline

            for my $i ( 0..4 ) {
                $self->flush_extra_( $mail, $client, 1 );
            }

            return $mail;
        }
    }

    $self->log_( 0, "IO::Socket::INET or IO::Socket::SSL gets an error: $@" );

    # Tell the client we failed
    $self->tee_(  $client, "$self->{connection_failed_error_} $hostname:$port$eol" );

    return undef;
}

# ----------------------------------------------------------------------------
#
# configure_item
#
#    $name            The name of the item being configured, was passed in by
#                     the call
#                     to register_configuration_item
#    $templ           The loaded template
#
# ----------------------------------------------------------------------------
sub configure_item
{
    my ( $self, $name, $templ ) = @_;

    $templ->param( 'Socks_Widget_Name' => $self->name() );
    $templ->param( 'Socks_Server'      => $self->config_( 'socks_server' ) );
    $templ->param( 'Socks_Port'        => $self->config_( 'socks_port'   ) );
}

# ----------------------------------------------------------------------------
#
# validate_item
#
#    $name            The name of the item being configured, was passed in by the call
#                     to register_configuration_item
#    $templ           The loaded template
#    $language        Reference to the hash holding the current language
#    $form            Hash containing all form items
#
#  Must return the HTML for this item
# ----------------------------------------------------------------------------
sub validate_item
{
    my ( $self, $name, $templ, $language, $form ) = @_;

    my $me = $self->name();

    if ( defined($$form{"$me" . "_socks_port"}) ) {
        if ( ( $$form{"$me" . "_socks_port"} >= 1 ) && ( $$form{"$me" . "_socks_port"} < 65536 ) ) {
            $self->config_( 'socks_port', $$form{"$me" . "_socks_port"} );
            $templ->param( 'Socks_Widget_If_Port_Updated' => 1 );
            $templ->param( 'Socks_Widget_Port_Updated' => sprintf( $$language{Configuration_SOCKSPortUpdate}, $self->config_( 'socks_port' ) ) );
        } else {
            $templ->param( 'Socks_Widget_If_Port_Error' => 1 );
        }
    }

    if ( defined($$form{"$me" . "_socks_server"}) ) {
        $self->config_( 'socks_server', $$form{"$me" . "_socks_server"} );
        $templ->param( 'Socks_Widget_If_Server_Updated' => 1 );
        $templ->param( 'Socks_Widget_Server_Updated' => sprintf( $$language{Configuration_SOCKSServerUpdate}, $self->config_( 'socks_server' ) ) );
    }
}

# SETTERS

sub classifier
{
    my ( $self, $classifier ) = @_;

    $self->{classifier__} = $classifier;
}

sub history
{
    my ( $self, $history ) = @_;

    $self->{history__} = $history;
}

1;
popfile 1.1.3+dfsg-0ubuntu1 / usr / share / popfile / Proxy / Proxy.pm
