[popfile-commit] engine/Classifier Bayes.pm,1.345,1.346

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

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

Modified Files:
	Bayes.pm 
Log Message:
More v0.23.0 work; mostly around the test suite and the ability to
change passwords.

*** NOTE: Had to run 'dos2unix' because a number of files had CRLF line
    endings.  POPFile standard is Unix-style LF only line endings on
    files.

*** tests/TestBayes.tst and Classifier/Bayes.pm:

Add tests for APIs that had no tests (and fix the bugs that the tests
showed up!).  All APIs now have tests; the new tests cover:

    add_account
    create_user
    get_accounts
    get_bucket_id
    get_bucket_name
    get_user_id
    get_user_list
    get_user_parameter
    get_user_parameter_from_id
    get_user_parameter_list
    remove_account
    remove_user
    set_user_parameter_from_id

*** Classifier/Bayes.pm, tests/TestBayes.tst, UI/HTML.pm

create_user now also creates a random password for the user and the
password is displayed when the user is created in the UI.

*** Classifier/Bayes.pm, tests/TestBayes.tst, UI/HTML.pm,
    skins/default/configuration-bar.thtml

Added the ability to change password for a user.  This is done in the
configuration bar and added new APIs and tests (validate_password and
set_password) for a user.

*** POPFile/API.pm:

Add external access to the following new APIs:

    add_account
    create_user
    get_user_id
    get_user_id_from_session
    get_user_parameter
    get_user_parameter_from_id
    get_user_parameter_list
    remove_account
    remove_user
    set_user_parameter_from_id

*** tests/TestHTTP.tst:

Remove redirection tests since this is no longer handled by the HTTP
module.

*** Current state of the test suite:

    TestBayesScript         fail
    TestBayes                       PASS    
    TestConfiguration       fail
    TestHistory             fail
    TestHTML                fail (horribly)
    TestHTTP                        PASS
    TestIMAP                        PASS
    TestInsertScript        fail
    TestLogger                      PASS
    TestMailParse           fail
    TestModule                      PASS
    TestMQ                          PASS
    TestMutex                       PASS    
    TestPipeScript                  PASS
    TestPOP3                fail
    TestProxy                       PASS
    TestWordMangle                  PASS
    TestXMLRPC              fail

*** TODO

tests/TestModule.tst needs updating for the user_*_config_ APIs that
have been added.

Look into why we get bogus complaints about the primary key not being
unique when we do a database upgrade.  I think some of these are
caused by the fact that popfile.sql contains some INSERT statements
and we are getting double inserts.  Perhaps the upgrade should be
using UPDATE instead.

Index: Bayes.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Classifier/Bayes.pm,v
retrieving revision 1.345
retrieving revision 1.346
diff -C2 -d -r1.345 -r1.346
*** Bayes.pm	14 Aug 2005 03:57:26 -0000	1.345
--- Bayes.pm	21 Aug 2005 22:17:46 -0000	1.346
***************
*** 1476,1480 ****
      # get a random session key in hex

!     my $random = Crypt::Random::makerandom_octet( Length => 128, Strength => 1 );
      my $now = time;
      return sha256_hex( "$$" . "$random$now" );
--- 1476,1481 ----
      # get a random session key in hex

!     my $random = Crypt::Random::makerandom_octet( Length => 128,
!                                                   Strength => 1 );
      my $now = time;
      return sha256_hex( "$$" . "$random$now" );
***************
*** 1618,1622 ****
  #----------------------------------------------------------------------------
  #
! # release_sessions_key
  #
  # $session        A session key previously returned by get_session_key
--- 1619,1623 ----
  #----------------------------------------------------------------------------
  #
! # release_session_key
  #
  # $session        A session key previously returned by get_session_key
***************
*** 1668,1672 ****
  #
  #----------------------------------------------------------------------------
