[popfile-commit] engine/UI HTML.pm, 1.391, 1.392 HTTP.pm, 1.40, 1.41 XMLRPC.pm, 1.24, 1.25

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

Update of /cvsroot/popfile/engine/UI
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv20326/UI

Modified Files:
	HTML.pm HTTP.pm XMLRPC.pm 
Log Message:
Change Log

1. UI and POP3 proxy are now able to be connected via SSL
2. New Proxy module 'Proxy::POP3S' (POP3 over SSL)
3. New global options: GLOBAL_cert_file, GLOBAL_key_file, GLOBAL_ca_file
4. New html options: html_https_enabled, html_https_port
5. Secure cookies are used when accessed to the HTTPS server

  Proxy/POP3S.pm
  Proxy/POP3.pm
  Proxy/Proxy.pm
  UI/HTML.pm
  UI/HTTP.pm
  POPFile/Configuration.pm
  Classifier/Bayes.pm
  skins/default/pop3s-configuration-panel.thtml
  skins/default/pop3s-security-panel.thtml
  tests/Configuration.tst

    The new Proxy::POP3S module supports connections via SSL.
    It has following options:
        pop3s_enabled           Enable(=1)/Disable(=0;default) the module
        pop3s_force_fork        Enable(=1)/Disable(=0) forking
        pop3s_local             Allow(=1)/Disallow(=0) connections from remote
        pop3s_port              POP3S proxy port(default:995)
        pop3s_socks_port        SOCKS proxy port
        pop3s_socks_server      SOCKS proxy server
        pop3s_welcome_string    POP3S proxy welcome string
    The other POP3 options (e.g. pop3_separator) are same as the Proxy::POP3 module.

    Here's the new options of the UI::HTML module:
        html_https_enabled      Enable(=1)/Disable(=0;default) the HTTPS server
        html_https_port         HTTPS server port(default:8443)

    The new global options:
        GLOBAL_cert_file        Location of the certification file of the server
        GLOBAL_key_file         Location of the key file of the server
        GLOBAL_ca_file          Location of the CA file

    NOTE: I've implemented POP3S and the HTTPS in the different way.
          I've made a new module Proxy::POP3S for POP3S, but I don't make the
          module for HTTPS. This is because I think making the new module for
          HTTPS ( UI:HTTPS ? ) is very hard.

    BUG:  Concurrent POP3S connections cause an error in some environment:
            SSL3 alert write:fatal:bad record mac
            7664:error:1408F119:SSL routines:SSL3_GET_RECORD:decryption failed or bad record mac:s3_pkt.c:424:

6. AUTH PLAIN support

  Proxy/POP3.pm

7. Supress the verbose status messages on the administration tab
8. Add some status messages (administration tab)

  UI/HTML.pm
  UI/XMLRPC.pm
  Proxy/Proxy.pm
  Proxy/POP3.pm
  Proxy/NNTP.pm
  Proxy/SMTP.pm
  languages/English.msg
  languages/Nihongo.msg
  tests/TestPOP3.tst
  tests/TestHTML.script

9. The message files are no longer cached by the web browser

  UI/HTTP.pm

10. if html_allow_javascript == 0, don't disable the radio buttons

  skins/default/administration-page.thtml
  skins/default/pop3-security-panel.thtml
  skins/default/nntp-security-local.thtml
  skins/default/smtp-security-local.thtml
  skins/default/xmlrpc-local.thtml

11. Minor updates of the skins

  skins/smtp-chain-server.thtml
  skins/smtp-chain-server-port.thtml (merged to the above file)
  skins/pop3-chain-panel.thtml

12. Source code cleanup

  UI/HTML.pm
  UI/HTTP.pm
  UI/XMLRPC.pm
  Proxy/POP3.pm
  Proxy/Proxy.pm
  Proxy/NNTP.pm
  Proxy/SMTP.pm
  Classifier/Bayes.pm
  Classifier/MailParse.pm
  POPFile/Configuration.pm
  POPFile/Database.pm
  POPFile/History.pm
  POPFile/Loader.pm
  POPFile/Logger.pm
  POPFile/Module.pm
  POPFile/MQ.pm
  POPFile/Mutex.pm

    Add some 'PROFILE BLOCK START' and 'PROFILE BLOCK STOP's.
    These are used by Devel::TestCoverage to get the correct coverage.

