popfile-commit — CVS commit list messages

[popfile-commit] engine/tests/corpus/spam table,1.1,NONE

[<jgr...@us...>]

Update of /cvsroot/popfile/engine/tests/corpus/spam
In directory sc8-pr-cvs1:/tmp/cvs-serv28581/spam

Removed Files:
	table 
Log Message:
Empty this structure as not needed

--- table DELETED ---

[popfile-commit] engine/tests/corpus/personal table,1.1,NONE

[<jgr...@us...>]

Update of /cvsroot/popfile/engine/tests/corpus/personal
In directory sc8-pr-cvs1:/tmp/cvs-serv28581/personal

Removed Files:
	table 
Log Message:
Empty this structure as not needed

--- table DELETED ---

[popfile-commit] engine/tests/corpus/other table,1.1,NONE

[<jgr...@us...>]

Update of /cvsroot/popfile/engine/tests/corpus/other
In directory sc8-pr-cvs1:/tmp/cvs-serv28581/other

Removed Files:
	table 
Log Message:
Empty this structure as not needed

--- table DELETED ---

[popfile-commit] engine/Proxy POP3.pm,1.66,1.67

[<jgr...@us...>]

Update of /cvsroot/popfile/engine/Proxy
In directory sc8-pr-cvs1:/tmp/cvs-serv25896/Proxy

Modified Files:
	POP3.pm 
Log Message:
Fix bug (found in course of writing test suite... hooray) that when a RETR command failed with -ERR we would perform it twice

Index: POP3.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Proxy/POP3.pm,v
retrieving revision 1.66
retrieving revision 1.67
diff -C2 -d -r1.66 -r1.67
*** POP3.pm	30 Jul 2003 23:35:03 -0000	1.66
--- POP3.pm	31 Jul 2003 14:22:42 -0000	1.67
***************
*** 416,420 ****
                  close RETRFILE;
                  print $client ".$eol";
-                 next;
              } else {
  
--- 416,419 ----
***************
*** 438,443 ****
  
                      $self->flush_extra_( $mail, $client, 0 );
-                     next;
                  }
              }
          }
--- 437,443 ----
  
                      $self->flush_extra_( $mail, $client, 0 );
                  }
+ 
+                 next;
              }
          }

[popfile-commit] engine tests.pl,1.23,1.24

[<jgr...@us...>]

Update of /cvsroot/popfile/engine
In directory sc8-pr-cvs1:/tmp/cvs-serv25604

Modified Files:
	tests.pl 
Log Message:
Small change to make error reporting a bit clearer

Index: tests.pl
===================================================================
RCS file: /cvsroot/popfile/engine/tests.pl,v
retrieving revision 1.23
retrieving revision 1.24
diff -C2 -d -r1.23 -r1.24
*** tests.pl	26 Jul 2003 18:28:27 -0000	1.23
--- tests.pl	31 Jul 2003 14:21:10 -0000	1.24
***************
*** 105,109 ****
          }
  
!         test_report( $result, "expecting $expected and got $test", $file, $line, $context );
  }
  
--- 105,109 ----
          }
  
!         test_report( $result, "expecting [$expected] and got [$test]", $file, $line, $context );
  }
  
***************
*** 130,134 ****
      my $result = ( $test =~ /$expected/ );
  
!     test_report( $result, "expecting to match $expected and got $test", $file, $line, $context );
  }
  
--- 130,134 ----
      my $result = ( $test =~ /$expected/ );
  
!     test_report( $result, "expecting to match [$expected] and got [$test]", $file, $line, $context );
  }
  

[popfile-commit] engine/tests Makefile,1.3,1.4

[<jgr...@us...>]

Update of /cvsroot/popfile/engine/tests
In directory sc8-pr-cvs1:/tmp/cvs-serv25385

Modified Files:
	Makefile 
Log Message:
Clean up temporary directory at end of test run

Index: Makefile
===================================================================
RCS file: /cvsroot/popfile/engine/tests/Makefile,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** Makefile	30 Jul 2003 22:48:32 -0000	1.3
--- Makefile	31 Jul 2003 14:20:09 -0000	1.4
***************
*** 14,15 ****
--- 14,16 ----
  	@perl ../coverage.pl
  endif
+ 	@rm -rf corpus
\ No newline at end of file

[popfile-commit] engine/tests/corpus.base/spam params,1.2,1.3

[<jgr...@us...>]

Update of /cvsroot/popfile/engine/tests/corpus.base/spam
In directory sc8-pr-cvs1:/tmp/cvs-serv25260/corpus.base/spam

Modified Files:
	params 
Log Message:
Quarantine needs to be off by default

Index: params
===================================================================
RCS file: /cvsroot/popfile/engine/tests/corpus.base/spam/params,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** params	27 Jul 2003 21:13:40 -0000	1.2
--- params	31 Jul 2003 14:19:49 -0000	1.3
***************
*** 1,3 ****
  count 0
  subject 1
! quarantine 1
--- 1,3 ----
  count 0
  subject 1
! quarantine 0

[popfile-commit] windows installer.nsi,1.94,1.95

[<xue...@us...>]

Update of /cvsroot/popfile/windows
In directory sc8-pr-cvs1:/tmp/cvs-serv20789

Modified Files:
	installer.nsi 
Log Message:
Disable two debug aids (install log and visible 'upgrade uninstall').

Index: installer.nsi
===================================================================
RCS file: /cvsroot/popfile/windows/installer.nsi,v
retrieving revision 1.94
retrieving revision 1.95
diff -C2 -d -r1.94 -r1.95
*** installer.nsi	27 Jul 2003 00:19:04 -0000	1.94
--- installer.nsi	31 Jul 2003 10:58:31 -0000	1.95
***************
*** 231,235 ****
    ; Debug aid: Allow log file checking (by clicking "Show Details" button on the "Install" page)
  
!   !define MUI_FINISHPAGE_NOAUTOCLOSE
  
    ;-----------------------------------------
--- 231,235 ----
    ; Debug aid: Allow log file checking (by clicking "Show Details" button on the "Install" page)
  
! #  !define MUI_FINISHPAGE_NOAUTOCLOSE
  
    ;-----------------------------------------
***************
*** 1175,1179 ****
    Banner::show /NOUNLOAD /set 76 "$(PFI_LANG_OPTIONS_BANNER_1)" "$(PFI_LANG_OPTIONS_BANNER_2)"
    WriteUninstaller $INSTDIR\uninstall.exe
!   ExecWait '"$INSTDIR\uninstall.exe"  _?=$INSTDIR'
    IfFileExists "$INSTDIR\popfile.pl" skip_msg_delete
  
--- 1175,1179 ----
    Banner::show /NOUNLOAD /set 76 "$(PFI_LANG_OPTIONS_BANNER_1)" "$(PFI_LANG_OPTIONS_BANNER_2)"
    WriteUninstaller $INSTDIR\uninstall.exe
!   ExecWait '"$INSTDIR\uninstall.exe" /S _?=$INSTDIR'
    IfFileExists "$INSTDIR\popfile.pl" skip_msg_delete
  

[popfile-commit] engine/POPFile MQ.pm,1.4,1.5

[<jgr...@us...>]

Update of /cvsroot/popfile/engine/POPFile
In directory sc8-pr-cvs1:/tmp/cvs-serv18117/POPFile

Modified Files:
	MQ.pm 
Log Message:
Sort queues for consistency across Perl versions

Index: MQ.pm
===================================================================
RCS file: /cvsroot/popfile/engine/POPFile/MQ.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** MQ.pm	26 Jul 2003 18:28:28 -0000	1.4
--- MQ.pm	31 Jul 2003 01:54:31 -0000	1.5
***************
*** 87,91 ****
      # Iterate through all the messages in all the queues
  
