[popfile-commit] engine/UI HTML.pm,1.387,1.388 HTTP.pm,1.38,1.39

[naoki i. <am...@us...>]

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

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

1. New options in cloning user

  UI/HTML.pm
  Classifier/Bayes.pm
  skins/default/users-page.thtml
  languages/English.msg
  languages/Nihongo.msg

  Following two options are added:

    1. Copy user's magnets
    2. Copy user's corpus

  If these options are choosed, the magnets or corpus data of the
  cloned user will be copied to the new user.

2. The language cache is now updated correctly

  UI/HTML.pm

3. Admin's language setting is copied to the global language setting
  in the single user mode

  UI/HTML.pm

4. A new module 'POPFile::Random'
   A new option 'GLOBAL_random_module'
   A new function 'random_()'

  POPFile/Random.pm
  POPFile/Configuration.pm
  POPFile/Module.pm
  Classifier/Bayes.pm
  UI/HTML.pm
  UI/HTTP.pm
  tests/TestConfiguration.tst

  The new module 'POPFile::Random' is used for generating random strings.

  The new option 'GLOBAL_random_module' is used for specifying which
  module to be used in the POPFile::Random module.

  The new function 'random_()' is used for accessing the POPFile::Random
  module.

5. jump_to_message now works even if the UI is protected with a password

  UI/HTML.pm

6. The log files cannot be accessed from non admin users

  UI/HTML.pm

7. The log files won't be cached by the web browsers

  UI/HTTP.pm

8. The password input box is automatically selected in the single user mode

  skins/default/password-page.thtml

9. Fixed some typos

  skins/default/pop3-chain-panel.thtml
  languages/English.msg
  languages/Nihongo.msg



Current state of the test suite:

    TestBayesScript                 PASS
    TestBayes                       PASS
    TestConfiguration               PASS *
    TestHistory                     PASS *
    TestHTML                        PASS *
    TestHTTP                        PASS
    TestIMAP                        fail
    TestInsertScript                PASS *
    TestLogger                      PASS
    TestMailParse                   PASS
    TestModule                      PASS
    TestMQ                          PASS
    TestMutex                       PASS
    TestPipeScript                  PASS
    TestPOP3                        PASS
    TestProxy                       PASS
    TestWordMangle                  PASS
    TestXMLRPC                      PASS (but child process does not terminate)

    * :  needs to add tests for multi user support

TODO

1. multi user mode tests are needed

  tests/TestConfiguration.tst
  tests/TestHistory.tst
  tests/TestHTML.tst
  tests/TestInsertScript.tst

Index: HTML.pm
===================================================================
RCS file: /cvsroot/popfile/engine/UI/HTML.pm,v
retrieving revision 1.387
retrieving revision 1.388
diff -C2 -d -r1.387 -r1.388
*** HTML.pm	9 Apr 2008 17:20:47 -0000	1.387
--- HTML.pm	13 Apr 2008 03:08:09 -0000	1.388
***************
*** 43,47 ****
  use MIME::Base64;
  use Crypt::CBC;
- use Crypt::Random qw( makerandom_octet );
  use Digest::MD5 qw( md5_hex );
  
--- 43,46 ----
***************
*** 217,224 ****
      # translated will still appear
  
!     $self->load_language( 'English' );
!     if ( $self->global_config_( 'language' ) ne 'English' ) {
!         $self->load_language( $self->global_config_( 'language' ) );
!     }
  
      return $self->SUPER::start();
--- 216,220 ----
      # translated will still appear
  
!     $self->cache_global_language( $self->global_config_( 'language' ) );
  
      return $self->SUPER::start();
***************
*** 365,374 ****
          # translated will still appear
  
!         if ( $self->user_config_( $user, 'language' ) ne $self->global_config_( 'language' ) ) {
!             $self->load_language( 'English', $session );
!             if ( $self->user_config_( $user, 'language' ) ne 'English' ) {
!                 $self->load_language( $self->user_config_( $user, 'language' ), $session );
!             }
!         }
  
          return $session;
--- 361,366 ----
          # translated will still appear
  
!         $self->cache_language_for_user( $self->user_config_( $user, 'language' ),
!                                         $session );
  
          return $session;
***************
*** 405,416 ****
          # The IP address of the client that set the cookie
          # MD5 checksum of the data (hex encoded)
!         $self->log_( 1, "Generating random octet" );
!         $cookie_string =  encode_base64(
!                             makerandom_octet(
!                                 Length   => 16,
!                                 Strength => $self->global_config_( 'crypt_strength' ),
!                                 Device   => $self->global_config_( 'crypt_device' )
!                              ),
!                         '' );
          $cookie_string .= ' ';
          $cookie_string .= time;