13. Add some tests

  tests/TestBayes.tst

Current state of the test suite:

    TestBayesScript                 PASS
    TestBayes                       PASS
    TestConfiguration               PASS *
    TestHistory                     PASS
    TestHTML                        PASS *
    TestHTTP                        PASS
    TestIMAP                        PASS
    TestInsertScript                PASS *
    TestLogger                      PASS
    TestMailParse                   PASS
    TestModule                      PASS
    TestMQ                          PASS
    TestMutex                       PASS
    TestPipeScript                  PASS
    TestPOP3                        PASS
    TestProxy                       PASS
    TestWordMangle                  PASS
    TestXMLRPC                      PASS

    * :  TODO : needs to add tests for multi user support

Index: HTML.pm
===================================================================
RCS file: /cvsroot/popfile/engine/UI/HTML.pm,v
retrieving revision 1.391
retrieving revision 1.392
diff -C2 -d -r1.391 -r1.392
*** HTML.pm	18 Apr 2008 12:41:49 -0000	1.391
--- HTML.pm	25 Apr 2008 16:26:27 -0000	1.392
***************
*** 71,75 ****
  my $euc_jp = "(?:$ascii|$two_bytes_euc_jp|$three_bytes_euc_jp)";

! my %headers_table = ( 'from',       'From',            # PROFILE BLOCK START
                        'to',         'To',
                        'cc',         'Cc',
--- 71,75 ----
  my $euc_jp = "(?:$ascii|$two_bytes_euc_jp|$three_bytes_euc_jp)";

! my %headers_table = ( 'from',       'From',         # PROFILE BLOCK START
                        'to',         'To',
[...2428 lines suppressed...]
      $self->{skin_root} = $root;
--- 4045,4049 ----
                     'Header_If_SingleUser'    =>
                         $self->global_config_( 'single_user' ),
!                    );                                       # PROFILE BLOCK STOP

      $self->{skin_root} = $root;
***************
*** 4087,4091 ****
              $count++;
              next;
!             }
          unless ( !defined($self->{form_}{$field}) || ( $self->{form_}{$field} eq '' ) ) {
              $formstring .= "$amp" if ($count > 0);
--- 4284,4288 ----
              $count++;
              next;
!         }
          unless ( !defined($self->{form_}{$field}) || ( $self->{form_}{$field} eq '' ) ) {
              $formstring .= "$amp" if ($count > 0);

Index: XMLRPC.pm
===================================================================
RCS file: /cvsroot/popfile/engine/UI/XMLRPC.pm,v
retrieving revision 1.24
retrieving revision 1.25
diff -C2 -d -r1.24 -r1.25
*** XMLRPC.pm	18 Apr 2008 12:41:49 -0000	1.24
--- XMLRPC.pm	25 Apr 2008 16:26:27 -0000	1.25
***************
*** 110,122 ****
      # item that needs a UI component

!     $self->register_configuration_item_( 'configuration',
                                           'xmlrpc_port',
                                           'xmlrpc-port.thtml',
!                                          $self );

!     $self->register_configuration_item_( 'security',
                                           'xmlrpc_local',
                                           'xmlrpc-local.thtml',
!                                          $self );

      # We use a single XMLRPC::Lite object to handle requests for access to the
--- 110,122 ----
      # item that needs a UI component

!     $self->register_configuration_item_( 'configuration', # PROFILE BLOCK START
                                           'xmlrpc_port',
                                           'xmlrpc-port.thtml',
!                                          $self );         # PROFILE BLOCK STOP

!     $self->register_configuration_item_( 'security',      # PROFILE BLOCK START
                                           'xmlrpc_local',
                                           'xmlrpc-local.thtml',
!                                          $self );         # PROFILE BLOCK STOP

      # We use a single XMLRPC::Lite object to handle requests for access to the
***************
*** 285,291 ****
      if ( $name eq 'xmlrpc_port' ) {
          if ( defined($$form{xmlrpc_port}) ) {
!             if ( ( $$form{xmlrpc_port} =~ /^\d+$/ ) && ( $$form{xmlrpc_port} >= 1 ) && ( $$form{xmlrpc_port} < 65536 ) ) {
!                 $self->config_( 'port', $$form{xmlrpc_port} );
!                 $status = sprintf( $$language{Configuration_XMLRPCUpdate}, $self->config_( 'port' ) );
              } else {
                  $error = $$language{Configuration_Error7};
--- 285,297 ----
      if ( $name eq 'xmlrpc_port' ) {
          if ( defined($$form{xmlrpc_port}) ) {
!             if ( ( $$form{xmlrpc_port} =~ /^\d+$/ ) &&     # PROFILE BLOCK START
!                  ( $$form{xmlrpc_port} >= 1 ) &&
!                  ( $$form{xmlrpc_port} < 65536 ) ) {       # PROFILE BLOCK STOP
!                 if ( $self->config_( 'port' ) ne $$form{xmlrpc_port} ) {
!                     $self->config_( 'port', $$form{xmlrpc_port} );
!                     $status = sprintf(                     # PROFILE BLOCK START
!                             $$language{Configuration_XMLRPCUpdate},
!                             $self->config_( 'port' ) );    # PROFILE BLOCK STOP
!                 }
              } else {
                  $error = $$language{Configuration_Error7};
***************
*** 296,305 ****
      if ( $name eq 'xmlrpc_local' ) {
          if ( $$form{serveropt_xmlrpc} ) {
!             $self->config_( 'local', 0 );
!             $status = $$language{Security_ServerModeUpdateXMLRPC};
          }
          else {
!             $self->config_( 'local', 1 );
!             $status = $$language{Security_StealthModeUpdateXMLRPC};
          }

--- 302,315 ----
      if ( $name eq 'xmlrpc_local' ) {
          if ( $$form{serveropt_xmlrpc} ) {
!             if ( $self->config_( 'local' ) ne 0 ) {
!                 $self->config_( 'local', 0 );
!                 $status = $$language{Security_ServerModeUpdateXMLRPC};
!             }
          }
          else {
!             if ( $self->config_( 'local' ) ne 1 ) {
!                 $self->config_( 'local', 1 );
!                 $status = $$language{Security_StealthModeUpdateXMLRPC};
!             }
          }

Index: HTTP.pm
===================================================================
RCS file: /cvsroot/popfile/engine/UI/HTTP.pm,v
retrieving revision 1.40
retrieving revision 1.41
diff -C2 -d -r1.40 -r1.41
*** HTTP.pm	17 Apr 2008 15:13:05 -0000	1.40
--- HTTP.pm	25 Apr 2008 16:26:27 -0000	1.41
***************
*** 73,77 ****
      my ( $self ) = @_;

!     $self->{server_} = IO::Socket::INET->new( Proto     => 'tcp',             # PROFILE BLOCK START
                                      $self->config_( 'local' )  == 1 ? (LocalAddr => 'localhost') : (),
                                       LocalPort => $self->config_( 'port' ),
--- 73,90 ----
      my ( $self ) = @_;

!     if ( $self->config_( 'https_enabled' ) ) {
!         require IO::Socket::SSL;
! 
!         $self->{server_}{https} = IO::Socket::SSL->new( Proto     => 'tcp',   # PROFILE BLOCK START
!                                     $self->config_( 'local' )  == 1 ? (LocalAddr => 'localhost') : (),
!                                      LocalPort => $self->config_( 'https_port' ),
!                                      Listen    => SOMAXCONN,
!                                      SSL_cert_file => $self->get_user_path_( $self->global_config_( 'cert_file' ) ),
!                                      SSL_key_file => $self->get_user_path_( $self->global_config_( 'key_file' ) ),
!                                      SSL_ca_file => $self->get_user_path_( $self->global_config_( 'ca_file' ) ),
!                                      Reuse     => 1 );                        # PROFILE BLOCK STOP
!     }
! 
!     $self->{server_}{http} = IO::Socket::INET->new( Proto     => 'tcp',       # PROFILE BLOCK START
                                      $self->config_( 'local' )  == 1 ? (LocalAddr => 'localhost') : (),
                                       LocalPort => $self->config_( 'port' ),
***************
*** 79,89 ****
                                       Reuse     => 1 );                        # PROFILE BLOCK STOP

!     if ( !defined( $self->{server_} ) ) {
!         my $port = $self->config_( 'port' );
          my $name = $self->name();
          print STDERR <<EOM;                                                   # PROFILE BLOCK START

! \nCouldn't start the $name HTTP interface because POPFile could not bind to the
! HTTP 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
--- 92,112 ----
                                       Reuse     => 1 );                        # PROFILE BLOCK STOP

!     if ( !defined( $self->{server_}{http} ) ||       # PROFILE BLOCK START
!          ( $self->config_( 'https_enabled' ) &&
!            !defined( $self->{server_}{https} ) ) ) { # PROFILE BLOCK STOP
!         my ( $port, $protocol );
! 
!         if ( !defined( $self->{server_}{http} ) ) {
!             $port = $self->config_( 'port' );
!             $protocol = 'HTTP';
!         } else {
!             $port = $self->config_( 'https_port' );
!             $protocol = 'HTTPS';
!         }
          my $name = $self->name();
          print STDERR <<EOM;                                                   # PROFILE BLOCK START

! \nCouldn't start the $name $protocol interface because POPFile could not bind to the
! $protocol 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
***************
*** 96,100 ****
      }

!     $self->{selector_} = new IO::Select( $self->{server_} );

      # Think of an encryption key for encrypting cookies using Blowfish
--- 119,125 ----
      }

!     foreach my $protocol ( keys %{$self->{server_}} ) {
!         $self->{selector_}{$protocol} = new IO::Select( $self->{server_}{$protocol} );
!     }

      # Think of an encryption key for encrypting cookies using Blowfish
***************
*** 103,113 ****
      $self->log_( 1, "Generating random octet using $module" );

!     my $key = $self->random_()->generate_random_string(
                  $module,
                  56,
                  $self->global_config_( 'crypt_strength' ),
                  $self->global_config_( 'crypt_devide' )
!               );
!     $self->{crypto__} = new Crypt::CBC( { 'key'            => $key,
                                            'cipher'         => 'Blowfish',
                                            'padding'        => 'standard',
--- 128,138 ----
      $self->log_( 1, "Generating random octet using $module" );

!     my $key = $self->random_()->generate_random_string( # PROFILE BLOCK START
                  $module,
                  56,
                  $self->global_config_( 'crypt_strength' ),
                  $self->global_config_( 'crypt_devide' )
!               );                                         # PROFILE BLOCK STOP
!     $self->{crypto__} = new Crypt::CBC( { 'key'            => $key, # PROFILE BLOCK START
                                            'cipher'         => 'Blowfish',
                                            'padding'        => 'standard',
***************
*** 115,119 ****
                                            'regenerate_key' => 0,
                                            'salt'           => 1,
!                                           'header'         => 'salt', } );

      return 1;
--- 140,144 ----
                                            'regenerate_key' => 0,
                                            'salt'           => 1,
!                                           'header'         => 'salt', } ); # PROFILE BLOCK STOP

      return 1;
***************
*** 131,135 ****
      my ( $self ) = @_;

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

      $self->SUPER::stop();
--- 156,164 ----
      my ( $self ) = @_;

!     if ( defined( $self->{server__} ) ) {
!         foreach my $protocol ( keys %{$self->{server_}} ) {
!             close $self->{server_}{$protocol};
!         }
!     }

      $self->SUPER::stop();
***************
*** 152,230 ****
      # accept it handle a single request and then exit

!     my ( $ready ) = $self->{selector_}->can_read(0);

!     # Handle HTTP requests for the UI

!     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 allow remote users
!             # to admin POPFile

!             my ( $remote_port, $remote_host ) = sockaddr_in( $client->peername() );

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

!                 # Read the request line (GET or POST) from the client
!                 # and if we manage to do that then read the rest of
!                 # the HTTP headers grabbing the Content-Length and
!                 # using it to read any form POST content into $content

!                 $client->autoflush(1);

!                 if ( ( defined( $client ) ) &&
!                      ( my $request = $self->slurp_( $client ) ) ) {
!                     my $content_length = 0;
!                     my $content;
!                     my $cookie = '';

!                     $self->log_( 2, $request );

!                     while ( my $line = $self->slurp_( $client ) )  {
!                         $cookie = $1 if ( $line =~ /Cookie: (.+)/ );
!                         $content_length = $1 if ( $line =~ /Content-Length: (\d+)/i );
!                         # Discovered that Norton Internet Security was
!                         # adding HTTP headers of the form
!                         #
!                         # ~~~~~~~~~~~~~~: ~~~~~~~~~~~~~
!                         #
!                         # which we were not recognizing as valid
!                         # (surprise, surprise) and this was messing
!                         # about our handling of POST data.  Changed
!                         # the end of header identification to any line
!                         # that does not contain a :

!                         last                 if ( $line !~ /:/ );
!                     }

!                     if ( $content_length > 0 ) {
!                         $content = $self->slurp_buffer_( $client,
!                             $content_length );
!                         $self->log_( 2, $content );
!                     }

!                     # Handle decryption of a cookie header

!                     $cookie = $self->decrypt_cookie__( $cookie );

!                     if ( $request =~ /^(GET|POST) (.*) HTTP\/1\./i ) {
!                         $code = $self->handle_url( $client, $2, $1,
!                                     $content, $cookie );
!                         $self->log_( 2,
!                             "HTTP handle_url returned code $code\n" );
!                     } else {
!                         $self->http_error_( $client, 500 );
                      }
                  }
-             }

!             $self->log_( 2, "Close HTTP connection on $client\n" );
!             $self->done_slurp_( $client );
!             close $client;
          }
      }

--- 181,263 ----
      # accept it handle a single request and then exit

!     foreach my $protocol ( keys %{$self->{server_}} ) {

!         my ( $ready ) = $self->{selector_}{$protocol}->can_read(0);

!         # Handle HTTP requests for the UI

!         if ( ( defined( $ready ) ) && ( $ready == $self->{server_}{$protocol} ) ) {

!             if ( my $client = $self->{server_}{$protocol}->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 allow remote users
!                 # to admin POPFile

!                 my ( $remote_port, $remote_host ) = sockaddr_in( $client->peername() );

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

!                     # Read the request line (GET or POST) from the client
!                     # and if we manage to do that then read the rest of
!                     # the HTTP headers grabbing the Content-Length and
!                     # using it to read any form POST content into $content

!                     $client->autoflush(1);

!                     if ( ( defined( $client ) ) &&                      # PROFILE BLOCK START
!                          ( my $request = $self->slurp_( $client ) ) ) { # PROFILE BLOCK STOP
!                         my $content_length = 0;
!                         my $content;
!                         my $cookie = '';

!                         $self->log_( 2, $request );

!                         while ( my $line = $self->slurp_( $client ) )  {
!                             $cookie = $1 if ( $line =~ /Cookie: (.+)/ );
!                             $content_length = $1 if ( $line =~ /Content-Length: (\d+)/i );
!                             # Discovered that Norton Internet Security was
!                             # adding HTTP headers of the form
!                             #
!                             # ~~~~~~~~~~~~~~: ~~~~~~~~~~~~~
!                             #
!                             # which we were not recognizing as valid
!                             # (surprise, surprise) and this was messing
!                             # about our handling of POST data.  Changed
!                             # the end of header identification to any line
!                             # that does not contain a :

!                             last                 if ( $line !~ /:/ );
!                         }

!                         if ( $content_length > 0 ) {
!                             $content = $self->slurp_buffer_( $client, # PROFILE BLOCK START
!                                 $content_length );                    # PROFILE BLOCK STOP
!                             $self->log_( 2, $content );
!                         }

!                         # Handle decryption of a cookie header

!                         $cookie = $self->decrypt_cookie__( $cookie );
! 
!                         if ( $request =~ /^(GET|POST) (.*) HTTP\/1\./i ) {
!                             $code = $self->handle_url( $client, $2, $1, # PROFILE BLOCK START
!                                         $content, $cookie );            # PROFILE BLOCK STOP
!                             $self->log_( 2,                                # PROFILE BLOCK START
!                                 "HTTP handle_url returned code $code\n" ); # PROFILE BLOCK STOP
!                         } else {
!                             $self->http_error_( $client, 500 );
!                         }
                      }
                  }

!                 $self->log_( 2, "Close HTTP connection on $client\n" );
!                 $self->done_slurp_( $client );
!                 close $client;
!             }
          }
+ 
      }

***************
*** 245,249 ****
      $self->SUPER::forked( $writer );

!     close $self->{server_};
  }

--- 278,284 ----
      $self->SUPER::forked( $writer );

!     foreach my $protocol ( keys %{$self->{server_}} ) {
!         close $self->{server_}{$protocol};
!     }
  }

***************
*** 263,268 ****
      my ( $self, $client, $url, $command, $content, $cookie ) = @_;

!     return $self->{url_handler_}( $self, $client, $url, $command,
!                                   $content, $cookie );
  }

--- 298,303 ----
      my ( $self, $client, $url, $command, $content, $cookie ) = @_;

!     return $self->{url_handler_}( $self, $client, $url, $command, # PROFILE BLOCK START
!                                   $content, $cookie ); # PROFILE BLOCK STOP
  }

***************
*** 427,431 ****
      $self->log_( 0, "HTTP error $error returned" );

!     my $text="<html><head><title>POPFile Web Server Error $error</title></head>
  <body>
  <h1>POPFile Web Server Error $error</h1>
--- 462,467 ----
      $self->log_( 0, "HTTP error $error returned" );

!     my $text =      # PROFILE BLOCK START
!             "<html><head><title>POPFile Web Server Error $error</title></head>
  <body>
  <h1>POPFile Web Server Error $error</h1>
***************
*** 434,438 ****
  Click <a href=\"/\">here</a> to continue.
  </body>
! </html>$eol";

      $self->log_( 1, $text );
--- 470,474 ----
  Click <a href=\"/\">here</a> to continue.
  </body>
! </html>$eol";       # PROFILE BLOCK STOP

      $self->log_( 1, $text );
***************
*** 482,487 ****
          my $header = "HTTP/1.0 200 OK$eol";
          $header .= "Content-Type: $type$eol";
!         if ( $file =~ /\.log$/ ) {
!             # The log files should not been cached

              $header .= "Pragma: no-cache$eol";
--- 518,523 ----
          my $header = "HTTP/1.0 200 OK$eol";
          $header .= "Content-Type: $type$eol";
!         if ( $file =~ /\.log$/ || $file =~ /\.msg$/ ) {
!             # The log/message files should not been cached

              $header .= "Pragma: no-cache$eol";
***************
*** 516,521 ****

      my @day   = ( 'Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat' );
!     my @month = ( 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug',
!                   'Sep', 'Oct', 'Nov', 'Dec' );
      my $zulu = time;
      $zulu += 60 * 60 * $hours;
--- 552,557 ----

      my @day   = ( 'Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat' );
!     my @month = ( 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', # PROFILE BLOCK START
!                   'Sep', 'Oct', 'Nov', 'Dec' );                           # PROFILE BLOCK STOP
      my $zulu = time;
      $zulu += 60 * 60 * $hours;