- 
  sub get_session_key_from_token
  {
--- 1669,1672 ----
***************
*** 1698,1707 ****
      # figure out which user is being talked about

!     my $result = $self->{db_get_user_from_account__}->execute( "$module:$token" );
      if ( !defined( $result ) ) {
          $self->log_( 1, "Unknown account $module:$token" );
          return undef;
      }
!     my $user = $self->{db_get_user_from_account__}->fetchrow_arrayref->[0];

      my $user_session = $self->generate_unique_session_key__();
--- 1698,1715 ----
      # figure out which user is being talked about

!     my $result = $self->{db_get_user_from_account__}->execute(
!                                                           "$module:$token" );
      if ( !defined( $result ) ) {
          $self->log_( 1, "Unknown account $module:$token" );
          return undef;
      }
! 
!     my $rows = $self->{db_get_user_from_account__}->fetchrow_arrayref;
!     my $user = defined( $rows )?$rows->[0]:undef;
! 
!     if ( !defined( $user ) ) {
!         $self->log_( 1, "Unknown account $module:$token" );
!         return undef;
!     }

      my $user_session = $self->generate_unique_session_key__();
***************
*** 2626,2635 ****
              # to predict if there is flushable data)

!             $self->flush_extra_( $mail, \*FLUSH, 0);
              close FLUSH;

              # append any data we got to the actual temp file

!             if ( ( (-s "$msg_file.flush") > 0 ) && ( open FLUSH, "<$msg_file.flush" ) ) {
                  binmode FLUSH;
                  if ( open TEMP, ">>$msg_file" ) {
--- 2634,2644 ----
              # to predict if there is flushable data)

!             $self->flush_extra_( $mail, \*FLUSH, 0 );
              close FLUSH;

              # append any data we got to the actual temp file

!             if ( ( (-s "$msg_file.flush") > 0 ) &&
!                    ( open FLUSH, "<$msg_file.flush" ) ) {
                  binmode FLUSH;
                  if ( open TEMP, ">>$msg_file" ) {
***************
*** 2768,2772 ****
  # $account   The account to add
  #
! #----------------------------------------------------------------------------
  sub add_account
  {
--- 2777,2783 ----
  # $account   The account to add
  #
! # Returns 1 if the account was added successfully, or 0 for an error,
! # -1 if another user already has that account associated with it
! # ----------------------------------------------------------------------------
  sub add_account
  {
***************
*** 2811,2814 ****
--- 2822,2827 ----
  # $account   The account to remove
  #
+ # Returns 1 if the account was successfully removed, 0 if not
+ #
  #----------------------------------------------------------------------------
  sub remove_account
***************
*** 2824,2828 ****
      }

!     return $self->db_()->do( "delete from accounts where account = '$module:$account';" );
  }

--- 2837,2843 ----
      }

!     my $result = $self->db_()->do( "delete from accounts where account = '$module:$account';" );
! 
!     return defined( $result );
  }

***************
*** 3277,3281 ****
  #
  # Returns 0 for success, 1 for user already exists, 2 for other error,
! # 3 for clone failure and undef if caller isn't an admin.
  #
  # ----------------------------------------------------------------------------
--- 3292,3297 ----
  #
  # Returns 0 for success, 1 for user already exists, 2 for other error,
! # 3 for clone failure and undef if caller isn't an admin.  If
! # successful also returns an initial password for the user.
  #
  # ----------------------------------------------------------------------------
***************
*** 3292,3296 ****

      if ( $can_admin != 1 ) {
!         return undef;
      }

--- 3308,3312 ----

      if ( $can_admin != 1 ) {
!         return ( undef, undef );
      }

***************
*** 3298,3312 ****

      if ( defined( $self->get_user_id( $session, $new_user ) ) ) {
!         return 1;
      }

!     my $password = md5_hex( $new_user . '__popfile__' );

!     $self->db_()->do( "insert into users ( name, password ) values ( '$new_user', '$password' );" );

      my $id = $self->get_user_id( $session, $new_user );

      if ( !defined( $id ) ) {
!         return 2;
      }

--- 3314,3339 ----

      if ( defined( $self->get_user_id( $session, $new_user ) ) ) {
!         return ( 1, undef );
      }

!     my $password = '';
!     my @chars = split( //,'abcdefghijklmnopqurstuvwxyz0123456789' );

!     while ( length( $password ) < 8 ) {
!         my $c = $chars[int(rand($#chars+1))];
!         if ( int(rand(2)) == 1 ) {
!             $c = uc($c);
!         }
!         $password .= $c;
!     }
! 
!     my $password_hash = md5_hex( $new_user . '__popfile__' . $password );
! 
!     $self->db_()->do( "insert into users ( name, password ) values ( '$new_user', '$password_hash' );" );

      my $id = $self->get_user_id( $session, $new_user );

      if ( !defined( $id ) ) {
!         return ( 2, undef );
      }

***************
*** 3317,3321 ****
          my $clid = $self->get_user_id( $session, $clone );
          if ( !defined( $clid ) ) {
!             return 3;
          }
          my $h = $self->db_()->prepare( "select utid, val from user_params where userid = $clid;" );
--- 3344,3348 ----
          my $clid = $self->get_user_id( $session, $clone );
          if ( !defined( $clid ) ) {
!             return ( 3, undef );
          }
          my $h = $self->db_()->prepare( "select utid, val from user_params where userid = $clid;" );
***************
*** 3344,3353 ****

          # TODO clone bucket parameters
- 
-         # TODO assign a password
- 
      }

!     return 0;
  }

--- 3371,3377 ----

          # TODO clone bucket parameters
      }

!     return ( 0, $password );
  }

***************
*** 3359,3363 ****
  #
  # $session     A valid session ID for an administrator
! # $user        The name for the new to remove
  #
  # Returns 0 for success, undef for wrong permissions and 1 for user
--- 3383,3387 ----
  #
  # $session     A valid session ID for an administrator
! # $user        The name of the user to remove
  #
  # Returns 0 for success, undef for wrong permissions and 1 for user
***************
*** 3388,3391 ****
--- 3412,3416 ----
          if ( $val == 0 ) {
              $self->db_()->do( "delete from users where name = '$user';" );
+             return 0;
          } else {
              return 2;
***************
*** 3393,3397 ****
      }

!     return 0;
  }

--- 3418,3496 ----
      }

!     return 1;
! }
! 
! #----------------------------------------------------------------------------
! #
! # validate_password
! #
! # Checks the password for the current user
! #
! # $session     A valid session ID
! # $password    A possible password to check
! #
! # Returns 1 if the password is valid, 0 otherwise
! #
! # ----------------------------------------------------------------------------
! sub validate_password
! {
!     my ( $self, $session, $password ) = @_;
! 
!     # Lookup the user name from the session key
! 
!     my $user;
!     my $h = $self->db_()->prepare( "select name from users where id = $self->{api_sessions__}{$session};" );
!     $h->execute;
!     if ( my $row = $h->fetchrow_arrayref ) {
!         $h->finish;
!         $user = $row->[0];
!     } else {
!         return 0;
!     }
! 
!     my $hash = md5_hex( $user . '__popfile__' . $password );
! 
!     $self->{db_get_userid__}->execute( $user, $hash );
!     my $result = $self->{db_get_userid__}->fetchrow_arrayref;
!     if ( !defined( $result ) ) {
!         return 0;
!     }
! 
!     return 1;
! }
! 
! #----------------------------------------------------------------------------
! #
! # set_password
! #
! # Sets the password for the current user
! #
! # $session     A valid session ID
! # $password    The new password
! #
! # Returns 1 if the password was updated, 0 if not
! #
! # ----------------------------------------------------------------------------
! sub set_password
! {
!     my ( $self, $session, $password ) = @_;
! 
!     # Lookup the user name from the session key
! 
!     my $user;
!     my $h = $self->db_()->prepare( "select name from users where id = $self->{api_sessions__}{$session};" );
!     $h->execute;
!     if ( my $row = $h->fetchrow_arrayref ) {
!         $h->finish;
!         $user = $row->[0];
!     } else {
!         return 0;
!     }
! 
!     my $hash = md5_hex( $user . '__popfile__' . $password );
! 
!     $self->db_()->do( "update users set password = '$hash' where id = $self->{api_sessions__}{$session};" );
! 
!     return 1;
  }

***************
*** 3473,3477 ****
      return undef if ( !defined( $userid ) );

!     my ( $val, $def)= $self->get_user_parameter_from_id( $userid, $parameter );

      return $val;
--- 3572,3576 ----
      return undef if ( !defined( $userid ) );

!     my ( $val, $def )= $self->get_user_parameter_from_id( $userid,$parameter );

      return $val;
***************
*** 3482,3486 ****
  # get_user_id (ADMIN ONLY)
  #
! # Returns the database ID of a named used
  #
  # $session     A valid session ID
--- 3581,3585 ----
  # get_user_id (ADMIN ONLY)
  #
! # Returns the database ID of a named user
  #
  # $session     A valid session ID
***************
*** 3688,3693 ****
  # fast_get_html_colored_message
  #
! # Parser a mail message stored in a file and returns HTML representing the message
! # with coloring of the words
  #
  # $session        A valid session key returned by a call to get_session_key
--- 3787,3792 ----
  # fast_get_html_colored_message
  #
! # Parser a mail message stored in a file and returns HTML representing
! # the message with coloring of the words
  #
  # $session        A valid session key returned by a call to get_session_key