--- 397,412 ----
          # The IP address of the client that set the cookie
          # MD5 checksum of the data (hex encoded)
! 
!         my $module = $self->global_config_( 'random_module' );
!         $self->log_( 1, "Generating random octet using $module" );
! 
!         $cookie_string = encode_base64(
!                             $self->random_()->generate_random_string(
!                                 $module,
!                                 16,
!                                 $self->global_config_( 'crypt_strength' ),
!                                 $self->global_config_( 'crypt_device' )
!                             ),
!                          '' );
          $cookie_string .= ' ';
          $cookie_string .= time;
***************
*** 496,499 ****
--- 492,499 ----
      $url =~ s/#.*//;
  
+     # Save the original URL
+ 
+     my $original_url = $url;
+ 
      # If the URL was passed in through a GET then it may contain form
      # arguments separated by & signs, which we parse out into the
***************
*** 522,526 ****
      # prevent caching
  
!     if ( $url =~ /skins\/(([^\/]+)\/(([^\/]+\/)+)?)?([^\/]+)$/ ) {
          my $user = 1;
          my $path = ( $1 || '');
--- 522,526 ----
      # prevent caching
  
!     if ( $url =~ /^\/skins\/(([^\/]+)\/(([^\/]+\/)+)?)?([^\/]+)$/ ) {
          my $user = 1;
          my $path = ( $1 || '');
***************
*** 593,612 ****
      }
  
!     if ( $url =~ /\/autogen_(.+)\.bmp/ ) {
          $self->bmp_file__( $client, $1 );
          return 1;
      }
  
!     if ( $url =~ /\/(.+\.gif)/ ) {
          $self->http_file_( $client, $self->get_root_path_( $1 ), 'image/gif' );
          return 1;
      }
  
!     if ( $url =~ /\/(.+\.png)/ ) {
          $self->http_file_( $client, $self->get_root_path_( $1 ), 'image/png' );
          return 1;
      }
  
!     if ( $url =~ /\/(.+\.ico)/ ) {
          $self->http_file_( $client, $self->get_root_path_( $1 ),
               'image/x-icon' );
--- 593,612 ----
      }
  
!     if ( $url =~ /^\/autogen_(.+)\.bmp/ ) {
          $self->bmp_file__( $client, $1 );
          return 1;
      }
  
!     if ( $url =~ /^\/(.+\.gif)/ ) {
          $self->http_file_( $client, $self->get_root_path_( $1 ), 'image/gif' );
          return 1;
      }
  
!     if ( $url =~ /^\/(.+\.png)/ ) {
          $self->http_file_( $client, $self->get_root_path_( $1 ), 'image/png' );
          return 1;
      }
  
!     if ( $url =~ /^\/(.+\.ico)/ ) {
          $self->http_file_( $client, $self->get_root_path_( $1 ),
               'image/x-icon' );
***************
*** 614,622 ****
      }
  
!     if ( $url =~ /(manual\/.+\.html)/ ) {
          $self->http_file_( $client, $self->get_root_path_( $1 ), 'text/html' );
          return 1;
      }
  
      if ( $url eq '/jump_to_message' )  {
          $self->{form_}{filter}    = '';
--- 614,642 ----
      }
  
!     if ( $url =~ /^\/(manual\/.+\.html)/ ) {
          $self->http_file_( $client, $self->get_root_path_( $1 ), 'text/html' );
          return 1;
      }
  
+     # If we don't have a valid session key, then insist that the user
+     # log in, or check the username and password for validity, if they
+     # are valid then create the session now.  In single user mode get
+     # the key
+ 
+     if ( !defined( $session ) ) {
+         my $continue;
+ 
+         ( $session, $continue ) = $self->password_page( $client, $original_url );
+         if ( !defined( $continue ) ||
+              $continue eq '/password' ) {
+             $continue = '/';
+         }
+         if ( defined( $session ) ) {
+             $self->http_redirect_( $client, $continue , $session );
+         }
+ 
+         return 1;
+     }
+ 
      if ( $url eq '/jump_to_message' )  {
          $self->{form_}{filter}    = '';
***************
*** 638,661 ****
      }
  
!     # If we don't have a valid session key, then insist that the user
!     # log in, or check the username and password for validity, if they
!     # are valid then create the session now.  In single user mode get
!     # the key
! 
!     if ( !defined( $session ) ) {
!         my $continue;
!         ( $session, $continue ) = $self->password_page( $client, $url );
!         if ( !defined( $continue ) ||
!              $continue eq '/password' ) {
!             $continue = '/';
!         }
!         if ( defined( $session ) ) {
!             $self->http_redirect_( $client, $continue , $session );
!         }
! 
!         return 1;
!     }
! 
!     if ( $url =~ /(popfile.*\.log)/ ) {
          $self->http_file_( $client, $self->logger_()->debug_filename(),
              'text/plain' );
--- 658,663 ----
      }
  
!     if ( ( $url =~ /^\/popfile.*\.log$/ ) &&
!          ( $self->classifier_()->is_admin_session( $session ) ) )  {
          $self->http_file_( $client, $self->logger_()->debug_filename(),
              'text/plain' );
***************
*** 669,674 ****
  
      if ( ( $url eq '/shutdown' ) &&
!          ( $self->user_global_config_( $self->{sessions__}{$session}{user},
!                'can_admin' ) ) )  {
          my $http_header = "HTTP/1.1 200 OK\r\n";
          $http_header .= "Connection: close\r\n";
--- 671,675 ----
  
      if ( ( $url eq '/shutdown' ) &&
!          ( $self->classifier_()->is_admin_session( $session ) ) )  {
          my $http_header = "HTTP/1.1 200 OK\r\n";
          $http_header .= "Connection: close\r\n";
***************
*** 741,745 ****
      # not then remove the administration and advanced URLs
  
!     if ( !$self->user_global_config_( $self->{sessions__}{$session}{user}, 'can_admin' ) ) {
          delete $url_table{'/administration'};
          delete $url_table{'/advanced'};
--- 742,746 ----
      # not then remove the administration and advanced URLs
  
!     if ( !$self->classifier_()->is_admin_session( $session ) ) {
          delete $url_table{'/administration'};
          delete $url_table{'/advanced'};
***************
*** 1063,1084 ****
      my ( $self, $client, $templ, $template, $page, $session ) = @_;
  
      if ( defined($self->{form_}{skin}) ) {
!         $self->user_config_( $self->{sessions__}{$session}{user}, 'skin', $self->{form_}{skin} );
          $templ = $self->load_template__( $template, $page, $session );
      }
  
      if ( defined($self->{form_}{language}) ) {
!         if ( $self->user_config_( $self->{sessions__}{$session}{user}, 'language' ) ne
                   $self->{form_}{language} ) {
!             $self->user_config_( $self->{sessions__}{$session}{user}, 'language', $self->{form_}{language} );
!             if ( $self->user_config_( $self->{sessions__}{$session}{user}, 'language' ) ne $self->global_config_( 'language' ) ) {
!                 if ( $self->user_config_( $self->{sessions__}{$session}{user}, 'language' ) ne 'English' ) {
!                     $self->load_language( 'English', $session );
!                 }
!                 $self->load_language( $self->user_config_( $self->{sessions__}{$session}{user}, 'language' ), $session );
!             } else {
!                 delete $self->{language__}{$session};
              }
  
              # Force a template relocalization because the language has been
              # changed which changes the localization of the template
--- 1064,1095 ----
      my ( $self, $client, $templ, $template, $page, $session ) = @_;
  
+     my $userid = $self->classifier_()->valid_session_key__( $session );
+ 
      if ( defined($self->{form_}{skin}) ) {
!         $self->user_config_( $userid, 'skin', $self->{form_}{skin} );
          $templ = $self->load_template__( $template, $page, $session );
      }
  
      if ( defined($self->{form_}{language}) ) {
!         if ( $self->user_config_( $userid, 'language' ) ne
                   $self->{form_}{language} ) {
!             my $language = $self->{form_}{language};
! 
!             $self->user_config_( $userid, 'language', $language );
! 
!             # If the language setting of the administrator is changed in the
!             # multiuser mode, update the global language setting
! 
!             if ( $self->global_config_( 'single_user' ) &&
!                  ( $userid eq 1 ) ) {
!                 $self->global_config_( 'language', $language );
! 
!                 $self->cache_language_for_user( $language, 'global' );
              }
  
+             # Reload language cache
+ 
+             $self->cache_language_for_user( $language, $session );
+ 
              # Force a template relocalization because the language has been
              # changed which changes the localization of the template
***************
*** 1096,1100 ****
          $name =~ /\/([^\/]+)\/$/;
          $name = $1;
!         my $selected = ( $name eq $self->user_config_( $self->{sessions__}{$session}{user}, 'skin' ) )?'selected':'';
  
          if ( $name =~ /tiny/ ) {
--- 1107,1111 ----
          $name =~ /\/([^\/]+)\/$/;
          $name = $1;
!         my $selected = ( $name eq $self->user_config_( $userid, 'skin' ) )?'selected':'';
  
          if ( $name =~ /tiny/ ) {
***************
*** 1121,1125 ****
          my %row_data;
          $row_data{Configuration_Language} = $lang;
!         $row_data{Configuration_Selected_Language} = ( $lang eq $self->user_config_( $self->{sessions__}{$session}{user}, 'language' ) )?'selected':'';
          push ( @language_loop, \%row_data );
      }
--- 1132,1136 ----
          my %row_data;
          $row_data{Configuration_Language} = $lang;
!         $row_data{Configuration_Selected_Language} = ( $lang eq $self->user_config_( $userid, 'language' ) )?'selected':'';
          push ( @language_loop, \%row_data );
      }
***************
*** 1132,1141 ****
  
      if ( defined($self->{form_}{hide_configbar}) ) {
!         $self->user_config_( $self->{sessions__}{$session}{user}, 'show_configbars', 0 );
          $templ->param( 'If_Show_Config_Bars' => 0 );
      }
  
      if ( defined ($self->{form_}{show_configbar}) ) {
!         $self->user_config_( $self->{sessions__}{$session}{user}, 'show_configbars', 1 );
          $templ->param( 'If_Show_Config_Bars' => 1 );
      }
--- 1143,1152 ----
  
      if ( defined($self->{form_}{hide_configbar}) ) {
!         $self->user_config_( $userid, 'show_configbars', 0 );
          $templ->param( 'If_Show_Config_Bars' => 0 );
      }
  
      if ( defined ($self->{form_}{show_configbar}) ) {
!         $self->user_config_( $userid, 'show_configbars', 1 );
          $templ->param( 'If_Show_Config_Bars' => 1 );
      }
***************
*** 1504,1508 ****
      if ( exists( $self->{form_}{create} ) &&
           ( $self->{form_}{newuser} ne '' ) ) {
!         my ( $result, $password ) = $self->classifier_()->create_user( $session, $self->{form_}{newuser}, $self->{form_}{clone} );
          if ( $result == 0 ) {
              if ( $self->{form_}{clone} ne '' ) {
--- 1515,1524 ----
      if ( exists( $self->{form_}{create} ) &&
           ( $self->{form_}{newuser} ne '' ) ) {
!         my ( $result, $password ) = $self->classifier_()->create_user(
!                 $session,
!                 $self->{form_}{newuser},
!                 $self->{form_}{clone},
!                 $self->{form_}{users_copy_magnets},
!                 $self->{form_}{users_copy_corpus} );
          if ( $result == 0 ) {
              if ( $self->{form_}{clone} ne '' ) {
***************
*** 3617,3623 ****
--- 3633,3641 ----
  
      my $user = 1;
+     my $can_admin = 0;
  
      if ( defined( $session ) ) {
          $user = $self->{sessions__}{$session}{user};
+         $can_admin = $self->classifier_()->is_admin_session( $session );
      }
  
***************
*** 3658,3663 ****
                     'If_Show_Config_Bars'     =>
                         $self->user_config_( $user, 'show_configbars' ),
!                    'Common_Middle_If_CanAdmin' =>
!                        $self->user_global_config_( $user, 'can_admin' ),
                     'If_Javascript_OK'        => $self->config_( 'allow_javascript' ),
                     'If_Language_RTL'         =>
--- 3676,3680 ----
                     'If_Show_Config_Bars'     =>
                         $self->user_config_( $user, 'show_configbars' ),
!                    'Common_Middle_If_CanAdmin' => $can_admin,
                     'If_Javascript_OK'        => $self->config_( 'allow_javascript' ),
                     'If_Language_RTL'         =>
***************
*** 3754,3777 ****
  #----------------------------------------------------------------------------
  #
! # load_language
  #
! # Fill the language hash with the language strings that are from the
! # named language file
  #
! # $lang    - The language to load (no .msg extension)
  #
  #----------------------------------------------------------------------------
! sub load_language
  {
      my ( $self, $lang, $session ) = @_;
  
!     my $user = 1;
  
!     if ( defined( $session ) ) {
!         $user = $self->{sessions__}{$session}{user};
      } else {
!         $session = 'global';
      }
  
      if ( open LANG, '<' . $self->get_root_path_( "languages/$lang.msg" ) ) {
          while ( <LANG> ) {
--- 3771,3859 ----
  #----------------------------------------------------------------------------
  #
! # cache_global_language
  #
! # Cache the language file
  #
! # $lang    - The language to cache
  #
  #----------------------------------------------------------------------------
! sub cache_global_language
! {
!     my ( $self, $lang ) = @_;
! 
!     $self->load_language( 'English', 'global', 0 );
!     if ( $lang ne 'English' ) {
!         $self->load_language( $lang, 'global', 0 );
!     }
!     $self->{language__}{global}{lang} = $lang;
! }
! 
! #----------------------------------------------------------------------------
! #
! # cache_language_for_user
! #
! # Cache the language file for the user
! #
! # $lang    - The language to cache
! # $session - A valid session key
! #
! #----------------------------------------------------------------------------
! sub cache_language_for_user
  {
      my ( $self, $lang, $session ) = @_;
  
!     my $test_language = 0;
!     my $need_to_load = 0;
  
!     my $user = $self->classifier_()->valid_session_key__( $session );
!     return if ( !defined($user) );
! 
!     $test_language = $self->user_config_( $user, 'test_language' );
! 
!     if ( $test_language ) {
!         $need_to_load = 1;
      } else {
!         if ( $self->{language__}{global}{lang} ne $self->user_config_( $user, 'language' ) ) {
!             if ( !defined($self->{language__}{$session}) ) {
!                 $need_to_load = 1;
!             } else {
!                 if ( $self->{language__}{$session}{lang} ne $self->user_config_( $user, 'language' ) ) {
!                     $need_to_load = 1;
!                 }
!             }
!         } else {
!             if ( defined($self->{language__}{$session}) ) {
!                 delete $self->{language__}{$session};
!             }
!         }
      }
  
+     if ( $need_to_load ) {
+         $self->load_language( 'English', $session, $test_language );
+         if ( $lang ne 'English' ) {
+             $self->load_language( $lang, $session, $test_language );
+         }
+         $self->{language__}{$session}{lang} = $lang;
+     }
+ }
+ 
+ #----------------------------------------------------------------------------
+ #
+ # load_language
+ #
+ # Fill the language hash with the language strings that are from the
+ # named language file
+ #
+ # 
+ #
+ # $lang          - The language to load (no .msg extension)
+ # $session       - A valid session key
+ # $test_language - If 1, language file test mode
+ #
+ #----------------------------------------------------------------------------
+ sub load_language
+ {
+     my ( $self, $lang, $session, $test_language ) = @_;
+ 
      if ( open LANG, '<' . $self->get_root_path_( "languages/$lang.msg" ) ) {
          while ( <LANG> ) {
***************
*** 3783,3787 ****
                      $value = $1;
                  }
!                 my $msg = ($self->user_config_( $user, 'test_language' )) ? $id : $value;
                  $msg =~ s/[\r\n]//g;
  
--- 3865,3869 ----
                      $value = $1;
                  }
!                 my $msg = $test_language ? $id : $value;
                  $msg =~ s/[\r\n]//g;
  

Index: HTTP.pm
===================================================================
RCS file: /cvsroot/popfile/engine/UI/HTTP.pm,v
retrieving revision 1.38
retrieving revision 1.39
diff -C2 -d -r1.38 -r1.39
*** HTTP.pm	5 Apr 2008 16:50:46 -0000	1.38
--- HTTP.pm	13 Apr 2008 03:08:09 -0000	1.39
***************
*** 37,41 ****
  
  use Crypt::CBC;
- use Crypt::Random qw/makerandom_octet/;
  use MIME::Base64;
  
--- 37,40 ----
***************
*** 100,108 ****
  
      # Think of an encryption key for encrypting cookies using Blowfish
!     $self->log_( 1, "Generating random octet" );
!     my $key = makerandom_octet(
!                 Length => 56,
!                 Strength => $self->global_config_( 'crypt_strength' ),
!                 Device   => $self->global_config_( 'crypt_device' )
                );
      $self->{crypto__} = new Crypt::CBC( { 'key'            => $key,
--- 99,111 ----
  
      # Think of an encryption key for encrypting cookies using Blowfish
! 
!     my $module = $self->global_config_( 'random_module' );
!     $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,
***************
*** 455,459 ****
  
          my $expires = $self->zulu_offset_( 0, 1 );
!         my $header = "HTTP/1.0 200 OK$eol" . "Content-Type: $type$eol" . "Expires: $expires$eol" . "Content-Length: ";
          $header .= length($contents);
          $header .= "$eol$eol";
--- 458,473 ----
  
          my $expires = $self->zulu_offset_( 0, 1 );
!         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";
!             $header .= "Cache-Control: no-cache$eol";
!             $header .= "Expires: 0$eol";
!         } else {
!             $header .= "Expires: $expires$eol";
!         }
!         $header .= "Content-Length: ";
          $header .= length($contents);
          $header .= "$eol$eol";