!     for my $type (keys %{$self->{queue__}}) {
           while ( my $ref = shift @{$self->{queue__}{$type}} ) {
               for my $waiter (@{$self->{waiters__}{$type}}) {
--- 87,91 ----
      # Iterate through all the messages in all the queues
  
!     for my $type (sort keys %{$self->{queue__}}) {
           while ( my $ref = shift @{$self->{queue__}{$type}} ) {
               for my $waiter (@{$self->{waiters__}{$type}}) {

[popfile-commit] engine/Test SimpleProxy.pm,1.9,1.10

[<ssc...@us...>]

Update of /cvsroot/popfile/engine/Test
In directory sc8-pr-cvs1:/tmp/cvs-serv14293

Modified Files:
	SimpleProxy.pm 
Log Message:
increase delay on sucessive sent lines to allow tests to complete here

Index: SimpleProxy.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Test/SimpleProxy.pm,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** SimpleProxy.pm	26 Jul 2003 21:17:18 -0000	1.9
--- SimpleProxy.pm	31 Jul 2003 01:26:08 -0000	1.10
***************
*** 109,113 ****
          while ( $self->{send__} =~ s/^([^\r\n]+)[\r\n]+// ) {
              $self->tee_( $handle, "$1$eol" );
!             select( undef, undef, undef, 0.1 );
          }
  
--- 109,113 ----
          while ( $self->{send__} =~ s/^([^\r\n]+)[\r\n]+// ) {
              $self->tee_( $handle, "$1$eol" );
!             select( undef, undef, undef, 0.15 );
          }
  

[popfile-commit] engine/Proxy POP3.pm,1.65,1.66

[<jgr...@us...>]

Update of /cvsroot/popfile/engine/Proxy
In directory sc8-pr-cvs1:/tmp/cvs-serv27315/Proxy

Modified Files:
	POP3.pm 
Log Message:
Clean up comments

Index: POP3.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Proxy/POP3.pm,v
retrieving revision 1.65
retrieving revision 1.66
diff -C2 -d -r1.65 -r1.66
*** POP3.pm	30 Jul 2003 23:06:12 -0000	1.65
--- POP3.pm	30 Jul 2003 23:35:03 -0000	1.66
***************
*** 77,99 ****
      # item that needs a UI component
  
!     $self->register_configuration_item_( 'configuration',
                                           'pop3_port',
!                                          $self );
  
!     $self->register_configuration_item_( 'configuration',
                                           'pop3_separator',
!                                          $self );
  
!     $self->register_configuration_item_( 'security',
                                           'pop3_local',
!                                          $self );
  
!     $self->register_configuration_item_( 'chain',
                                           'pop3_secure_server',
!                                          $self );
  
!     $self->register_configuration_item_( 'chain',
                                           'pop3_secure_server_port',
!                                          $self );
  
      return 1;
--- 77,99 ----
      # item that needs a UI component
  
!     $self->register_configuration_item_( 'configuration',              # PROFILE BLOCK START
                                           'pop3_port',
!                                          $self );                      # PROFILE BLOCK STOP
  
!     $self->register_configuration_item_( 'configuration',              # PROFILE BLOCK START
                                           'pop3_separator',
!                                          $self );                      # PROFILE BLOCK STOP
  
!     $self->register_configuration_item_( 'security',                   # PROFILE BLOCK START
                                           'pop3_local',
!                                          $self );                      # PROFILE BLOCK STOP
  
!     $self->register_configuration_item_( 'chain',                      # PROFILE BLOCK START
                                           'pop3_secure_server',
!                                          $self );                      # PROFILE BLOCK STOP
  
!     $self->register_configuration_item_( 'chain',                      # PROFILE BLOCK START
                                           'pop3_secure_server_port',
!                                          $self );                      # PROFILE BLOCK STOP
  
      return 1;
***************
*** 115,131 ****
  
      # Hash of indexes of downloaded messages
-     my %downloaded;
  
!     # Number of messages downloaded in this session
!     #my $count = 0;
  
      # The handle to the real mail server gets stored here
      my $mail;
  
      # Tell the client that we are ready for commands and identify our version number
      $self->tee_( $client, "+OK " . $self->config_( 'welcome_string' ) . "$eol" );
  
      # Retrieve commands from the client and process them until the client disconnects or
      # we get a specific QUIT command
      while  ( <$client> ) {
          my $command;
--- 115,132 ----
  
      # Hash of indexes of downloaded messages
  
!     my %downloaded;
  
      # The handle to the real mail server gets stored here
+ 
      my $mail;
  
      # Tell the client that we are ready for commands and identify our version number
+ 
      $self->tee_( $client, "+OK " . $self->config_( 'welcome_string' ) . "$eol" );
  
      # Retrieve commands from the client and process them until the client disconnects or
      # we get a specific QUIT command
+ 
      while  ( <$client> ) {
          my $command;
***************
*** 134,137 ****
--- 135,139 ----
  
          # Clean up the command so that it has a nice clean $eol at the end
+ 
          $command =~ s/(\015|\012)//g;
  
***************
*** 144,147 ****
--- 146,150 ----
          # will pull email from.  Doing this means we can act as a proxy for multiple mail clients
          # and mail accounts
+ 
          my $user_command = 'USER (.+?)(:(\d+))?' . $self->config_( 'separator' ) . '(.+)';
          if ( $command =~ /$user_command/i ) {
***************
*** 149,154 ****
--- 152,159 ----
                  print $pipe "LOGIN:$4$eol";
                  if ( $mail = $self->verify_connected_( $mail, $client, $1, $3 || 110 ) )  {
+ 
                      # Pass through the USER command with the actual user name for this server,
                      # and send the reply straight to the client
+ 
                      $self->echo_response_($mail, $client, 'USER ' . $4 );
                  } else {
***************
*** 169,176 ****
--- 174,184 ----
  
          # User is issuing the APOP command to start a session with the remote server
+ 
          if ( $command =~ /APOP (.*):((.*):)?(.*) (.*)/i ) {
              if ( $mail = $self->verify_connected_( $mail, $client,  $1, $3 || 110 ) )  {
+ 
                  # Pass through the USER command with the actual user name for this server,
                  # and send the reply straight to the client
+ 
                  $self->echo_response_($mail, $client, "APOP $4 $5" );
              } else {
***************
*** 183,195 ****
--- 191,208 ----
  
          # Secure authentication
+ 
          if ( $command =~ /AUTH ([^ ]+)/ ) {
              if ( $self->config_( 'secure_server' ) ne '' )  {
                  if ( $mail = $self->verify_connected_( $mail, $client,  $self->config_( 'secure_server' ), $self->config_( 'secure_port' ) ) )  {
+ 
                      # Loop until we get -ERR or +OK
+ 
                      my $response;
                      $response = $self->get_response_( $mail, $client, $command );
  
                      while ( ( ! ( $response =~ /\+OK/ ) ) && ( ! ( $response =~ /-ERR/ ) ) ) {
+ 
                          # Check for an abort
+ 
                          if ( $self->{alive} == 0 ) {
                              last;
***************
*** 232,237 ****
  
          # The client is requesting a LIST/UIDL of the messages
!         if ( ( $command =~ /LIST ?(.*)?/i ) ||
!              ( $command =~ /UIDL ?(.*)?/i ) ) {
              if ( $self->echo_response_($mail, $client, $command ) ) {
                  $self->echo_to_dot_( $mail, $client ) if ( $1 eq '' );
--- 245,251 ----
  
          # The client is requesting a LIST/UIDL of the messages
! 
!         if ( ( $command =~ /LIST ?(.*)?/i ) ||                            # PROFILE BLOCK START
!              ( $command =~ /UIDL ?(.*)?/i ) ) {                           # PROFILE BLOCK STOP
              if ( $self->echo_response_($mail, $client, $command ) ) {
                  $self->echo_to_dot_( $mail, $client ) if ( $1 eq '' );
***************
*** 300,303 ****
--- 314,318 ----
  
                              # Tell the parent that we just handled a mail
+ 
                              print $pipe "CLASS:$class$eol";
                              print $pipe "NEWFL:$history_file$eol";
***************
*** 316,319 ****
--- 331,335 ----
  
          # The CAPA command
+ 
          if ( $command =~ /CAPA/i ) {
              if ( $self->config_( 'secure_server' ) ne '' )  {
***************
*** 333,336 ****
--- 349,353 ----
          # The HELO command results in a very simple response from us.  We just echo that
          # we are ready for commands
+ 
          if ( $command =~ /HELO/i ) {
              $self->tee_(  $client, "+OK HELO POPFile Server Ready$eol" );
***************
*** 340,349 ****
          # In the case of PASS, NOOP, XSENDER, STAT, DELE and RSET commands we simply pass it through to
          # the real mail server for processing and echo the response back to the client
!         if ( ( $command =~ /PASS (.*)/i )    ||
               ( $command =~ /NOOP/i )         ||
               ( $command =~ /STAT/i )         ||
               ( $command =~ /XSENDER (.*)/i ) ||
               ( $command =~ /DELE (.*)/i )    ||
!              ( $command =~ /RSET/i ) ) {
              $self->echo_response_($mail, $client, $command );
              $self->flush_extra_( $mail, $client, 0 );
--- 357,367 ----
          # In the case of PASS, NOOP, XSENDER, STAT, DELE and RSET commands we simply pass it through to
          # the real mail server for processing and echo the response back to the client
! 
!         if ( ( $command =~ /PASS (.*)/i )    ||                  # PROFILE BLOCK START
               ( $command =~ /NOOP/i )         ||
               ( $command =~ /STAT/i )         ||
               ( $command =~ /XSENDER (.*)/i ) ||
               ( $command =~ /DELE (.*)/i )    ||
!              ( $command =~ /RSET/i ) ) {                         # PROFILE BLOCK STOP
              $self->echo_response_($mail, $client, $command );
              $self->flush_extra_( $mail, $client, 0 );
***************
*** 354,357 ****
--- 372,376 ----
          # Note the horrible hack here where we detect a command of the form TOP x 99999999 this
          # is done so that fetchmail can be used with POPFile.
+ 
          if ( ( $command =~ /RETR (.*)/i ) || ( $command =~ /TOP (.*) 99999999/i ) )  {
              my $count = $1;
***************
*** 382,389 ****
--- 401,410 ----
  
                  if ($bucket ne 'unknown class') {
+ 
                      # echo file, inserting known classification, without saving
  
                      $class = $self->{classifier__}->classify_and_modify( \*RETRFILE, $client, $download_count, 0, 1, $bucket );
                  } else {
+ 
                      # If the class wasn't saved properly, classify from disk normally
  
***************
*** 397,404 ****
--- 418,427 ----
                  next;
              } else {
+ 
                  # Retrieve file directly from the server
  
                  # Get the message from the remote server, if there's an error then we're done, but if not then
                  # we echo each line of the message until we hit the . at the end
+ 
                  if ( $self->echo_response_($mail, $client, $command ) ) {
                      my $history_file;
***************
*** 406,413 ****
--- 429,438 ----
  
                      # Tell the parent that we just handled a mail
+ 
                      print $pipe "NEWFL:$history_file$eol";
                      print $pipe "CLASS:$class$eol";
  
                      # Note locally that file has been retrieved
+ 
                      $downloaded{$count} = 1;
  
***************
*** 421,424 ****
--- 446,450 ----
          # real mail server, echo the response back up to the client and exit the while.  We will
          # close the connection immediately
+ 
          if ( $command =~ /QUIT/i ) {
              if ( $mail )  {
***************
*** 432,435 ****
--- 458,462 ----
  
          # Don't know what this is so let's just pass it through and hope for the best
+ 
          if ( $mail && $mail->connected )  {
              $self->echo_response_($mail, $client, $command );

[popfile-commit] engine/Proxy POP3.pm,1.64,1.65

[<jgr...@us...>]

Update of /cvsroot/popfile/engine/Proxy
In directory sc8-pr-cvs1:/tmp/cvs-serv22415/Proxy

Modified Files:
	POP3.pm 
Log Message:
Fix a bug that was preventing use of the host:port:username syntax

Index: POP3.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Proxy/POP3.pm,v
retrieving revision 1.64
retrieving revision 1.65
diff -C2 -d -r1.64 -r1.65
*** POP3.pm	30 Jul 2003 22:48:58 -0000	1.64
--- POP3.pm	30 Jul 2003 23:06:12 -0000	1.65
***************
*** 144,148 ****
          # will pull email from.  Doing this means we can act as a proxy for multiple mail clients
          # and mail accounts
!         my $user_command = 'USER (.+)(:(\d+))?' . $self->config_( 'separator' ) . '(.+)';
          if ( $command =~ /$user_command/i ) {
              if ( $1 ne '' )  {
--- 144,148 ----
          # will pull email from.  Doing this means we can act as a proxy for multiple mail clients
          # and mail accounts
!         my $user_command = 'USER (.+?)(:(\d+))?' . $self->config_( 'separator' ) . '(.+)';
          if ( $command =~ /$user_command/i ) {
              if ( $1 ne '' )  {

[popfile-commit] engine/tests TestPOP3.tst,NONE,1.1

[<jgr...@us...>]

Update of /cvsroot/popfile/engine/tests
In directory sc8-pr-cvs1:/tmp/cvs-serv18890/tests

Added Files:
	TestPOP3.tst 
Log Message:
Initial commit of test suite for the POP3 proxy; currently consists of a POP3 server that can send the TestMailParse\d+.tst files and respond to standard POP3 commands, an instance of the POP3 proxy and a very simple POP3 client

--- NEW FILE: TestPOP3.tst ---
# ---------------------------------------------------------------------------------------------
#
# Tests for POP3.pm
#
# Copyright (c) 2003 John Graham-Cumming
#
# ---------------------------------------------------------------------------------------------

use POPFile::Configuration;
use POPFile::MQ;
use POPFile::Logger;
use Proxy::POP3;
use IO::Handle;
use IO::Socket;

use POSIX ":sys_wait_h";

my $eol = "\015\012";

sub forker
{
    pipe my $reader, my $writer;
    my $pid = fork();

    if ( !defined( $pid ) ) {
        close $reader;
        close $writer;
        return (undef, undef);
    }

    if ( $pid == 0 ) {
        close $reader;

        use IO::Handle;
        $writer->autoflush(1);

        return (0, $writer);
    }

    close $writer;
    return ($pid, $reader);
}

sub pipeready
{
    my ( $pipe ) = @_;

    if ( !defined( $pipe ) ) {
        return 0;
    }

    if ( $^O eq 'MSWin32' ) {
        return ( ( -s $pipe ) > 0 );
    } else {
        my $rin = '';
        vec( $rin, fileno( $pipe ), 1 ) = 1;
        my $ready = select( $rin, undef, undef, 0.01 );
        return ( $ready > 0 );
    }
}

sub server
{
    my $client;
    my @messages = glob '*.msg';

    while  ( <$client> ) {
        my $command;

        $command = $_;
        $command =~ s/(\015|\012)//g;

        if ( $command =~ /USER (.*)/i ) {
	    if ( $1 =~ /gooduser/ ) {
                 print $client "+OK Welcome $1$eol";
	    } else {
                 print $client "-ERR Unknown user $1$eol";
            }
            next;
        }

        if ( $command =~ /PASS (.*)/i ) {
	    if ( $1 =~ /secret/ ) {
                 print $client "+OK Now logged in$eol";
	    } else {
                 print $client "-ERR Bad Password$eol";
            }
	}

        if ( ( $command =~ /LIST ?(.*)?/i ) ||
             ( $command =~ /UIDL ?(.*)?/i ) ||
             ( $command =~ /STAT/ ) ) {
            my $count = 0;
            my $size  = 0;
            for my $i (0..$#messages) {
	        if ( $messages[$i] ne '' ) {
                    $count += 1;
                    $size  += ( -s $messages[$i] );
	        }
	    }

            print $client "+OK $count $size$eol";

            if ( $command =~ /STAT/ ) {
                next;
	    }

            for my $i (0..$#messages) {
	        if ( $messages[$i] ne '' ) {
                     my $resp = ( $command =~ /LIST/ )?( -s $messages[$i] ):$messages[$i];
                     print $client ($i+1) . " $resp$eol";
	        }
	    }

            print $client ".$eol";

            next;
        }

        if ( $command =~ /QUIT/i ) {
            print $client "+OK Bye$eol";
            next;
        }

        if ( $command =~ /__QUIT__/i ) {
            print $client "+OK Bye$eol";
            last;
        }

        if ( $command =~ /RSET/i ) {
            @messages = glob '*.msg';
            print $client "+OK Reset$eol";
            next;
        }

        if ( $command =~ /HELO/i ) {
            print $client "+OK Hello$eol";
            next;
        }

        if ( $command =~ /DELE (.*)/i ) {
            $messages[$1] = '';
            print $client "+OK Deleted $1$eol";
            next;
        }

        if ( $command =~ /RETR (.*)/i ) {
	    if ( $messages[$1] ne '' ) {
                 print $client "+OK " . ( -s $messages[$1] ) . "$eol";

                 open FILE, "<$messages[$1]";
                 while ( <FILE> ) {
                     print $client $_;
		 }
                 close FILE;

                 print $client ".$eol";

	    } else {
                print $client "-ERR No such message $1$eol";
            }
            next;
        }

        if ( $command =~ /TOP (.*) (.*)/i ) {
	    if ( $messages[$1] ne '' ) {
                 print $client "+OK " . ( -s $messages[$1] ) . "$eol";

                 open FILE, "<$messages[$1]";
                 while ( <FILE> ) {
                     print $client $_;

                     if ( !/[^ \t\r\n]/ ) {
                         last;
		     }
		 }
                 my $countdown = $2;
                 while ( <FILE> && ( $countdown > 0 ) ) {
                     print $client $_;
                     $countdown -= 1;
		 }
                 close FILE;

                 print $client ".$eol";

	    } else {
                print $client "-ERR No such message $1$eol";
            }
            next;
        }

        if ( $command =~ /CAPA/i ) {
            next;
        }

        if ( $command =~ /APOP (.*):((.*):)?(.*) (.*)/i ) {
            next;
        }

        if ( $command =~ /AUTH ([^ ]+)/ ) {
            next;
        }

        if ( $command =~ /AUTH/ ) {
            next;
        }

        print $client "-ERR unknown command or bad syntax$eol";
    }
}

my $pid = fork();

if ( $pid == 0 ) {

    # CHILD THAT WILL RUN THE POP3 SERVER

    exit(0);
} else {

    my $port = 9000 + int(rand(1000));
    my $pid2 = fork();

    if ( $pid2 == 0 ) {

        # CHILD THAT WILL RUN THE POP3 PROXY

        my $c = new POPFile::Configuration;
        my $mq = new POPFile::MQ;
        my $l = new POPFile::Logger;
        my $p = new Proxy::POP3

        $c->configuration( $c );
        $c->mq( $mq );
        $c->logger( $l );

        $c->initialize();

        $l->configuration( $c );
        $l->mq( $mq );
        $l->logger( $l );

        $l->initialize();

        $mq->configuration( $c );
        $mq->mq( $mq );
        $mq->logger( $l );

        $p->configuration( $c );
        $p->mq( $mq );
        $p->logger( $l );

        $p->forker( \&forker );
        $p->pipeready( \&pipeready );

        $p->{version_} = 'test suite';
        $p->initialize();
        $p->config_( 'port', $port );
        test_assert_equal( $p->start(), 1 );

        my $now = time;

        while ( $p->service() && ( ( $now + 5 ) > time ) ) {
	}

        my @kids = keys %{$p->{children__}};
        while ( $#kids >= 0 ) {
            $p->reaper();
            select( undef, undef, undef, 0.25 );
            @kids = keys %{$p->{children__}};
        }

        $p->stop();

        exit(0);
    } else {

        # PARENT THAT WILL SEND COMMAND TO THE PROXY

        my $client = IO::Socket::INET->new(
                        Proto    => "tcp",
                        PeerAddr => 'localhost',
                        PeerPort => $port );

        test_assert( defined( $client ) );
        test_assert( $client->connected );

        close $client;

        while ( waitpid( $pid, &WNOHANG ) != $pid ) {
        }
        while ( waitpid( $pid2, &WNOHANG ) != $pid2 ) {
        }
    }
}

[popfile-commit] engine/Proxy POP3.pm,1.63,1.64

[<jgr...@us...>]

Update of /cvsroot/popfile/engine/Proxy
In directory sc8-pr-cvs1:/tmp/cvs-serv18440/Proxy

Modified Files:
	POP3.pm 
Log Message:
If the USER command fails wait for another command from the server so that the client can send QUIT

Index: POP3.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Proxy/POP3.pm,v
retrieving revision 1.63
retrieving revision 1.64
diff -C2 -d -r1.63 -r1.64
*** POP3.pm	26 Jul 2003 18:28:28 -0000	1.63
--- POP3.pm	30 Jul 2003 22:48:58 -0000	1.64
***************
*** 153,157 ****
                      $self->echo_response_($mail, $client, 'USER ' . $4 );
                  } else {
!                     last;
                  }
              } else {
--- 153,161 ----
                      $self->echo_response_($mail, $client, 'USER ' . $4 );
                  } else {
! 
!                     # If the login fails then we want to continue in the unlogged in state
!                     # so that clients can send us the QUIT command
! 
!                     next;
                  }
              } else {

[popfile-commit] engine/tests Makefile,1.2,1.3

[<jgr...@us...>]

Update of /cvsroot/popfile/engine/tests
In directory sc8-pr-cvs1:/tmp/cvs-serv18324/tests

Modified Files:
	Makefile 
Log Message:
If DEBUGARGS is not defined then don't run the coverage tool since we wont have collected coverage data

Index: Makefile
===================================================================
RCS file: /cvsroot/popfile/engine/tests/Makefile,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** Makefile	13 Jul 2003 05:21:21 -0000	1.2
--- Makefile	30 Jul 2003 22:48:32 -0000	1.3
***************
*** 11,13 ****
--- 11,15 ----
  runtest:
  	@perl -I ../ $(DEBUGARGS) ../tests.pl $(TESTARGS)
+ ifdef DEBUGARGS
  	@perl ../coverage.pl
+ endif

[popfile-commit] engine/UI HTTP.pm,1.10,1.11

[<jgr...@us...>]

Update of /cvsroot/popfile/engine/UI
In directory sc8-pr-cvs1:/tmp/cvs-serv20181/UI

Modified Files:
	HTTP.pm 
Log Message:
Complete test suite for the UI::HTTP module

Index: HTTP.pm
===================================================================
RCS file: /cvsroot/popfile/engine/UI/HTTP.pm,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** HTTP.pm	26 Jul 2003 23:52:44 -0000	1.10
--- HTTP.pm	28 Jul 2003 00:03:03 -0000	1.11
***************
*** 33,36 ****
--- 33,38 ----
      my $self = POPFile::Module->new();
  
+     bless $self;
+ 
      return $self;
  }
***************
*** 47,60 ****
      my ( $self ) = @_;
  
!     $self->{server_} = IO::Socket::INET->new( Proto     => 'tcp',
                                      $self->config_( 'local' )  == 1 ? (LocalAddr => 'localhost') : (),
                                       LocalPort => $self->config_( 'port' ),
                                       Listen    => SOMAXCONN,
!                                      Reuse     => 1 );
  
      if ( !defined( $self->{server_} ) ) {
          my $port = $self->config_( 'port' );
          my $name = $self->name();
!         print <<EOM;
  
  \nCouldn't start the $name HTTP interface because POPFile could not bind to the
--- 49,62 ----
      my ( $self ) = @_;
  
!     $self->{server_} = IO::Socket::INET->new( Proto     => 'tcp',             # PROFILE BLOCK START
                                      $self->config_( 'local' )  == 1 ? (LocalAddr => 'localhost') : (),
                                       LocalPort => $self->config_( 'port' ),
                                       Listen    => SOMAXCONN,
!                                      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
***************
*** 65,68 ****
--- 67,71 ----
  
  EOM
+ # PROFILE BLOCK STOP
  
          return 0;
***************
*** 115,120 ****
              my ( $remote_port, $remote_host ) = sockaddr_in( $client->peername() );
  
!             if ( ( $self->config_( 'local' ) == 0 ) ||
!                  ( $remote_host eq inet_aton( "127.0.0.1" ) ) ) {
  
                  # Read the request line (GET or POST) from the client and if we manage to do that
--- 118,123 ----
              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
***************
*** 199,203 ****
  # parse_form_    - parse form data and fill in $self->{form_}
  #
! # $arguments         The text of the form arguments (e.g. foo=bar&baz=fou)
  #
  # ---------------------------------------------------------------------------------------------
--- 202,207 ----
  # parse_form_    - parse form data and fill in $self->{form_}
  #
! # $arguments         The text of the form arguments (e.g. foo=bar&baz=fou) or separated by
! #                    CR/LF
  #
  # ---------------------------------------------------------------------------------------------
***************
*** 220,227 ****
          my $need_array = defined( $self->{form_}{$arg} );
  
          $self->{form_}{$arg} = $2;
          $self->{form_}{$arg} =~ s/\+/ /g;
  
!         # Expand %7E (hex) escapes in the form data
  
          $self->{form_}{$arg} =~ s/%([0-9A-F][0-9A-F])/chr hex $1/gie;
--- 224,237 ----
          my $need_array = defined( $self->{form_}{$arg} );
  
+         if ( $need_array ) {
+ 	    if ( $#{ $self->{form_}{$arg . "_array"} } == -1 ) {
+                 push( @{ $self->{form_}{$arg . "_array"} }, $self->{form_}{$arg} );
+ 	    }
+ 	}
+ 
          $self->{form_}{$arg} = $2;
          $self->{form_}{$arg} =~ s/\+/ /g;
  
!         # Expand hex escapes in the form data
  
          $self->{form_}{$arg} =~ s/%([0-9A-F][0-9A-F])/chr hex $1/gie;
***************
*** 249,253 ****
  
      $text =~ s/ /\+/;
!     $text =~ s/([^a-zA-Z0-9_\-.+])/sprintf("%%%02x",ord($1))/eg;
  
      return $text;
--- 259,263 ----
  
      $text =~ s/ /\+/;
!     $text =~ s/([^a-zA-Z0-9_\-.\+\'!~*\(\)])/sprintf("%%%02x",ord($1))/eg;
  
      return $text;
***************
*** 268,272 ****
      my ( $self, $client, $url ) = @_;
  
!     my $header = "HTTP/1.0 302 Found\r\nLocation: ";
      $header .= $url;
      $header .= "$eol$eol";
--- 278,282 ----
      my ( $self, $client, $url ) = @_;
  
!     my $header = "HTTP/1.0 302 Found$eol" . 'Location: ';
      $header .= $url;
      $header .= "$eol$eol";
***************
*** 326,334 ****
          my ( $sec, $min, $hour, $mday, $mon, $year, $wday ) = gmtime( $zulu );
  
!         my $expires = sprintf( "%s, %02d %s %04d %02d:%02d:%02d GMT",
                                 $day[$wday], $mday, $month[$mon], $year+1900,
!                                $hour, $min, $sec);
  
!         my $header = "HTTP/1.0 200 OK\r\nContent-Type: $type\r\nExpires: $expires\r\nContent-Length: ";
          $header .= length($contents);
          $header .= "$eol$eol";
--- 336,344 ----
          my ( $sec, $min, $hour, $mday, $mon, $year, $wday ) = gmtime( $zulu );
  
!         my $expires = sprintf( "%s, %02d %s %04d %02d:%02d:%02d GMT",          # PROFILE BLOCK START
                                 $day[$wday], $mday, $month[$mon], $year+1900,
!                                $hour, 59, 0);                                  # PROFILE BLOCK STOP
  
!         my $header = "HTTP/1.0 200 OK$eol" . "Content-Type: $type$eol" . "Expires: $expires$eol" . "Content-Length: ";
          $header .= length($contents);
          $header .= "$eol$eol";

[popfile-commit] engine/tests TestHTTP.tst,NONE,1.1

[<jgr...@us...>]

Update of /cvsroot/popfile/engine/tests
In directory sc8-pr-cvs1:/tmp/cvs-serv20181/tests

Added Files:
	TestHTTP.tst 
Log Message:
Complete test suite for the UI::HTTP module

--- NEW FILE: TestHTTP.tst ---
# ---------------------------------------------------------------------------------------------
#
# Tests for HTTP.pm
#
# Copyright (c) 2003 John Graham-Cumming
#
# ---------------------------------------------------------------------------------------------

sub my_handler
{
    my ( $self, $client, $url, $command, $content ) = @_;

    my $code = 1;

    if ( $url =~ /\/stop/ ) {
        $code = 0;
    }

    $self->http_error_( $client, "$url $command $content" );

    return $code;
}

use IO::Handle;
use POSIX ":sys_wait_h";

use UI::HTTP;
use POPFile::Configuration;
use POPFile::MQ;
use POPFile::Logger;

my $c = new POPFile::Configuration;
my $mq = new POPFile::MQ;
my $l = new POPFile::Logger;
my $h = new UI::HTTP;

$c->configuration( $c );
$c->mq( $mq );
$c->logger( $l );

$l->configuration( $c );
$l->mq( $mq );
$l->logger( $l );

$l->initialize();

$mq->configuration( $c );
$mq->mq( $mq );
$mq->logger( $l );

$h->configuration( $c );
$h->mq( $mq );
$h->logger( $l );

$h->initialize();

my $port = 9000 + int(rand(1000));
$h->config_( 'port', $port );
$h->config_( 'local', 1 );
test_assert( $h->start() );

my $eol = "\015\012";

# parse_form_ tests

delete $h->{form_};
$h->parse_form_( 'foo=bar' );
my @keys = keys %{$h->{form_}};
test_assert_equal( $#keys, 0 );
test_assert_equal( $h->{form_}{foo}, 'bar' );

delete $h->{form_};
$h->parse_form_( 'answer=%2A' );
my @keys = keys %{$h->{form_}};
test_assert_equal( $#keys, 0 );
test_assert_equal( $h->{form_}{answer}, '*' );

delete $h->{form_};
$h->parse_form_( 'foo=bar&' );
my @keys = keys %{$h->{form_}};
test_assert_equal( $#keys, 0 );
test_assert_equal( $h->{form_}{foo}, 'bar' );

delete $h->{form_};
$h->parse_form_( 'foo=bar&bar=baz' );
my @keys = keys %{$h->{form_}};
test_assert_equal( $#keys, 1 );
test_assert_equal( $h->{form_}{foo}, 'bar' );
test_assert_equal( $h->{form_}{bar}, 'baz' );

delete $h->{form_};
$h->parse_form_( 'foo=bar&bar=baz' );
my @keys = keys %{$h->{form_}};
test_assert_equal( $#keys, 1 );
test_assert_equal( $h->{form_}{foo}, 'bar' );
test_assert_equal( $h->{form_}{bar}, 'baz' );

delete $h->{form_};
$h->parse_form_( 'foo=bar&foo=baz' );
my @keys = keys %{$h->{form_}};
test_assert_equal( $#keys, 1 );
test_assert_equal( $h->{form_}{foo}, 'baz' );
test_assert_equal( $h->{form_}{foo_array}[0], 'bar' );
test_assert_equal( $h->{form_}{foo_array}[1], 'baz' );

# url_encode_ tests

test_assert_equal( $h->url_encode_( 'nochange' ), 'nochange' );
my $allowed = '0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ-_.+!*\'()';
test_assert_equal( $h->url_encode_( $allowed ), $allowed );
test_assert_equal( $h->url_encode_( chr(0) ), '%00' );
test_assert_equal( $h->url_encode_( chr(127) ), '%7f' );
test_assert_equal( $h->url_encode_( chr(255) ), '%ff' );
test_assert_equal( $h->url_encode_( 'thealmighty$' ), 'thealmighty%24' );
test_assert_equal( $h->url_encode_( 'youcan"me' ), 'youcan%22me' );
test_assert_equal( $h->url_encode_( '{start' ), '%7bstart' );

# http_redirect_ tests

open FILE, ">temp.tmp";
$h->http_redirect_( \*FILE, 'http://www.usethesource.com/' );
close FILE;
open FILE, "<temp.tmp";
my $line = <FILE>;
test_assert_equal( $line, "HTTP/1.0 302 Found$eol" );
$line = <FILE>;
test_assert_equal( $line, "Location: http://www.usethesource.com/$eol" );
$line = <FILE>;
test_assert( defined( $line ) );
test_assert( $line =~ /^$eol$/ );
$line = <FILE>;
test_assert( !defined( $line ) );
close FILE;

# http_error_ tests

open FILE, ">temp.tmp";
$h->http_error_( \*FILE, 404 );
close FILE;
open FILE, "<temp.tmp";
my $line = <FILE>;
test_assert_equal( $line, "HTTP/1.0 404 Error$eol" );
$line = <FILE>;
test_assert( defined( $line ) );
test_assert( $line =~ /^$eol$/ );
$line = <FILE>;
test_assert( !defined( $line ) );
close FILE;

# http_file_ tests

open FILE, ">temp.tmp";
$h->http_file_( \*FILE, 'doesnotexist.fil' );
close FILE;
open FILE, "<temp.tmp";
my $line = <FILE>;
test_assert_equal( $line, "HTTP/1.0 404 Error$eol" );
$line = <FILE>;
test_assert( defined( $line ) );
test_assert( $line =~ /^$eol$/ );
$line = <FILE>;
test_assert( !defined( $line ) );
close FILE;

open FILE, ">send.tmp";
print FILE "somechars\n";
close FILE;

open FILE, ">temp.tmp";
$h->http_file_( \*FILE, 'send.tmp', 'text/plain' );
close FILE;
open FILE, "<temp.tmp";
my $line = <FILE>;
test_assert_equal( $line, "HTTP/1.0 200 OK$eol" );
$line = <FILE>;
test_assert_equal( $line, "Content-Type: text/plain$eol" );

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; # 1 hour
my ( $sec, $min, $hour, $mday, $mon, $year, $wday ) = gmtime( $zulu );
my $expires = sprintf( "%s, %02d %s %04d %02d:%02d:%02d GMT",
                       $day[$wday], $mday, $month[$mon], $year+1900,
                       $hour, 59, 0);
$line = <FILE>;
test_assert_equal( $line, "Expires: $expires$eol" );
$line = <FILE>;
test_assert_equal( $line, "Content-Length: " . ( -s 'send.tmp' ) . "$eol" );
$line = <FILE>;
test_assert( defined( $line ) );
test_assert( $line =~ /^$eol$/ );
$line = <FILE>;
test_assert_equal( $line, "somechars\n" );
$line = <FILE>;
test_assert( !defined( $line ) );
close FILE;

# Test what happens when we fail to open the server socket

my $h2 = new UI::HTTP;

$h2->configuration( $c );
$h2->mq( $mq );
$h2->logger( $l );

$h2->initialize();
$h2->name( 'simple' );
$h2->config_( 'port', 0 );

open (STDERR, ">stdout.tmp");
test_assert( !$h2->start() );
close STDERR;
open TEMP, "<stdout.tmp";
$line = <TEMP>;
$line = <TEMP>;
$line = <TEMP>;
$line = <TEMP>;
test_assert_regexp( $line, "Couldn't start the simple HTTP interface" );
close TEMP;

$h2->stop();

# Fork into a subprocess that keeps calling service() on the HTTP
# module to handle requests and a top level process that sends down
# requests and receives a replies

my $pid = fork();

if ( $pid == 0 ) {

    # CHILD

    $h->{url_handler_} = \&my_handler;

    while ( $h->service() ) {
    }

    exit(0);
} else {

    # PARENT

    $h->forked();

    # Get a valid result

    my $client = IO::Socket::INET->new(
                    Proto    => "tcp",
                    PeerAddr => 'localhost',
                    PeerPort => $port );

    select( undef, undef, undef, 0.1 );

    test_assert( defined( $client ) );
    test_assert( $client->connected );

    print $client "GET / HTTP/1.0$eol" . "Header: Mine$eol" . "~~~~~~: ~~~~~~~$eol$eol";
    select( undef, undef, undef, 0 );
    $line = <$client>;
    test_assert_equal( $line, "HTTP/1.0 / GET  Error$eol" );
    close $client;

    # Get a protocol error

    my $client = IO::Socket::INET->new(
                    Proto    => "tcp",
                    PeerAddr => 'localhost',
                    PeerPort => $port );

    select( undef, undef, undef, 0.1 );

    test_assert( defined( $client ) );
    test_assert( $client->connected );

    print $client "GET / HTTP/2.0$eol$eol";
    select( undef, undef, undef, 0 );
    $line = <$client>;
    test_assert_equal( $line, "HTTP/1.0 500 Error$eol" );
    close $client;

    # Send body data

    my $client = IO::Socket::INET->new(
                    Proto    => "tcp",
                    PeerAddr => 'localhost',
                    PeerPort => $port );

    select( undef, undef, undef, 0.1 );

    test_assert( defined( $client ) );
    test_assert( $client->connected );

    print $client "POST /body HTTP/1.0$eol" . "Content-Length: 12$eol$eol" . "1234567890$eol$eol";
    select( undef, undef, undef, 0 );
    $line = <$client>;
    test_assert_equal( $line, "HTTP/1.0 /body POST 1234567890$eol" );
    close $client;

    # kill child

    my $client = IO::Socket::INET->new(
                    Proto    => "tcp",
                    PeerAddr => 'localhost',
                    PeerPort => $port );

    select( undef, undef, undef, 0.1 );

    test_assert( defined( $client ) );
    test_assert( $client->connected );

    # Get a valid result

    print $client "GET /stop HTTP/1.0$eol$eol";
    select( undef, undef, undef, 0.1 );
    $line = <$client>;
    test_assert_equal( $line, "HTTP/1.0 /stop GET  Error$eol" );
    close $client;

    while ( waitpid( $pid, &WNOHANG ) != $pid ) {
    }

    $h->stop();
}

[popfile-commit] engine/tests TestBayes.tst,1.18,1.19

[<jgr...@us...>]

Update of /cvsroot/popfile/engine/tests
In directory sc8-pr-cvs1:/tmp/cvs-serv16357/tests

Modified Files:
	TestBayes.tst 
Log Message:
Finished test suite for Bayes except for the generation of HTML for the UI which I'll leave until I do the test suite for UI::HTML; have 88% coverage of Classifier::Bayes

Index: TestBayes.tst
===================================================================
RCS file: /cvsroot/popfile/engine/tests/TestBayes.tst,v
retrieving revision 1.18
retrieving revision 1.19
diff -C2 -d -r1.18 -r1.19
*** TestBayes.tst	27 Jul 2003 20:00:31 -0000	1.18
--- TestBayes.tst	27 Jul 2003 21:13:40 -0000	1.19
***************
*** 446,450 ****
  }
  
! # glob the tests directory for files called TestMailParse\d+.msg which consist of messages 
  # to be sent through classify_and_modify
  
--- 446,450 ----
  }
  
! # glob the tests directory for files called TestMailParse\d+.msg which consist of messages
  # to be sent through classify_and_modify
  
***************
*** 664,667 ****
--- 664,751 ----
  close MAIL;
  close TEMP;
+ 
+ # test quarantining of a message
+ 
+ $b->global_config_( 'msgdir', 'messages/' );
+ $b->set_bucket_parameter( 'spam', 'quarantine', 1 );
+ 
+ open CLIENT, ">temp.tmp";
+ open MAIL, "<messages/one.msg";
+ my ( $class, $nopath ) = $b->classify_and_modify( \*MAIL, \*CLIENT, 0, 0, 0, '', 1 );
+ close CLIENT;
+ close MAIL;
+ 
+ test_assert_equal( $class, 'spam' );
+ test_assert( -e 'messages/popfile0=0.msg' );
+ test_assert( -e 'messages/popfile0=0.cls' );
+ 
+ my ( $reclassified, $bucket, $usedtobe, $magnet ) = $b->history_read_class( 'popfile0=0.msg' );
+ test_assert( !$reclassified );
+ test_assert_equal( $bucket, 'spam' );
+ test_assert( !defined( $usedtobe ) );
+ test_assert_equal( $magnet, '' );
+ 
+ my @lookfor = ( '--popfile0=0.msg', 'Quarantined Message Detail', ' This is the body', '--popfile0=0.msg', '--popfile0=0.msg--', '.' );
+ open CLIENT, "<temp.tmp";
+ while ( $#lookfor > -1 ) {
+     test_assert( !eof( CLIENT ) );
+     my $search = shift @lookfor;
+     while ( <CLIENT> ) {
+         if ( /^\Q$search\E/ ) {
+             last;
+         }
+     }
+ }
+ close CLIENT;
+ 
+ # test no save option
+ 
+ unlink( 'messages/popfile0=0.cls' );
+ unlink( 'messages/popfile0=0.msg' );
+ open CLIENT, ">temp.tmp";
+ open MAIL, "<messages/one.msg";
+ my ( $class, $nopath ) = $b->classify_and_modify( \*MAIL, \*CLIENT, 0, 0, 1, '', 1 );
+ close CLIENT;
+ close MAIL;
+ 
+ test_assert_equal( $class, 'spam' );
+ test_assert( !( -e 'messages/popfile0=0.msg' ) );
+ test_assert( !( -e 'messages/popfile0=0.cls' ) );
+ 
+ # test no echo option
+ 
+ open CLIENT, ">temp.tmp";
+ open MAIL, "<messages/one.msg";
+ my ( $class, $nopath ) = $b->classify_and_modify( \*MAIL, \*CLIENT, 0, 0, 0, '', 0 );
+ close CLIENT;
+ close MAIL;
+ 
+ test_assert_equal( $class, 'spam' );
+ test_assert( -e 'messages/popfile0=0.msg' );
+ test_assert( -e 'messages/popfile0=0.cls' );
+ 
+ test_assert_equal( ( -s 'temp.tmp' ), 0 );
+ 
+ # test option where we know the classification
+ 
+ open CLIENT, ">temp.tmp";
+ open MAIL, "<messages/one.msg";
+ my ( $class, $nopath ) = $b->classify_and_modify( \*MAIL, \*CLIENT, 0, 0, 0, 'other', 1 );
+ close CLIENT;
+ close MAIL;
+ 
+ test_assert_equal( $class, 'other' );
+ test_assert( -e 'messages/popfile0=0.msg' );
+ test_assert( -e 'messages/popfile0=0.cls' );
+ 
+ my ( $reclassified, $bucket, $usedtobe, $magnet ) = $b->history_read_class( 'popfile0=0.msg' );
+ test_assert( !$reclassified );
+ test_assert_equal( $bucket, 'other' );
+ test_assert( !defined( $usedtobe ) );
+ test_assert_equal( $magnet, '' );
+ 
+ # Test X-POPFile-TimeoutPrevention header insertion
+ 
+ # TODO
  
  # TODO test that stop writes the parameters to disk

[popfile-commit] engine/Classifier Bayes.pm,1.176,1.177

[<jgr...@us...>]

Update of /cvsroot/popfile/engine/Classifier
In directory sc8-pr-cvs1:/tmp/cvs-serv16357/Classifier

Modified Files:
	Bayes.pm 
Log Message:
Finished test suite for Bayes except for the generation of HTML for the UI which I'll leave until I do the test suite for UI::HTML; have 88% coverage of Classifier::Bayes

Index: Bayes.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Classifier/Bayes.pm,v
retrieving revision 1.176
retrieving revision 1.177
diff -C2 -d -r1.176 -r1.177
*** Bayes.pm	27 Jul 2003 20:00:30 -0000	1.176
--- Bayes.pm	27 Jul 2003 21:13:40 -0000	1.177
***************
*** 1177,1182 ****
                  if ( $self->global_config_( 'subject' ) ) {
                      # Don't add the classification unless it is not present
!                     if ( !( $msg_subject =~ /\[\Q$classification\E\]/ ) &&
!                          ( $self->{parameters__}{$classification}{subject} == 1 ) ) {
                          $msg_subject = " $modification$msg_subject";
                      }
--- 1177,1182 ----
                  if ( $self->global_config_( 'subject' ) ) {
                      # Don't add the classification unless it is not present
!                     if ( !( $msg_subject =~ /\[\Q$classification\E\]/ ) &&             # PROFILE BLOCK START
!                          ( $self->{parameters__}{$classification}{subject} == 1 ) ) {  # PROFILE BLOCK STOP
                          $msg_subject = " $modification$msg_subject";
                      }

[popfile-commit] engine/tests/corpus.base/spam params,1.1,1.2

[<jgr...@us...>]

Update of /cvsroot/popfile/engine/tests/corpus.base/spam
In directory sc8-pr-cvs1:/tmp/cvs-serv16357/tests/corpus/spam

Modified Files:
	params 
Log Message:
Finished test suite for Bayes except for the generation of HTML for the UI which I'll leave until I do the test suite for UI::HTML; have 88% coverage of Classifier::Bayes

Index: params
===================================================================
RCS file: /cvsroot/popfile/engine/tests/corpus.base/spam/params,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** params	27 Jul 2003 18:28:56 -0000	1.1
--- params	27 Jul 2003 21:13:40 -0000	1.2
***************
*** 1,3 ****
  count 0
  subject 1
! quarantine 0
--- 1,3 ----
  count 0
  subject 1
! quarantine 1

[popfile-commit] engine/tests/corpus.base/personal magnets,1.2,1.3

[<jgr...@us...>]

Update of /cvsroot/popfile/engine/tests/corpus.base/personal
In directory sc8-pr-cvs1:/tmp/cvs-serv2089/tests/corpus/personal

Modified Files:
	magnets 
Log Message:
Tests for echo_to_dot_

Index: magnets
===================================================================
RCS file: /cvsroot/popfile/engine/tests/corpus.base/personal/magnets,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** magnets	27 Jul 2003 19:07:20 -0000	1.2
--- magnets	27 Jul 2003 20:00:31 -0000	1.3
***************
*** 2,4 ****
  to ba...@ba...
  from foo
! oldstyle
--- 2,4 ----
  to ba...@ba...
  from foo
! from oldstyle

[popfile-commit] engine/tests TestBayes.tst,1.17,1.18

[<jgr...@us...>]

Update of /cvsroot/popfile/engine/tests
In directory sc8-pr-cvs1:/tmp/cvs-serv2089/tests

Modified Files:
	TestBayes.tst 
Log Message:
Tests for echo_to_dot_

Index: TestBayes.tst
===================================================================
RCS file: /cvsroot/popfile/engine/tests/TestBayes.tst,v
retrieving revision 1.17
retrieving revision 1.18
diff -C2 -d -r1.17 -r1.18
*** TestBayes.tst	27 Jul 2003 19:07:20 -0000	1.17
--- TestBayes.tst	27 Jul 2003 20:00:31 -0000	1.18
***************
*** 551,554 ****
--- 551,668 ----
  test_assert( !defined( $magnet ) );
  
+ # echo_to_dot_
+ 
+ open FILE, ">messages/one.msg";
+ print FILE "From: test\@test.com\n";
+ print FILE "Subject: Your attention please\n\n";
+ print FILE "This is the body\n.\n";
+ close FILE;
+ 
+ # Four possibilities for echo_to_dot_ depending on whether we give
+ # it a client handle, a file handle, both or neither
+ 
+ # neither
+ 
+ open MAIL, "<messages/one.msg";
+ $b->echo_to_dot_( \*MAIL );
+ test_assert( eof( MAIL ) );
+ close MAIL;
+ 
+ # to a handle
+ 
+ open TEMP, ">temp.tmp";
+ open MAIL, "<messages/one.msg";
+ $b->echo_to_dot_( \*MAIL, \*TEMP );
+ test_assert( eof( MAIL ) );
+ close MAIL;
+ close TEMP;
+ 
+ open TEMP, "<temp.tmp";
+ open MAIL, "<messages/one.msg";
+ while ( !eof( MAIL ) && !eof( TEMP ) ) {
+     my $temp = <TEMP>;
+     my $mail = <MAIL>;
+     test_assert_regexp( $temp, $mail );
+ }
+ test_assert( eof( MAIL ) );
+ test_assert( eof( TEMP ) );
+ close MAIL;
+ close TEMP;
+ 
+ # to a file (no dot)
+ 
+ open TEMP, ">temp.tmp";
+ open MAIL, "<messages/one.msg";
+ $b->echo_to_dot_( \*MAIL, undef, \*TEMP );
+ test_assert( eof( MAIL ) );
+ close MAIL;
+ close TEMP;
+ 
+ open TEMP, "<temp.tmp";
+ open MAIL, "<messages/one.msg";
+ while ( !eof( MAIL ) && !eof( TEMP ) ) {
+     my $temp = <TEMP>;
+     my $mail = <MAIL>;
+     last if ( $mail =~ /^./ );
+     test_assert_regexp( $temp, $mail );
+ }
+ test_assert( !eof( MAIL ) );
+ test_assert( eof( TEMP ) );
+ close MAIL;
+ close TEMP;
+ 
+ # both
+ 
+ open TEMP, ">temp.tmp";
+ open TEMP2, ">temp2.tmp";
+ open MAIL, "<messages/one.msg";
+ $b->echo_to_dot_( \*MAIL, \*TEMP2, \*TEMP );
+ test_assert( eof( MAIL ) );
+ close MAIL;
+ close TEMP;
+ 
+ open TEMP, "<temp.tmp";
+ open TEMP2, "<temp2.tmp";
+ open MAIL, "<messages/one.msg";
+ while ( !eof( MAIL ) && !eof( TEMP ) && !eof( TEMP2 ) ) {
+     my $temp = <TEMP>;
+     my $temp2 = <TEMP>;
+     my $mail = <MAIL>;
+     test_assert_regexp( $temp2, $mail );
+     last if ( $mail =~ /^./ );
+     test_assert_regexp( $temp, $mail );
+ }
+ test_assert( !eof( MAIL ) );
+ test_assert( eof( TEMP ) );
+ test_assert( !eof( TEMP2 ) );
+ close MAIL;
+ close TEMP;
+ close TEMP2;
+ 
+ # to a file (no dot) with before string
+ 
+ open TEMP, ">temp.tmp";
+ open MAIL, "<messages/one.msg";
+ $b->echo_to_dot_( \*MAIL, undef, \*TEMP, "before\n" );
+ test_assert( eof( MAIL ) );
+ close MAIL;
+ close TEMP;
+ 
+ open TEMP, "<temp.tmp";
+ open MAIL, "<messages/one.msg";
+ while ( !eof( MAIL ) && !eof( TEMP ) ) {
+     my $temp = <TEMP>;
+     my $mail = <MAIL>;
+     if ( $mail =~ /^./ ) {
+         test_assert_regexp( $temp, 'before' );
+         last;
+     }
+     test_assert_regexp( $temp, $mail );
+ }
+ test_assert( !eof( MAIL ) );
+ test_assert( eof( TEMP ) );
+ close MAIL;
+ close TEMP;
+ 
  # TODO test that stop writes the parameters to disk
  

[popfile-commit] engine/Classifier Bayes.pm,1.175,1.176

[<jgr...@us...>]

Update of /cvsroot/popfile/engine/Classifier
In directory sc8-pr-cvs1:/tmp/cvs-serv2089/Classifier

Modified Files:
	Bayes.pm 
Log Message:
Tests for echo_to_dot_

Index: Bayes.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Classifier/Bayes.pm,v
retrieving revision 1.175
retrieving revision 1.176
diff -C2 -d -r1.175 -r1.176
*** Bayes.pm	27 Jul 2003 19:07:20 -0000	1.175
--- Bayes.pm	27 Jul 2003 20:00:30 -0000	1.176
***************
*** 1135,1141 ****
          if ( $self->global_config_( 'subject' ) ) {
              # Don't add the classification unless it is not present
!             if ( !( $msg_subject =~ /\Q$modification\E/ ) &&
                   ( $self->{parameters__}{$classification}{subject} == 1 ) &&
!                  ( $self->{parameters__}{$classification}{quarantine} == 0 ) )  {
                  $msg_subject = " $modification$msg_subject";
              }
--- 1135,1141 ----
          if ( $self->global_config_( 'subject' ) ) {
              # Don't add the classification unless it is not present
!             if ( !( $msg_subject =~ /\Q$modification\E/ ) &&                        # PROFILE BLOCK START
                   ( $self->{parameters__}{$classification}{subject} == 1 ) &&
!                  ( $self->{parameters__}{$classification}{quarantine} == 0 ) )  {   # PROFILE BLOCK STOP
                  $msg_subject = " $modification$msg_subject";
              }
***************
*** 1147,1152 ****
  
      # Add the XTC header
!     $msg_head_after .= "X-Text-Classification: $classification$eol" if ( ( $self->global_config_( 'xtc' ) ) &&
!                                                                          ( $self->{parameters__}{$classification}{quarantine} == 0 ) );
  
      # Add the XPL header
--- 1147,1152 ----
  
      # Add the XTC header
!     $msg_head_after .= "X-Text-Classification: $classification$eol" if ( ( $self->global_config_( 'xtc' ) ) && # PROFILE BLOCK START
!                                                                          ( $self->{parameters__}{$classification}{quarantine} == 0 ) ); # PROFILE BLOCK STOP
  
      # Add the XPL header
***************
*** 1692,1701 ****
  #
  # $mail     The stream (created with IO::) to send the message to (the remote mail server)
! # $client   The local mail client (created with IO::) that needs the response
! # $file     a file to print the response to
! # $before   Optional string to send to client before the dot is sent
  #
  # echo all information from the $mail server until a single line with a . is seen
! # Also echoes the line with . to $client but not to $file
  #
  # ---------------------------------------------------------------------------------------------
--- 1692,1702 ----
  #
  # $mail     The stream (created with IO::) to send the message to (the remote mail server)
! # $client   (optional) The local mail client (created with IO::) that needs the response
! # $file     (optional) A file to print the response to
! # $before   (optional) String to send to client before the dot is sent
  #
  # echo all information from the $mail server until a single line with a . is seen
! #
! # NOTE Also echoes the line with . to $client but not to $file
  #
  # ---------------------------------------------------------------------------------------------
***************
*** 1704,1795 ****
      my ( $self, $mail, $client, $file, $before ) = @_;
  
!     # These if statements are repetitive to keep the inner loops efficient
! 
!     if ( defined($file) && defined($client) ) {
!         # echo to file and stream
! 
!         open FILE, $file;
!         while ( <$mail> ) {
!             # Check for an abort
!             last if ( $self->{alive_} == 0 );
! 
!             # The termination has to be a single line with exactly a dot on it and nothing
!             # else other than line termination characters.  This is vital so that we do
!             # not mistake a line beginning with . as the end of the block
! 
!             if ( /^\.(\r\n|\r|\n)$/ ) {
!                 if ( $before ne '' ) {
!                     print $client $before;
!                     print FILE    $before;
!                 }
! 
!                 print $client $_;
! 
!                 last;
!             }
! 
!             print $client $_;
!             print FILE    $_;
! 
!         }
!         close FILE;
!     } elsif (defined($client)) {
!         # Echo only to stream
  
!         while ( <$mail> ) {
!             # Check for an abort
!             last if ( $self->{alive_} == 0 );
  
!             # The termination has to be a single line with exactly a dot on it and nothing
!             # else other than line termination characters.  This is vital so that we do
!             # not mistake a line beginning with . as the end of the block
  
!             if ( /^\.(\r\n|\r|\n)$/ ) {
!                 if ( $before ne '' ) {
!                     print $client $before;
!                 }
  
!                 print $client $_;
  
!                 last;
              }
  
!             print $client $_;
!         }
!     } elsif (defined($file)) {
!         # Echo only to file
! 
!         open FILE, $file;
!         while ( <$mail> ) {
!             # Check for an abort
!             last if ( $self->{alive_} == 0 );
! 
!             # The termination has to be a single line with exactly a dot on it and nothing
!             # else other than line termination characters.  This is vital so that we do
!             # not mistake a line beginning with . as the end of the block
! 
!             if ( /^\.(\r\n|\r|\n)$/ ) {
!                 if ( $before ne '' ) {
!                         print FILE $before;
!                 }
!                 last;
!             }
  
!             print FILE $_;
          }
-         close FILE;
-     } else {
-         # consume without echoing
  
!         while ( <$mail> ) {
!             # Check for an abort
!             last if ( $self->{alive_} == 0 );
  
-             # The termination has to be a single line with exactly a dot on it and nothing
-             # else other than line termination characters.  This is vital so that we do
-             # not mistake a line beginning with . as the end of the block
-             last if ( /^\.(\r\n|\r|\n)$/ );
-         }
      }
  }
  
--- 1705,1740 ----
      my ( $self, $mail, $client, $file, $before ) = @_;
  
!     open FILE, ">>$file" if ( defined( $file ) );
  
!     while ( <$mail> ) {
  
!         # Check for an abort
  
!         last if ( $self->{alive_} == 0 );
  
!         # The termination has to be a single line with exactly a dot on it and nothing
!         # else other than line termination characters.  This is vital so that we do
!         # not mistake a line beginning with . as the end of the block
  
!         if ( /^\.(\r\n|\r|\n)$/ ) {
!             if ( defined( $before ) && ( $before ne '' ) ) {
!                 print $client $before if ( defined( $client ) );
!                 print FILE    $before if ( defined( $file ) );
              }
  
!             # Note that there is no print FILE here.  This is correct because we
!             # to no want the network terminator . to appear in the file version
!             # of any message
  
!             print $client $_ if ( defined( $client ) );
!             last;
          }
  
!         print $client $_ if ( defined( $client ) );
!         print FILE    $_ if ( defined( $file ) );
  
      }
+ 
+     close FILE if ( defined( $file ) );
  }
  

[popfile-commit] engine/UI HTML.pm,1.186,1.187

[<jgr...@us...>]

Update of /cvsroot/popfile/engine/UI
In directory sc8-pr-cvs1:/tmp/cvs-serv23853/UI

Modified Files:
	HTML.pm 
Log Message:
More tests for Bayes covering the reading and writing of history class files and other miscellanea

Index: HTML.pm
===================================================================
RCS file: /cvsroot/popfile/engine/UI/HTML.pm,v
retrieving revision 1.186
retrieving revision 1.187
diff -C2 -d -r1.186 -r1.187
*** HTML.pm	27 Jul 2003 15:42:42 -0000	1.186
--- HTML.pm	27 Jul 2003 19:07:20 -0000	1.187
***************
*** 2588,2595 ****
      my ( $self, $file, $index ) = @_;
  
!     # Find the class information for this file using the history_load_class helper
      # function, and then parse the MSG file for the From and Subject information
  
!     my ( $reclassified, $bucket, $usedtobe, $magnet ) = $self->{classifier__}->history_load_class( $file );
      my $from    = '';
      my $subject = '';
--- 2588,2595 ----
      my ( $self, $file, $index ) = @_;
  
!     # Find the class information for this file using the history_read_class helper
      # function, and then parse the MSG file for the From and Subject information
  
!     my ( $reclassified, $bucket, $usedtobe, $magnet ) = $self->{classifier__}->history_read_class( $file );
      my $from    = '';
      my $subject = '';
***************
*** 2841,2845 ****
              # Get the current classification for this message
  
!             my ( $reclassified, $bucket, $usedtobe, $magnet) = $self->{classifier__}->history_load_class( $mail_file );
  
              # Only reclassify messages that haven't been reclassified before
--- 2841,2845 ----
              # Get the current classification for this message
  
!             my ( $reclassified, $bucket, $usedtobe, $magnet) = $self->{classifier__}->history_read_class( $mail_file );
  
              # Only reclassify messages that haven't been reclassified before
***************
*** 2913,2917 ****
              # Load the class file
  
!             my ( $reclassified, $bucket, $usedtobe, $magnet ) = $self->{classifier__}->history_load_class( $mail_file );
  
              # Only undo if the message has been classified...
--- 2913,2917 ----
              # Load the class file
  
!             my ( $reclassified, $bucket, $usedtobe, $magnet ) = $self->{classifier__}->history_read_class( $mail_file );
  
              # Only undo if the message has been classified...
***************
*** 3757,3761 ****
          mkdir( $path );
  
!         my ($reclassified, $bucket, $usedtobe, $magnet) = $self->{classifier__}->history_load_class( $mail_file );
  
          if ( ( $bucket ne 'unclassified' ) && ( $bucket ne 'unknown class' ) ) {
--- 3757,3761 ----
          mkdir( $path );
  
!         my ($reclassified, $bucket, $usedtobe, $magnet) = $self->{classifier__}->history_read_class( $mail_file );
  
          if ( ( $bucket ne 'unclassified' ) && ( $bucket ne 'unknown class' ) ) {

[popfile-commit] engine/tests TestBayes.tst,1.16,1.17

[<jgr...@us...>]

Update of /cvsroot/popfile/engine/tests
In directory sc8-pr-cvs1:/tmp/cvs-serv23853/tests

Modified Files:
	TestBayes.tst 
Log Message:
More tests for Bayes covering the reading and writing of history class files and other miscellanea

Index: TestBayes.tst
===================================================================
RCS file: /cvsroot/popfile/engine/tests/TestBayes.tst,v
retrieving revision 1.16
retrieving revision 1.17
diff -C2 -d -r1.16 -r1.17
*** TestBayes.tst	27 Jul 2003 18:26:14 -0000	1.16
--- TestBayes.tst	27 Jul 2003 19:07:20 -0000	1.17
***************
*** 45,48 ****
--- 45,58 ----
  test_assert( $b->start() );
  
+ # Test the unclassifier_probability parameter
+ 
+ test_assert_equal( $b->{unclassified__}, log(0.5) );
+ $b->config_( 'unclassified_probability', 0.42 );
+ test_assert( $b->start() );
+ test_assert_equal( $b->{unclassified__}, log(0.42) );
+ $b->config_( 'unclassified_probability', 0.5 );
+ test_assert( $b->start() );
+ test_assert_equal( $b->{unclassified__}, log(0.5) );
+ 
  # test the API functions
  
***************
*** 284,287 ****
--- 294,316 ----
  close FILE;
  
+ open STDERR, ">temp.tmp";
+ test_assert( !$b->load_bucket_( 'zeotrope' ) );
+ close STDERR;
+ open FILE, "<temp.tmp";
+ $line = <FILE>;
+ test_assert_regexp( $line, 'Incompatible corpus version in zeotrope' );
+ close FILE;
+ 
+ open FILE, ">corpus/zeotrope/table";
+ close FILE;
+ 
+ open STDERR, ">temp.tmp";
+ test_assert( !$b->load_bucket_( 'zeotrope' ) );
+ close STDERR;
+ open FILE, "<temp.tmp";
+ $line = <FILE>;
+ test_assert( !defined( $line ) );
+ close FILE;
+ 
  # create_magnet
  
***************
*** 345,348 ****
--- 374,384 ----
  test_assert_equal( $mags[0], 'personal' );
  
+ # send a message through the mq
+ 
+ test_assert_equal( $b->get_bucket_parameter( 'zeotrope', 'count' ), 0 );
+ $b->mq_post_( 'CLASS', 'zeotrope' );
+ $mq->service();
+ test_assert_equal( $b->get_bucket_parameter( 'zeotrope', 'count' ), 1 );
+ 
  # clear_bucket
  
***************
*** 351,358 ****
  test_assert_equal( $b->get_bucket_word_count('zeotrope'), 0 );
  
  # clear_magnets
  
  $b->clear_magnets();
! test_assert_equal( $b->magnet_count(), 4 );
  @mags = $b->get_buckets_with_magnets();
  test_assert_equal( $#mags, -1 );
--- 387,401 ----
  test_assert_equal( $b->get_bucket_word_count('zeotrope'), 0 );
  
+ # classify a message using a magnet
+ 
+ $b->create_magnet( 'zeotrope', 'from', 'cxc...@ya...' );
+ test_assert_equal( $b->classify( 'TestMailParse021.msg' ), 'zeotrope' );
+ test_assert_equal( $b->{magnet_detail__}, 'from: cxc...@ya...' );
+ test_assert( $b->{magnet_used__} );
+ 
  # clear_magnets
  
  $b->clear_magnets();
! test_assert_equal( $b->magnet_count(), 0 );
  @mags = $b->get_buckets_with_magnets();
  test_assert_equal( $#mags, -1 );
***************
*** 374,383 ****
--- 417,429 ----
  
  test_assert_equal( $b->get_value_( 'personal', 'foo' ), log(1/103) );
+ test_assert_equal( $b->get_sort_value_( 'personal', 'foo' ), log(1/103) );
  $b->{total__}{personal} = 100;
  $b->set_value_( 'personal', 'foo', 100 );
  test_assert_equal( $b->get_value_( 'personal', 'foo' ), 0 );
+ test_assert_equal( $b->get_sort_value_( 'personal', 'foo' ), $b->{not_likely__} );
  $b->{total__}{personal} = 1000;
  $b->set_value_( 'personal', 'foo', 100 );
  test_assert_equal( $b->get_value_( 'personal', 'foo' ), -log(10) );
+ test_assert_equal( $b->get_sort_value_( 'personal', 'foo' ), -log(10) );
  
  # glob the tests directory for files called TestMailParse\d+.msg which consist of messages
***************
*** 474,479 ****
  test_assert_equal( $stopwords[1], 'andnotthat' );
  
  # TODO test that stop writes the parameters to disk
  
  $b->stop();
- 
--- 520,555 ----
  test_assert_equal( $stopwords[1], 'andnotthat' );
  
+ # Test history class file reading and writing
+ 
+ unlink( 'messages/*' );
+ 
+ $b->history_write_class( 'one.msg', 0, 'zeotrope' );
+ my ( $reclassified, $bucket, $usedtobe, $magnet ) = $b->history_read_class( 'one.msg' );
+ test_assert( !$reclassified );
+ test_assert_equal( $bucket, 'zeotrope' );
+ test_assert( !defined( $usedtobe ) );
+ test_assert_equal( $magnet, '' );
+ 
+ $b->history_write_class( 'one.msg', 1, 'zeotrope', 'spam' );
+ my ( $reclassified, $bucket, $usedtobe, $magnet ) = $b->history_read_class( 'one.msg' );
+ test_assert( $reclassified );
+ test_assert_equal( $bucket, 'zeotrope' );
+ test_assert_equal( $usedtobe, 'spam' );
+ test_assert_equal( $magnet, '' );
+ 
+ $b->history_write_class( 'one.msg', 0, 'zeotrope', undef, 'from: margit' );
+ my ( $reclassified, $bucket, $usedtobe, $magnet ) = $b->history_read_class( 'one.msg' );
+ test_assert( !$reclassified );
+ test_assert_equal( $bucket, 'zeotrope' );
+ test_assert( !defined( $usedtobe ) );
+ test_assert_equal( $magnet, 'from: margit' );
+ 
+ my ( $reclassified, $bucket, $usedtobe, $magnet ) = $b->history_read_class( 'two.msg' );
+ test_assert( !defined( $reclassified ) );
+ test_assert( !defined( $bucket ) );
+ test_assert( !defined( $usedtobe ) );
+ test_assert( !defined( $magnet ) );
+ 
  # TODO test that stop writes the parameters to disk
  
  $b->stop();