From: <jgr...@us...> - 2003-02-18 14:47:09
|
Update of /cvsroot/popfile/engine/Proxy In directory sc8-pr-cvs1:/tmp/cvs-serv19251/Proxy Modified Files: POP3.pm Log Message: Fix bug 684967 by ensuring that all socket communication is done in binmode and that file writes use \n so that we are strict in using CRLF on the network and flexible in using CR or LF as appropriate file local files depending on the platform POPFile is running on. If we use \n for files that are not binmode then Perl takes care of the appropriate translation; on the other hand we do not want Perl taking care of translation on the network and you use $eol and binmode together Index: POP3.pm =================================================================== RCS file: /cvsroot/popfile/engine/Proxy/POP3.pm,v retrieving revision 1.35 retrieving revision 1.36 diff -C2 -d -r1.35 -r1.36 *** POP3.pm 17 Feb 2003 22:43:37 -0000 1.35 --- POP3.pm 18 Feb 2003 14:46:33 -0000 1.36 *************** *** 123,129 **** --- 123,131 ---- # Ensure that the messages subdirectory exists + mkdir( 'messages' ); # Open the socket used to receive request for POP3 service + $self->{server} = IO::Socket::INET->new( Proto => 'tcp', $self->{configuration}->{configuration}{localpop} == 1 ? (LocalAddr => 'localhost') : (), *************** *** 134,137 **** --- 136,140 ---- # 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} ); *************** *** 152,155 **** --- 155,159 ---- # 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} ) ); *************** *** 182,222 **** # because we deal with the statistics as we go # ! # $kid PID of a child of POP3.pm # # --------------------------------------------------------------------------------------------- sub flush_child_data { ! my ( $self, $kid ) = @_; ! ! my $stats_changed = 0; ! my $handle = $self->{children}{$kid}; ! while ( &{$self->{pipeready}}($handle) ) ! { ! my $class = <$handle>; ! ! if ( defined( $class ) ) { ! $class =~ s/[\r\n]//g; ! $self->{classifier}->{parameters}{$class}{count} += 1; ! $self->{configuration}->{configuration}{mcount} += 1; ! $stats_changed = 1; ! debug( $self, "Incrementing $class for $kid" ); ! } else { ! ! # This is here so that we get in errorneous position where the pipready ! # function is returning that there's data, but there is none, in fact the ! # pipe is dead then we break the cycle here. This was happening to me when ! # I tested POPFile running under cygwin. ! ! last; ! } ! } ! ! if ( $stats_changed ) { ! $self->{configuration}->save_configuration(); ! $self->{classifier}->write_parameters(); ! } } --- 186,226 ---- # because we deal with the statistics as we go # ! # $kid PID of a child of POP3.pm # # --------------------------------------------------------------------------------------------- sub flush_child_data { ! my ( $self, $kid ) = @_; ! ! my $stats_changed = 0; ! my $handle = $self->{children}{$kid}; ! while ( &{$self->{pipeready}}($handle) ) ! { ! my $class = <$handle>; ! ! if ( defined( $class ) ) { ! $class =~ s/[\r\n]//g; ! $self->{classifier}->{parameters}{$class}{count} += 1; ! $self->{configuration}->{configuration}{mcount} += 1; ! $stats_changed = 1; ! debug( $self, "Incrementing $class for $kid" ); ! } else { ! ! # This is here so that we get in errorneous position where the pipready ! # function is returning that there's data, but there is none, in fact the ! # pipe is dead then we break the cycle here. This was happening to me when ! # I tested POPFile running under cygwin. ! ! last; ! } ! } ! ! if ( $stats_changed ) { ! $self->{configuration}->save_configuration(); ! $self->{classifier}->write_parameters(); ! } } *************** *** 242,249 **** for my $kid (@kids) { if ( waitpid( $kid, &WNOHANG ) == $kid ) { ! $self->flush_child_data( $kid ); close $self->{children}{$kid}; delete $self->{children}{$kid}; ! debug( $self, "Done with $kid" ); } --- 246,253 ---- for my $kid (@kids) { if ( waitpid( $kid, &WNOHANG ) == $kid ) { ! $self->flush_child_data( $kid ); close $self->{children}{$kid}; delete $self->{children}{$kid}; ! debug( $self, "Done with $kid" ); } *************** *** 263,272 **** my ( $self ) = @_; ! # See if any of the children have passed up statistics data through their ! # pipes and deal with it now ! ! for my $kid (keys %{$self->{children}}) { ! $self->flush_child_data( $kid ); ! } # Accept a connection from a client trying to use us as the mail server. We service one client at a time --- 267,276 ---- my ( $self ) = @_; ! # See if any of the children have passed up statistics data through their ! # pipes and deal with it now ! ! for my $kid (keys %{$self->{children}}) { ! $self->flush_child_data( $kid ); ! } # Accept a connection from a client trying to use us as the mail server. We service one client at a time *************** *** 277,290 **** --- 281,301 ---- if ( ( defined( $self->{selector}->can_read(0) ) ) && ( $self->{alive} ) ) { 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 + # and set the socket to binmode so that no CRLF translation goes on + $self->{configuration}->{configuration}{download_count} += 1; my ($pid,$pipe) = &{$self->{forker}}; + binmode( $client ); # If we are in the parent process then push the pipe handle onto the children list + if ( ( defined( $pid ) ) && ( $pid != 0 ) ) { $self->{children}{$pid} = $pipe; *************** *** 292,295 **** --- 303,307 ---- # 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}, $pipe ); *************** *** 491,502 **** if ( $command =~ /CAPA/i ) { if ( $self->{configuration}->{configuration}{server} ne '' ) { ! if ( $mail = verify_connected( $self, $mail, $client, $self->{configuration}->{configuration}{server}, $self->{configuration}->{configuration}{sport} ) ) { ! echo_to_dot( $self, $mail, $client ) if ( echo_response( $self, $mail, $client, "CAPA" ) ); ! } else { ! last; ! } ! } else { tee( $self, $client, "-ERR No secure server specified$eol" ); ! } flush_extra( $self, $mail, $client, 0 ); --- 503,514 ---- if ( $command =~ /CAPA/i ) { if ( $self->{configuration}->{configuration}{server} ne '' ) { ! if ( $mail = verify_connected( $self, $mail, $client, $self->{configuration}->{configuration}{server}, $self->{configuration}->{configuration}{sport} ) ) { ! echo_to_dot( $self, $mail, $client ) if ( echo_response( $self, $mail, $client, "CAPA" ) ); ! } else { ! last; ! } ! } else { tee( $self, $client, "-ERR No secure server specified$eol" ); ! } flush_extra( $self, $mail, $client, 0 ); *************** *** 735,744 **** --- 747,764 ---- if ( $mail ) { if ( $mail->connected ) { + + # Set binmode on the socket so that no translation of CRLF + # occurs + + 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 ); return undef unless () = $selector->can_read($self->{configuration}->{configuration}{timeout}); # Read the response from the real server and say OK + my $buf = ''; my $max_length = 8192; |