home *** CD-ROM | disk | FTP | other *** search
/ PC Open 107 / PC Open 107 CD 1.bin / CD1 / INTERNET / EMAIL / pop file / setup.exe / Proxy / Proxy.pm < prev    next >
Encoding:
Perl POD Document  |  2004-11-29  |  21.0 KB  |  642 lines

  1. package Proxy::Proxy;
  2.  
  3. # ----------------------------------------------------------------------------
  4. #
  5. # This module implements the base class for all POPFile proxy Modules
  6. #
  7. # Copyright (c) 2001-2004 John Graham-Cumming
  8. #
  9. #   This file is part of POPFile
  10. #
  11. #   POPFile is free software; you can redistribute it and/or modify
  12. #   it under the terms of the GNU General Public License as published by
  13. #   the Free Software Foundation; either version 2 of the License, or
  14. #   (at your option) any later version.
  15. #
  16. #   POPFile is distributed in the hope that it will be useful,
  17. #   but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19. #   GNU General Public License for more details.
  20. #
  21. #   You should have received a copy of the GNU General Public License
  22. #   along with POPFile; if not, write to the Free Software
  23. #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  24. #
  25. #   Modified by     Sam Schinke (sschinke@users.sourceforge.net)
  26. #
  27. # ----------------------------------------------------------------------------
  28.  
  29. use POPFile::Module;
  30. @ISA = ( "POPFile::Module" );
  31.  
  32. use IO::Handle;
  33. use IO::Socket;
  34. use IO::Select;
  35.  
  36. # A handy variable containing the value of an EOL for networks
  37. my $eol = "\015\012";
  38.  
  39. #----------------------------------------------------------------------------
  40. # new
  41. #
  42. #   Class new() function, all real work gets done by initialize and
  43. #   the things set up here are more for documentation purposes than
  44. #   anything so that you know that they exists
  45. #
  46. #----------------------------------------------------------------------------
  47. sub new
  48. {
  49.     my $type = shift;
  50.     my $self = POPFile::Module->new();
  51.  
  52.     # A reference to the classifier and history
  53.  
  54.     $self->{classifier__}     = 0;
  55.     $self->{history__}        = 0;
  56.  
  57.     # Reference to a child() method called to handle a proxy
  58.     # connection
  59.  
  60.     $self->{child_}            = 0;
  61.  
  62.     # Holding variable for MSWin32 pipe handling
  63.  
  64.     $self->{pipe_cache__} = {};
  65.  
  66.     # This is where we keep the session with the Classifier::Bayes
  67.     # module
  68.  
  69.     $self->{api_session__} = '';
  70.  
  71.     # This is the error message returned if the connection at any
  72.     # time times out while handling a command
  73.     #
  74.     # $self->{connection_timeout_error_} = '';
  75.  
  76.     # This is the error returned (with the host and port appended)
  77.     # if contacting the remote server fails
  78.     #
  79.     # $self->{connection_failed_error_}  = '';
  80.  
  81.     # This is a regular expression used by get_response_ to determine
  82.     # if a response from the remote server is good or not (good being
  83.     # that the last command succeeded)
  84.     #
  85.     # $self->{good_response_}            = '';
  86.  
  87.     # Connect Banner returned by the real server
  88.     $self->{connect_banner__} = '';
  89.  
  90.     return bless $self, $type;
  91. }
  92.  
  93. # ----------------------------------------------------------------------------
  94. #
  95. # initialize
  96. #
  97. # Called to initialize the Proxy, most of this is handled by a subclass of this
  98. # but here we set the 'enabled' flag
  99. #
  100. # ----------------------------------------------------------------------------
  101. sub initialize
  102. {
  103.     my ( $self ) = @_;
  104.  
  105.     $self->config_( 'enabled', 1 );
  106.  
  107.     # The following parameters are for SOCKS proxy handling on outbound
  108.     # connections
  109.  
  110.     $self->config_( 'socks_server', '' );
  111.     $self->config_( 'socks_port',   1080 );
  112.  
  113.     return 1;
  114. }
  115.  
  116. # ----------------------------------------------------------------------------
  117. #
  118. # start
  119. #
  120. # Called when all configuration information has been loaded from disk.
  121. #
  122. # The method should return 1 to indicate that it started correctly, if it returns
  123. # 0 then POPFile will abort loading immediately
  124. #
  125. # ----------------------------------------------------------------------------
  126. sub start
  127. {
  128.     my ( $self ) = @_;
  129.  
  130.     # Open the socket used to receive request for proxy service
  131.  
  132.     $self->{server__} = IO::Socket::INET->new( Proto     => 'tcp', # PROFILE BLOCK START
  133.                                     ($self->config_( 'local' ) || 0) == 1 ? (LocalAddr => 'localhost') : (),
  134.                                     LocalPort => $self->config_( 'port' ),
  135.                                     Listen    => SOMAXCONN,
  136.                                     Reuse     => 1 ); # PROFILE BLOCK STOP
  137.  
  138.     my $name = $self->name();
  139.  
  140.     if ( !defined( $self->{server__} ) ) {
  141.         my $port = $self->config_( 'port' );
  142.         print STDERR <<EOM; # PROFILE BLOCK START
  143.  
  144. \nCouldn't start the $name proxy because POPFile could not bind to the
  145. listen port $port. This could be because there is another service
  146. using that port or because you do not have the right privileges on
  147. your system (On Unix systems this can happen if you are not root
  148. and the port you specified is less than 1024).
  149.  
  150. EOM
  151. # PROFILE BLOCK STOP
  152.         return 0;
  153.     }
  154.  
  155.     # This is used to perform select calls on the $server socket so that we can decide when there is
  156.     # a call waiting an accept it without having to block
  157.  
  158.     $self->{selector__} = new IO::Select( $self->{server__} );
  159.  
  160.     # Tell the UI about the SOCKS parameters
  161.  
  162.     $self->register_configuration_item_( 'configuration',  # PROFILE BLOCK START
  163.                                          $name . '_socks_configuration',
  164.                                          'socks-widget.thtml',
  165.                                          $self );          # PROFILE BLOCK STOP
  166.  
  167.     return 1;
  168. }
  169.  
  170. # ----------------------------------------------------------------------------
  171. #
  172. # stop
  173. #
  174. # Called when POPFile is closing down, this is the last method that will get called before
  175. # the object is destroyed.  There is no return value from stop().
  176. #
  177. # ----------------------------------------------------------------------------
  178. sub stop
  179. {
  180.     my ( $self ) = @_;
  181.  
  182.     if ( $self->{api_session__} ne '' ) {
  183.         $self->{classifier__}->release_session_key( $self->{api_session__} );
  184.     }
  185.  
  186.     # Need to close all the duplicated file handles, this include the POP3 listener
  187.     # and all the reading ends of pipes to active children
  188.  
  189.     close $self->{server__} if ( defined( $self->{server__} ) );
  190. }
  191.  
  192. # ----------------------------------------------------------------------------
  193. #
  194. # service
  195. #
  196. # service() is a called periodically to give the module a chance to do housekeeping work.
  197. #
  198. # If any problem occurs that requires POPFile to shutdown service() should return 0 and
  199. # the top level process will gracefully terminate POPFile including calling all stop()
  200. # methods.  In normal operation return 1.
  201. #
  202. # ----------------------------------------------------------------------------
  203. sub service
  204. {
  205.     my ( $self ) = @_;
  206.  
  207.     # Accept a connection from a client trying to use us as the mail
  208.     # server.  We service one client at a time and all others get
  209.     # queued up to be dealt with later.  We check the alive boolean
  210.     # here to make sure we are still allowed to operate. See if
  211.     # there's a connection waiting on the $server by getting the list
  212.     # of handles with data to read, if the handle is the server then
  213.     # we're off.
  214.  
  215.     if ( ( defined( $self->{selector__}->can_read(0) ) ) &&
  216.          ( $self->{alive_} ) ) {
  217.         if ( my $client = $self->{server__}->accept() ) {
  218.  
  219.             # Check to see if we have obtained a session key yet
  220.  
  221.             if ( $self->{api_session__} eq '' ) {
  222.                 $self->{api_session__} =
  223.                     $self->{classifier__}->get_session_key( 'admin', '' );
  224.         }
  225.  
  226.             # Check that this is a connection from the local machine,
  227.             # if it's not then we drop it immediately without any
  228.             # further processing.  We don't want to act as a proxy for
  229.             # just anyone's email
  230.  
  231.             my ( $remote_port, $remote_host ) = sockaddr_in(
  232.                                                     $client->peername() );
  233.  
  234.             if  ( ( ( $self->config_( 'local' ) || 0 ) == 0 ) ||
  235.                     ( $remote_host eq inet_aton( "127.0.0.1" ) ) ) {
  236.  
  237.                 # If we have force_fork turned on then we will do a
  238.                 # fork, otherwise we will handle this inline, in the
  239.                 # inline case we need to create the two ends of a pipe
  240.                 # that will be used as if there was a child process
  241.  
  242.                 binmode( $client );
  243.  
  244.                 if ( $self->config_( 'force_fork' ) ) {
  245.                     my ( $pid, $pipe ) = &{$self->{forker_}};
  246.  
  247.                     # If we fail to fork, or are in the child process
  248.                     # then process this request
  249.  
  250.                     if ( !defined( $pid ) || ( $pid == 0 ) ) {
  251.                         $self->{child_}( $self, $client,
  252.                             $self->{api_session__} );
  253.                         exit(0) if ( defined( $pid ) );
  254.                     }
  255.             } else {
  256.                     pipe my $reader, my $writer;
  257.  
  258.                     $self->{child_}( $self, $client, $self->{api_session__} );
  259.                     close $reader;
  260.                 }
  261.             }
  262.  
  263.             close $client;
  264.         }
  265.     }
  266.  
  267.     return 1;
  268. }
  269.  
  270. # ----------------------------------------------------------------------------
  271. #
  272. # forked
  273. #
  274. # This is called when some module forks POPFile and is within the context of the child
  275. # process so that this module can close any duplicated file handles that are not needed.
  276. #
  277. # There is no return value from this method
  278. #
  279. # ----------------------------------------------------------------------------
  280. sub forked
  281. {
  282.     my ( $self ) = @_;
  283.  
  284.     close $self->{server__};
  285. }
  286.  
  287. # ----------------------------------------------------------------------------
  288. #
  289. # tee_
  290. #
  291. # $socket   The stream (created with IO::) to send the string to
  292. # $text     The text to output
  293. #
  294. # Sends $text to $socket and sends $text to debug output
  295. #
  296. # ----------------------------------------------------------------------------
  297. sub tee_
  298. {
  299.     my ( $self, $socket, $text ) = @_;
  300.  
  301.     # Send the message to the debug output and then send it to the appropriate socket
  302.     $self->log_( 1, $text );
  303.     print $socket $text; # don't print if $socket undef
  304. }
  305.  
  306. # ----------------------------------------------------------------------------
  307. #
  308. # echo_to_regexp_
  309. #
  310. # $mail     The stream (created with IO::) to send the message to (the remote mail server)
  311. # $client   The local mail client (created with IO::) that needs the response
  312. # $regexp   The pattern match to terminate echoing, compile using qr/pattern/
  313. # $log      (OPTIONAL) log output if 1, defaults to 0 if unset
  314. # $suppress (OPTIONAL) suppress any lines that match, compile using qr/pattern/
  315. #
  316. # echo all information from the $mail server until a single line matching $regexp is seen
  317. #
  318. # ----------------------------------------------------------------------------
  319. sub echo_to_regexp_
  320. {
  321.     my ( $self, $mail, $client, $regexp, $log, $suppress ) = @_;
  322.  
  323.     $log = 0 if (!defined($log));
  324.  
  325.     while ( my $line = $self->slurp_( $mail ) ) {
  326.         if (!defined($suppress) || !( $line =~ $suppress )) {
  327.             if ( !$log ) {
  328.                 print $client $line;
  329.             } else {
  330.                 $self->tee_( $client, $line );
  331.             }
  332.         } else {
  333.             $self->log_( 2, "Suppressed: $line" );
  334.         }
  335.  
  336.     if ( $line =~ $regexp ) {
  337.             last;
  338.     }
  339.     }
  340. }
  341.  
  342. # ----------------------------------------------------------------------------
  343. #
  344. # echo_to_dot_
  345. #
  346. # $mail     The stream (created with IO::) to send the message to (the remote mail server)
  347. # $client   The local mail client (created with IO::) that needs the response
  348. #
  349. # echo all information from the $mail server until a single line with a . is seen
  350. #
  351. # ----------------------------------------------------------------------------
  352. sub echo_to_dot_
  353. {
  354.     my ( $self, $mail, $client ) = @_;
  355.  
  356.     # The termination has to be a single line with exactly a dot on it and nothing
  357.     # else other than line termination characters.  This is vital so that we do
  358.     # not mistake a line beginning with . as the end of the block
  359.  
  360.     $self->echo_to_regexp_( $mail, $client, qr/^\.(\r\n|\r|\n)$/);
  361. }
  362.  
  363. # ----------------------------------------------------------------------------
  364. #
  365. # get_response_
  366. #
  367. # $mail     The stream (created with IO::) to send the message to (the remote mail server)
  368. # $client   The local mail client (created with IO::) that needs the response
  369. # $command  The text of the command to send (we add an EOL)
  370. # $null_resp Allow a null response
  371. # $suppress If set to 1 then the response does not go to the client
  372. #
  373. # Send $command to $mail, receives the response and echoes it to the $client and the debug
  374. # output.  Returns the response and a failure code indicating false if there was a timeout
  375. #
  376. # ----------------------------------------------------------------------------
  377. sub get_response_
  378. {
  379.     my ( $self, $mail, $client, $command, $null_resp, $suppress ) = @_;
  380.  
  381.     $null_resp = 0 if (!defined $null_resp);
  382.     $suppress  = 0 if (!defined $suppress);
  383.  
  384.     unless ( defined($mail) && $mail->connected ) {
  385.        # $mail is undefined - return an error intead of crashing
  386.        $self->tee_(  $client, "$self->{connection_timeout_error_}$eol" );
  387.        return ( $self->{connection_timeout_error_}, 0 );
  388.     }
  389.  
  390.     # Send the command (followed by the appropriate EOL) to the mail server
  391.     $self->tee_( $mail, $command. $eol );
  392.  
  393.     my $response;
  394.  
  395.     # Retrieve a single string containing the response
  396.  
  397.     my $selector = new IO::Select( $mail );
  398.     my ($ready) = $selector->can_read( (!$null_resp?$self->global_config_( 'timeout' ):.5) );
  399.  
  400.     if ( ( defined( $ready ) ) && ( $ready == $mail ) ) {
  401.         $response = $self->slurp_( $mail );
  402.  
  403.         if ( $response ) {
  404.  
  405.             # Echo the response up to the mail client
  406.  
  407.             $self->tee_( $client, $response ) if ( !$suppress );
  408.             return ( $response, 1 );
  409.         }
  410.     }
  411.  
  412.     if ( !$null_resp ) {
  413.         # An error has occurred reading from the mail server
  414.  
  415.         $self->tee_(  $client, "$self->{connection_timeout_error_}$eol" );
  416.         return ( $self->{connection_timeout_error_}, 0 );
  417.     } else {
  418.         $self->tee_($client, "");
  419.         return ( "", 1 );
  420.     }
  421. }
  422.  
  423. # ----------------------------------------------------------------------------
  424. #
  425. # echo_response_
  426. #
  427. # $mail     The stream (created with IO::) to send the message to (the remote mail server)
  428. # $client   The local mail client (created with IO::) that needs the response
  429. # $command  The text of the command to send (we add an EOL)
  430. # $suppress If set to 1 then the response does not go to the client
  431. #
  432. # Send $command to $mail, receives the response and echoes it to the $client and the debug
  433. # output.
  434. #
  435. # Returns one of three values
  436. #
  437. # 0 Successfully sent the command and got a positive response
  438. # 1 Sent the command and got a negative response
  439. # 2 Failed to send the command (e.g. a timeout occurred)
  440. #
  441. # ----------------------------------------------------------------------------
  442. sub echo_response_
  443. {
  444.     my ( $self, $mail, $client, $command, $suppress ) = @_;
  445.  
  446.     # Determine whether the response began with the string +OK.  If it did then return 1
  447.     # else return 0
  448.  
  449.     my ( $response, $ok ) = $self->get_response_( $mail, $client, $command, 0, $suppress );
  450.  
  451.     if ( $ok == 1 ) {
  452.         if ( $response =~ /$self->{good_response_}/ ) {
  453.             return 0;
  454.     } else {
  455.             return 1;
  456.         }
  457.     } else {
  458.         return 2;
  459.     }
  460. }
  461.  
  462. # ----------------------------------------------------------------------------
  463. #
  464. # verify_connected_
  465. #
  466. # $mail        The handle of the real mail server
  467. # $client      The handle to the mail client
  468. # $hostname    The host name of the remote server
  469. # $port        The port
  470. # $ssl         If set to 1 then the connection to the remote is established using SSL
  471. #
  472. # Check that we are connected to $hostname on port $port putting the open handle in $mail.
  473. # Any messages need to be sent to $client
  474. #
  475. # ----------------------------------------------------------------------------
  476. sub verify_connected_
  477. {
  478.     my ( $self, $mail, $client, $hostname, $port, $ssl ) = @_;
  479.  
  480.     $ssl = 0 if ( !defined( $ssl ) );
  481.  
  482.     # Check to see if we are already connected
  483.     return $mail if ( $mail && $mail->connected );
  484.  
  485.     # Connect to the real mail server on the standard port, if we are using
  486.     # SOCKS then go through the proxy server
  487.  
  488.     if ( $self->config_( 'socks_server' ) ne '' ) {
  489.         require IO::Socket::Socks;
  490.         $mail = IO::Socket::Socks->new( # PROFILE BLOCK START
  491.                     ProxyAddr => $self->config_( 'socks_server' ),
  492.                     ProxyPort => $self->config_( 'socks_port' ),
  493.                     ConnectAddr  => $hostname,
  494.                     ConnectPort  => $port ); # PROFILE BLOCK STOP
  495.     } else {
  496.         if ( $ssl ) {
  497.             require IO::Socket::SSL;
  498.             $mail = IO::Socket::SSL->new( # PROFILE BLOCK START
  499.                         Proto    => "tcp",
  500.                         PeerAddr => $hostname,
  501.                         PeerPort => $port ); # PROFILE BLOCK STOP
  502.     } else {
  503.             $mail = IO::Socket::INET->new( # PROFILE BLOCK START
  504.                         Proto    => "tcp",
  505.                         PeerAddr => $hostname,
  506.                         PeerPort => $port ); # PROFILE BLOCK STOP
  507.         }
  508.     }
  509.  
  510.     # Check that the connect succeeded for the remote server
  511.     if ( $mail ) {
  512.         if ( $mail->connected )  {
  513.  
  514.             $self->log_( 0, "Connected to $hostname:$port timeout " . $self->global_config_( 'timeout' ) );
  515.  
  516.             # Set binmode on the socket so that no translation of CRLF
  517.             # occurs
  518.  
  519.             if ( !$ssl ) {
  520.                 binmode( $mail );
  521.         }
  522.  
  523.             # Wait 10 seconds for a response from the remote server and if
  524.             # there isn't one then give up trying to connect
  525.  
  526.             my $selector = new IO::Select( $mail );
  527.             last unless () = $selector->can_read($self->global_config_( 'timeout' ));
  528.  
  529.             # Read the response from the real server and say OK
  530.  
  531.             my $buf        = '';
  532.             my $max_length = 8192;
  533.             my $n          = sysread( $mail, $buf, $max_length, length $buf );
  534.  
  535.             if ( !( $buf =~ /[\r\n]/ ) ) {
  536.                 my $hit_newline = 0;
  537.                 my $temp_buf;
  538.  
  539.                 # Read until timeout or a newline (newline _should_ be immediate)
  540.  
  541.                 for my $i ( 0..($self->global_config_( 'timeout' ) * 100) ) {
  542.                     if ( !$hit_newline ) {
  543.                         $temp_buf = $self->flush_extra_( $mail, $client, 1 );
  544.                         $hit_newline = ( $temp_buf =~ /[\r\n]/ );
  545.                         $buf .= $temp_buf;
  546.                     } else {
  547.                         last;
  548.                     }
  549.                 }
  550.             }
  551.  
  552.             $self->log_( 1, "Connection returned: $buf" );
  553.  
  554.             $self->{connect_banner__} = $buf;
  555.  
  556.             # Clean up junk following a newline
  557.  
  558.             for my $i ( 0..4 ) {
  559.                 $self->flush_extra_( $mail, $client, 1 );
  560.             }
  561.  
  562.             return $mail;
  563.         }
  564.     }
  565.  
  566.     # Tell the client we failed
  567.     $self->tee_(  $client, "$self->{connection_failed_error_} $hostname:$port$eol" );
  568.  
  569.     return undef;
  570. }
  571.  
  572. # ----------------------------------------------------------------------------
  573. #
  574. # configure_item
  575. #
  576. #    $name            The name of the item being configured, was passed in by the call
  577. #                     to register_configuration_item
  578. #    $templ           The loaded template
  579. #
  580. # ----------------------------------------------------------------------------
  581. sub configure_item
  582. {
  583.     my ( $self, $name, $templ ) = @_;
  584.  
  585.     $templ->param( 'Socks_Widget_Name' => $self->name() );
  586.     $templ->param( 'Socks_Server'      => $self->config_( 'socks_server' ) );
  587.     $templ->param( 'Socks_Port'        => $self->config_( 'socks_port'   ) );
  588. }
  589.  
  590. # ----------------------------------------------------------------------------
  591. #
  592. # validate_item
  593. #
  594. #    $name            The name of the item being configured, was passed in by the call
  595. #                     to register_configuration_item
  596. #    $templ           The loaded template
  597. #    $language        Reference to the hash holding the current language
  598. #    $form            Hash containing all form items
  599. #
  600. #  Must return the HTML for this item
  601. # ----------------------------------------------------------------------------
  602. sub validate_item
  603. {
  604.     my ( $self, $name, $templ, $language, $form ) = @_;
  605.  
  606.     my $me = $self->name();
  607.  
  608.     if ( defined($$form{"$me" . "_socks_port"}) ) {
  609.         if ( ( $$form{"$me" . "_socks_port"} >= 1 ) && ( $$form{"$me" . "_socks_port"} < 65536 ) ) {
  610.             $self->config_( 'socks_port', $$form{"$me" . "_socks_port"} );
  611.             $templ->param( 'Socks_Widget_If_Port_Updated' => 1 );
  612.             $templ->param( 'Socks_Widget_Port_Updated' => sprintf( $$language{Configuration_SOCKSPortUpdate}, $self->config_( 'socks_port' ) ) );
  613.         } else {
  614.             $templ->param( 'Socks_Widget_If_Port_Error' => 1 );
  615.         }
  616.     }
  617.  
  618.     if ( defined($$form{"$me" . "_socks_server"}) ) {
  619.         $self->config_( 'socks_server', $$form{"$me" . "_socks_server"} );
  620.         $templ->param( 'Socks_Widget_If_Server_Updated' => 1 );
  621.         $templ->param( 'Socks_Widget_Server_Updated' => sprintf( $$language{Configuration_SOCKSServerUpdate}, $self->config_( 'socks_server' ) ) );
  622.     }
  623. }
  624.  
  625. # SETTERS
  626.  
  627. sub classifier
  628. {
  629.     my ( $self, $classifier ) = @_;
  630.  
  631.     $self->{classifier__} = $classifier;
  632. }
  633.  
  634. sub history
  635. {
  636.     my ( $self, $history ) = @_;
  637.  
  638.     $self->{history__} = $history;
  639. }
  640.  
  641. 1;
  642.