package Proxy::Proxy;
# ----------------------------------------------------------------------------
#
# This module implements the base class for all POPFile proxy Modules
#
# Copyright (c) 2001-2006 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_} = '';
# 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->{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' );
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) ) ) &&
( $self->{alive_} ) ) {
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__} =
$self->{classifier__}->get_session_key( 'admin', '' );
}
# 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->config_( 'local' ) || 0 ) == 0 ) ||
( $remote_host eq inet_aton( "127.0.0.1" ) ) ) {
# 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,
$self->{api_session__} );
exit(0) if ( defined( $pid ) );
}
} 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 $selector = new IO::Select( $mail );
my ($ready) = $selector->can_read( (!$null_resp?$self->global_config_( 'timeout' ):.5) );
if ( ( defined( $ready ) ) && ( $ready == $mail ) ) {
$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;
$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
$self->log_( 0, "Attempting to connect to socks server at "
. $self->config_( 'socks_server' ) . ":"
. ProxyPort => $self->config_( 'socks_port' ) );
} else {
if ( $ssl ) {
require IO::Socket::SSL;
$mail = IO::Socket::SSL->new( # PROFILE BLOCK START
Proto => "tcp",
PeerAddr => $hostname,
PeerPort => $port ); # PROFILE BLOCK STOP
$self->log_( 0, "Attempting to connect to SSL server at "
. "$hostname:$port" );
} else {
$mail = IO::Socket::INET->new( # PROFILE BLOCK START
Proto => "tcp",
PeerAddr => $hostname,
PeerPort => $port ); # PROFILE BLOCK STOP
$self->log_( 0, "Attempting to connect to POP server at "
. "$hostname:$port" );
}
}
# 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 );
}
# 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->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;
# 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;
} else {
last;
}
}
}
$self->log_( 1, "Connection returned: $buf" );
$self->{connect_banner__} = $buf;
# Clean up junk following a newline
for my $i ( 0..4 ) {
$self->flush_extra_( $mail, $client, 1 );
}
return $mail;
}
}
# 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;
syntax highlighted by Code2HTML, v. 0.9.1