Menu
▾
▴
popfile-commit — CVS commit list messages
You can subscribe to this list here.
| 2003 |
Jan
|
Feb
(160) |
Mar
(119) |
Apr
(111) |
May
(118) |
Jun
(101) |
Jul
(304) |
Aug
(113) |
Sep
(140) |
Oct
(137) |
Nov
(87) |
Dec
(122) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2004 |
Jan
(78) |
Feb
(125) |
Mar
(131) |
Apr
(59) |
May
(121) |
Jun
(166) |
Jul
(150) |
Aug
(137) |
Sep
(73) |
Oct
(58) |
Nov
(27) |
Dec
(60) |
| 2005 |
Jan
(131) |
Feb
(84) |
Mar
(36) |
Apr
(8) |
May
(28) |
Jun
(20) |
Jul
(10) |
Aug
(72) |
Sep
(76) |
Oct
(34) |
Nov
(3) |
Dec
(29) |
| 2006 |
Jan
(13) |
Feb
(92) |
Mar
(7) |
Apr
(1) |
May
(1) |
Jun
(2) |
Jul
(4) |
Aug
(17) |
Sep
(5) |
Oct
(2) |
Nov
(8) |
Dec
(12) |
| 2007 |
Jan
(28) |
Feb
(15) |
Mar
|
Apr
|
May
(8) |
Jun
(4) |
Jul
(5) |
Aug
(8) |
Sep
(20) |
Oct
(38) |
Nov
(65) |
Dec
(92) |
| 2008 |
Jan
(21) |
Feb
(56) |
Mar
(27) |
Apr
(174) |
May
(25) |
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
|
From: <jgr...@us...> - 2003-11-12 18:58:21
|
Update of /cvsroot/popfile/engine/Classifier
In directory sc8-pr-cvs1:/tmp/cvs-serv11038/Classifier
Modified Files:
Bayes.pm
Log Message:
Fix a couple tests in TestBayes that stops them from writing files outside the tests/ directory
Index: Bayes.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Classifier/Bayes.pm,v
retrieving revision 1.224
retrieving revision 1.225
diff -C2 -d -r1.224 -r1.225
*** Bayes.pm 11 Nov 2003 04:33:43 -0000 1.224
--- Bayes.pm 12 Nov 2003 18:58:16 -0000 1.225
***************
*** 1286,1291 ****
$filename =~ s/msg$/cls/;
! open CLASS, '>' . $self->get_user_path_( $self->global_config_( 'msgdir' ) . $filename );
if ( defined( $magnet ) && ( $magnet ne '' ) ) {
--- 1286,1292 ----
$filename =~ s/msg$/cls/;
+ $filename = $self->get_user_path_( $self->global_config_( 'msgdir' ) . $filename );
! open CLASS, ">$filename";
if ( defined( $magnet ) && ( $magnet ne '' ) ) {
|
|
From: <jgr...@us...> - 2003-11-12 03:47:34
|
Update of /cvsroot/popfile/engine/POPFile
In directory sc8-pr-cvs1:/tmp/cvs-serv12511/POPFile
Modified Files:
Configuration.pm
Log Message:
When setting a parameter via the command line call the parameter method to ensure that the dirty bit is set on the config and that command-line changes get saved to disk
Index: Configuration.pm
===================================================================
RCS file: /cvsroot/popfile/engine/POPFile/Configuration.pm,v
retrieving revision 1.33
retrieving revision 1.34
diff -C2 -d -r1.33 -r1.34
*** Configuration.pm 10 Nov 2003 21:09:28 -0000 1.33
--- Configuration.pm 12 Nov 2003 03:47:09 -0000 1.34
***************
*** 382,386 ****
if ( defined($self->{configuration_parameters__}{$parameter}) ) {
if ( $i < $#options ) {
! $self->{configuration_parameters__}{$parameter} = $options[$i+1];
$i += 2;
} else {
--- 382,386 ----
if ( defined($self->{configuration_parameters__}{$parameter}) ) {
if ( $i < $#options ) {
! $self->parameter( $parameter, $options[$i+1] );
$i += 2;
} else {
|
|
From: <jgr...@us...> - 2003-11-11 04:33:48
|
Update of /cvsroot/popfile/engine/Classifier
In directory sc8-pr-cvs1:/tmp/cvs-serv1908/Classifier
Modified Files:
Bayes.pm
Log Message:
Enable BerkeleyDB locking subsystem and fix small bug to do with the color table
Index: Bayes.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Classifier/Bayes.pm,v
retrieving revision 1.223
retrieving revision 1.224
diff -C2 -d -r1.223 -r1.224
*** Bayes.pm 10 Nov 2003 20:15:15 -0000 1.223
--- Bayes.pm 11 Nov 2003 04:33:43 -0000 1.224
***************
*** 542,546 ****
}
! $c = ($c+1) % $#{$self->{possible_colors__}};
}
--- 542,546 ----
}
! $c = ($c+1) % ($#{$self->{possible_colors__}}+1);
}
***************
*** 582,586 ****
-Cachesize => $self->config_( 'db_cache_size' ),
-Filename => $self->get_user_path_( $self->config_( 'corpus' ) . "/$bucket/table.db" ),
! -Flags => DB_CREATE; # PROFILE BLOCK STOP
# Check to see if the tie worked, if it failed then POPFile is about to fail
--- 582,586 ----
-Cachesize => $self->config_( 'db_cache_size' ),
-Filename => $self->get_user_path_( $self->config_( 'corpus' ) . "/$bucket/table.db" ),
! -Flags => DB_CREATE | DB_INIT_LOCK; # PROFILE BLOCK STOP
# Check to see if the tie worked, if it failed then POPFile is about to fail
|
|
From: <jgr...@us...> - 2003-11-10 21:09:32
|
Update of /cvsroot/popfile/engine/tests In directory sc8-pr-cvs1:/tmp/cvs-serv18062/tests Modified Files: TestBayes.tst TestMailParse.tst TestProxy.tst Log Message: Fix test suite failures Index: TestBayes.tst =================================================================== RCS file: /cvsroot/popfile/engine/tests/TestBayes.tst,v retrieving revision 1.35 retrieving revision 1.36 diff -C2 -d -r1.35 -r1.36 *** TestBayes.tst 10 Nov 2003 19:55:36 -0000 1.35 --- TestBayes.tst 10 Nov 2003 21:09:28 -0000 1.36 *************** *** 50,53 **** --- 50,55 ---- $c->logger( $l ); + $c->initialize(); + $l->configuration( $c ); $l->mq( $mq ); Index: TestMailParse.tst =================================================================== RCS file: /cvsroot/popfile/engine/tests/TestMailParse.tst,v retrieving revision 1.24 retrieving revision 1.25 diff -C2 -d -r1.24 -r1.25 *** TestMailParse.tst 10 Nov 2003 19:55:36 -0000 1.24 --- TestMailParse.tst 10 Nov 2003 21:09:29 -0000 1.25 *************** *** 48,51 **** --- 48,53 ---- $c->logger( $l ); + $c->initialize(); + $l->configuration( $c ); $l->mq( $mq ); Index: TestProxy.tst =================================================================== RCS file: /cvsroot/popfile/engine/tests/TestProxy.tst,v retrieving revision 1.17 retrieving revision 1.18 diff -C2 -d -r1.17 -r1.18 *** TestProxy.tst 10 Nov 2003 20:15:24 -0000 1.17 --- TestProxy.tst 10 Nov 2003 21:09:29 -0000 1.18 *************** *** 97,100 **** --- 97,102 ---- $p->logger( $l ); + $p->initialize(); + test_assert_equal( $p->config_( 'enabled' ), 1 ); |
|
From: <jgr...@us...> - 2003-11-10 21:09:32
|
Update of /cvsroot/popfile/engine/POPFile
In directory sc8-pr-cvs1:/tmp/cvs-serv18062/POPFile
Modified Files:
Configuration.pm
Log Message:
Fix test suite failures
Index: Configuration.pm
===================================================================
RCS file: /cvsroot/popfile/engine/POPFile/Configuration.pm,v
retrieving revision 1.32
retrieving revision 1.33
diff -C2 -d -r1.32 -r1.33
*** Configuration.pm 10 Nov 2003 20:55:35 -0000 1.32
--- Configuration.pm 10 Nov 2003 21:09:28 -0000 1.33
***************
*** 162,166 ****
# may be running, warn the user and terminate
! $self->{pid_file__} = $self->get_user_path_( $self->config_( 'piddir' ) . 'popfile.pid' );
if (defined($self->live_check_())) {
--- 162,166 ----
# may be running, warn the user and terminate
! $self->{pid_file__} = $self->get_user_path( $self->config_( 'piddir' ) . 'popfile.pid' );
if (defined($self->live_check_())) {
***************
*** 493,497 ****
my ( $self ) = @_;
! if ( open CONFIG, '<' . $self->get_user_path_( 'popfile.cfg' ) ) {
while ( <CONFIG> ) {
s/(\015|\012)//g;
--- 493,497 ----
my ( $self ) = @_;
! if ( open CONFIG, '<' . $self->get_user_path( 'popfile.cfg' ) ) {
while ( <CONFIG> ) {
s/(\015|\012)//g;
***************
*** 527,531 ****
}
! if ( open CONFIG, '>' . $self->get_user_path_( 'popfile.cfg' ) ) {
$self->{save_needed__} = 0;
--- 527,531 ----
}
! if ( open CONFIG, '>' . $self->get_user_path( 'popfile.cfg' ) ) {
$self->{save_needed__} = 0;
***************
*** 575,579 ****
my ( $self, $left, $right ) = @_;
! if ( ( $right =~ /^\// ) || ( $right =~ /^[A-Z]:\/\\/ ) ) {
return $right;
}
--- 575,579 ----
my ( $self, $left, $right ) = @_;
! if ( ( $right =~ /^\// ) || ( $right =~ /^[A-Z]:[\/\\]/ ) ) {
return $right;
}
|
|
From: <jgr...@us...> - 2003-11-10 20:55:39
|
Update of /cvsroot/popfile/engine/POPFile
In directory sc8-pr-cvs1:/tmp/cvs-serv15149/POPFile
Modified Files:
Configuration.pm
Log Message:
./ defaults for POPFILE_ROOT and POPFILE_USER
Index: Configuration.pm
===================================================================
RCS file: /cvsroot/popfile/engine/POPFile/Configuration.pm,v
retrieving revision 1.31
retrieving revision 1.32
diff -C2 -d -r1.31 -r1.32
*** Configuration.pm 10 Nov 2003 20:48:16 -0000 1.31
--- Configuration.pm 10 Nov 2003 20:55:35 -0000 1.32
***************
*** 97,100 ****
--- 97,108 ----
$self->{popfile_user__} = $ENV{POPFILE_USER};
+ if ( !defined( $self->{popfile_root__} ) ) {
+ $self->{popfile_root__} = './';
+ }
+
+ if ( !defined( $self->{popfile_user__} ) ) {
+ $self->{popfile_user__} = './';
+ }
+
# This is the location where we store the PID of POPFile in a file
# called popfile.pid
|
|
From: <jgr...@us...> - 2003-11-10 20:51:41
|
Update of /cvsroot/popfile/engine/tests In directory sc8-pr-cvs1:/tmp/cvs-serv14382/tests Modified Files: Makefile Log Message: Spell my own name... Index: Makefile =================================================================== RCS file: /cvsroot/popfile/engine/tests/Makefile,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** Makefile 31 Jul 2003 16:32:22 -0000 1.5 --- Makefile 10 Nov 2003 20:51:38 -0000 1.6 *************** *** 4,8 **** # and for testing # ! # Copyright (c) 2003 John Graham-Cummin # # This file is part of POPFile --- 4,8 ---- # and for testing # ! # Copyright (c) 2003 John Graham-Cumming # # This file is part of POPFile |
|
From: <jgr...@us...> - 2003-11-10 20:51:41
|
Update of /cvsroot/popfile/engine In directory sc8-pr-cvs1:/tmp/cvs-serv14382 Modified Files: stopwords Log Message: Spell my own name... Index: stopwords =================================================================== RCS file: /cvsroot/popfile/engine/stopwords,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** stopwords 28 Oct 2003 19:39:48 -0000 1.8 --- stopwords 10 Nov 2003 20:51:37 -0000 1.9 *************** *** 1,194 **** ! you ! strike ! date ! form ! textflow ! him ! pdt ! code ! also ! acronym ! pst ! valign ! subject ! cgi ! charset ! est ! nbsp ! sun ! your ! title ! but ! and ! multicol ! small ! xmp ! https ! area ! author ! all ! being ! dir ! jan ! she ! color ! have ! will ! received ! going ! serif ! htm ! edt ! height ! mbox ! can ! iframe ! dfn ! com ! were ! would ! off ! img ! etc ! noframes ! http ! bgsound ! jun ! sup ! gmt ! address ! basefont ! abbrev ! head ! tbody ! fri ! may ! ask ! aug ! overlay ! www ! div ! status ! doing ! tue ! person ! mon ! cellspacing ! his ! helo ! select ! esmtp ! alt ! wbr ! message ! border ! note ! big ! thu ! yes ! feb ! input ! table ! has ! not ! that ! meta ! isindex ! gone ! map ! our ! tfoot ! caption ! its ! encoding ! out ! base ! lang ! align ! strong ! marquee ! edu ! applet ! span ! nov ! with ! spacer ! width ! smtp ! goes ! did ! inc ! range ! wed ! frame ! dec ! advanced ! localhost ! body ! nobr ! html ! bgcolor ! from ! var ! oct ! her ! banner ! del ! blockquote ! math ! any ! path ! spot ! cdt ! textarea ! embed ! the ! done ! yet ! it's ! net ! font ! thead ! blink ! plaintext ! went ! could ! does ! param ! this ! jul ! org ! mar ! src ! mailto ! for ! cst ! kbd ! listing ! ltd ! pre ! are ! having ! center ! helvetica ! samp ! col ! tab ! been ! fig ! mail ! cite ! had ! link ! script ! menu ! colgroup ! sans ! return ! ins ! sep ! sub ! was ! sat ! frameset ! apr --- 1,195 ---- ! gone ! smtp ! status ! plaintext ! applet ! edu ! oct ! it's ! embed ! helvetica ! param ! map ! cdt ! tue ! height ! you ! strike ! our ! del ! going ! received ! esmtp ! ltd ! width ! not ! person ! nov ! thead ! head ! marquee ! she ! message ! pdt ! com ! fri ! are ! return ! yet ! his ! from ! blink ! samp ! kbd ! mail ! note ! sub ! has ! frame ! spot ! jul ! may ! alt ! cite ! center ! nbsp ! subject ! dir ! address ! the ! basefont ! doing ! caption ! being ! frameset ! xmp ! form ! mailto ! date ! went ! www ! big ! sup ! jun ! path ! listing ! align ! org ! will ! link ! serif ! var ! cellspacing ! could ! isindex ! goes ! input ! and ! inc ! script ! pre ! that ! meta ! anotherbigword ! title ! nobr ! sat ! select ! span ! dfn ! encoding ! mon ! blockquote ! gmt ! strong ! est ! jan ! for ! cgi ! did ! apr ! been ! have ! base ! math ! had ! bgcolor ! fig ! any ! author ! having ! feb ! dec ! html ! sep ! this ! valign ! off ! with ! thu ! net ! range ! would ! can ! color ! but ! font ! was ! menu ! abbrev ! table ! sun ! tbody ! ask ! https ! wed ! tfoot ! localhost ! charset ! lang ! body ! wbr ! textarea ! http ! col ! spacer ! iframe ! img ! acronym ! src ! helo ! him ! colgroup ! div ! done ! advanced ! out ! pst ! aug ! your ! small ! tab ! yes ! noframes ! its ! mar ! ins ! multicol ! etc ! also ! code ! does ! area ! banner ! her ! were ! all ! edt ! cst ! textflow ! overlay ! bgsound ! sans ! border ! mbox ! htm |
|
From: <jgr...@us...> - 2003-11-10 20:48:20
|
Update of /cvsroot/popfile/engine/UI
In directory sc8-pr-cvs1:/tmp/cvs-serv13702/UI
Modified Files:
XMLRPC.pm
Log Message:
Multi-user Phase #1
-------------------
Make POPFile work relative to two special environment variables:
POPFILE_ROOT The location where popfile.pl is installed
POPFILE_USER The location where this user's config is kept
POPFile/Module.pm:
Add two methods
get_root_path_
get_user_path_
that convert passed in relative paths to absolute paths relative
to either POPFILE_ROOT or POPFILE_USER. This two helpers simply
call the relevant public interface in POPFile/Configuration.pm.
POPFile/Configuration.pm:
Add two methods
get_root_path
get_user_path
that convert passed in relative paths to absolute paths relative
to either POPFILE_ROOT or POPFILE_USER.
Classifer/WordMangle.pm:
Make this a PLM (with name 'wordmangle') so that it can get access
to the POPFILE_USER variable so that stopwords are per user.
Classifier/Bayes.pm:
Remove unused Classifier::WordMangle object.
Change all path usage to call get_user_path_ to set the path
correctly relative to the current user.
UI/HTML.pm:
Change path usage to call get_root_path_ or get_user_path_ to get
the path relative to the current root or user. The root is used to
access skins, manual and language files. Everything else is in the
user directory.
POPFile/Module.pm:
Use the POPFILE_ROOT to control the loading of modules.
popfile.pl:
If POPFILE_ROOT is defined the add it to @INC so that we can load
the POPFile::Loader module.
tests/TestWordMangle.tst:
Since Classifier::WordMangle is now a PLM the tests need to be
updated to load the mangler correctly and link it in with the
other POPFile modules that is depends on.
tests/TestPOP3.tst
tests/TestMailParse.tst
tests/TestBayes.tst:
Since Classifier::WordMangle is now a PLM test suites that relied
upon Classifier::MailParse creating the mangler needed updating to
actually create and pass in the mangler object.
tests/TestHTTP.tst:
Make tests work on non-Windows systems. One test was relying on
\n being \r\n.
TODO
Write tests for get_user_path and get_root_path, is_absolute_path,
root_path and path_join
Write tests for POPFILE_ROOT and POPFILE_USER
Make HTML test suite run on Linux
Debug MailParse test suite, fix Japanese handling (026).
Debug POP3 suite/TOP handling
Index: XMLRPC.pm
===================================================================
RCS file: /cvsroot/popfile/engine/UI/XMLRPC.pm,v
retrieving revision 1.9
retrieving revision 1.10
diff -C2 -d -r1.9 -r1.10
*** XMLRPC.pm 10 Nov 2003 20:15:21 -0000 1.9
--- XMLRPC.pm 10 Nov 2003 20:48:17 -0000 1.10
***************
*** 42,47 ****
use IO::Select;
- require XMLRPC::Transport::HTTP;
-
my $eol = "\015\012";
--- 42,45 ----
***************
*** 76,80 ****
# By default we are disabled
! $self->config_( 'disabled', 1 );
# XML-RPC is available on port 8081 initially
--- 74,78 ----
# By default we are disabled
! $self->config_( 'enabled', 0 );
# XML-RPC is available on port 8081 initially
***************
*** 103,106 ****
--- 101,106 ----
return 2;
}
+
+ require XMLRPC::Transport::HTTP;
# Tell the user interface module that we having a configuration
|
|
From: <jgr...@us...> - 2003-11-10 20:48:20
|
Update of /cvsroot/popfile/engine/POPFile
In directory sc8-pr-cvs1:/tmp/cvs-serv13702/POPFile
Modified Files:
Configuration.pm Module.pm
Log Message:
Multi-user Phase #1
-------------------
Make POPFile work relative to two special environment variables:
POPFILE_ROOT The location where popfile.pl is installed
POPFILE_USER The location where this user's config is kept
POPFile/Module.pm:
Add two methods
get_root_path_
get_user_path_
that convert passed in relative paths to absolute paths relative
to either POPFILE_ROOT or POPFILE_USER. This two helpers simply
call the relevant public interface in POPFile/Configuration.pm.
POPFile/Configuration.pm:
Add two methods
get_root_path
get_user_path
that convert passed in relative paths to absolute paths relative
to either POPFILE_ROOT or POPFILE_USER.
Classifer/WordMangle.pm:
Make this a PLM (with name 'wordmangle') so that it can get access
to the POPFILE_USER variable so that stopwords are per user.
Classifier/Bayes.pm:
Remove unused Classifier::WordMangle object.
Change all path usage to call get_user_path_ to set the path
correctly relative to the current user.
UI/HTML.pm:
Change path usage to call get_root_path_ or get_user_path_ to get
the path relative to the current root or user. The root is used to
access skins, manual and language files. Everything else is in the
user directory.
POPFile/Module.pm:
Use the POPFILE_ROOT to control the loading of modules.
popfile.pl:
If POPFILE_ROOT is defined the add it to @INC so that we can load
the POPFile::Loader module.
tests/TestWordMangle.tst:
Since Classifier::WordMangle is now a PLM the tests need to be
updated to load the mangler correctly and link it in with the
other POPFile modules that is depends on.
tests/TestPOP3.tst
tests/TestMailParse.tst
tests/TestBayes.tst:
Since Classifier::WordMangle is now a PLM test suites that relied
upon Classifier::MailParse creating the mangler needed updating to
actually create and pass in the mangler object.
tests/TestHTTP.tst:
Make tests work on non-Windows systems. One test was relying on
\n being \r\n.
TODO
Write tests for get_user_path and get_root_path, is_absolute_path,
root_path and path_join
Write tests for POPFILE_ROOT and POPFILE_USER
Make HTML test suite run on Linux
Debug MailParse test suite, fix Japanese handling (026).
Debug POP3 suite/TOP handling
Index: Configuration.pm
===================================================================
RCS file: /cvsroot/popfile/engine/POPFile/Configuration.pm,v
retrieving revision 1.30
retrieving revision 1.31
diff -C2 -d -r1.30 -r1.31
*** Configuration.pm 10 Nov 2003 20:15:15 -0000 1.30
--- Configuration.pm 10 Nov 2003 20:48:16 -0000 1.31
***************
*** 71,74 ****
--- 71,79 ----
$self->{save_needed__} = 0;
+ # Local copies of POPFILE_ROOT and POPFILE_USER
+
+ $self->{popfile_root__} = '';
+ $self->{popfile_user__} = '';
+
bless $self, $type;
***************
*** 89,92 ****
--- 94,100 ----
my ( $self ) = @_;
+ $self->{popfile_root__} = $ENV{POPFILE_ROOT};
+ $self->{popfile_user__} = $ENV{POPFILE_USER};
+
# This is the location where we store the PID of POPFile in a file
# called popfile.pid
***************
*** 146,150 ****
# may be running, warn the user and terminate
! $self->{pid_file__} = $self->config_( 'piddir' ) . 'popfile.pid';
if (defined($self->live_check_())) {
--- 154,158 ----
# may be running, warn the user and terminate
! $self->{pid_file__} = $self->get_user_path_( $self->config_( 'piddir' ) . 'popfile.pid' );
if (defined($self->live_check_())) {
***************
*** 477,481 ****
my ( $self ) = @_;
! if ( open CONFIG, "<popfile.cfg" ) {
while ( <CONFIG> ) {
s/(\015|\012)//g;
--- 485,489 ----
my ( $self ) = @_;
! if ( open CONFIG, '<' . $self->get_user_path_( 'popfile.cfg' ) ) {
while ( <CONFIG> ) {
s/(\015|\012)//g;
***************
*** 511,515 ****
}
! if ( open CONFIG, ">popfile.cfg" ) {
$self->{save_needed__} = 0;
--- 519,523 ----
}
! if ( open CONFIG, '>' . $self->get_user_path_( 'popfile.cfg' ) ) {
$self->{save_needed__} = 0;
***************
*** 520,523 ****
--- 528,578 ----
close CONFIG;
}
+ }
+
+ # ---------------------------------------------------------------------------------------------
+ #
+ # get_user_path, get_root_path
+ #
+ # Resolve a path relative to POPFILE_USER or POPFILE_ROOT
+ #
+ # $path The path to resolve
+ #
+ # ---------------------------------------------------------------------------------------------
+ sub get_user_path
+ {
+ my ( $self, $path ) = @_;
+
+ return $self->path_join__( $self->{popfile_user__}, $path );
+ }
+
+ sub get_root_path
+ {
+ my ( $self, $path ) = @_;
+
+ return $self->path_join__( $self->{popfile_root__}, $path );
+ }
+
+ # ---------------------------------------------------------------------------------------------
+ #
+ # path_join__
+ #
+ # Join two paths togther
+ #
+ # $left The LHS
+ # $right The RHS
+ #
+ # ---------------------------------------------------------------------------------------------
+ sub path_join__
+ {
+ my ( $self, $left, $right ) = @_;
+
+ if ( ( $right =~ /^\// ) || ( $right =~ /^[A-Z]:\/\\/ ) ) {
+ return $right;
+ }
+
+ $left =~ s/\/$//;
+ $right =~ s/^\///;
+
+ return "$left/$right";
}
Index: Module.pm
===================================================================
RCS file: /cvsroot/popfile/engine/POPFile/Module.pm,v
retrieving revision 1.14
retrieving revision 1.15
diff -C2 -d -r1.14 -r1.15
*** Module.pm 10 Nov 2003 20:15:16 -0000 1.14
--- Module.pm 10 Nov 2003 20:48:17 -0000 1.15
***************
*** 424,427 ****
--- 424,450 ----
}
+ # ---------------------------------------------------------------------------------------------
+ #
+ # get_user_path_, get_root_path_
+ #
+ # Wrappers for POPFile::Configuration get_user_path and get_root_path
+ #
+ # $path The path to modify
+ #
+ # ---------------------------------------------------------------------------------------------
+ sub get_user_path_
+ {
+ my ( $self, $path ) = @_;
+
+ return $self->{configuration__}->get_user_path( $path );
+ }
+
+ sub get_root_path_
+ {
+ my ( $self, $path ) = @_;
+
+ return $self->{configuration__}->get_root_path( $path );
+ }
+
# GETTER/SETTER methods. Note that I do not expect documentation of these unless they
# are non-trivial since the documentation would be a waste of space
|
|
From: <jgr...@us...> - 2003-11-10 20:48:20
|
Update of /cvsroot/popfile/engine/Classifier
In directory sc8-pr-cvs1:/tmp/cvs-serv13702/Classifier
Modified Files:
MailParse.pm
Log Message:
Multi-user Phase #1
-------------------
Make POPFile work relative to two special environment variables:
POPFILE_ROOT The location where popfile.pl is installed
POPFILE_USER The location where this user's config is kept
POPFile/Module.pm:
Add two methods
get_root_path_
get_user_path_
that convert passed in relative paths to absolute paths relative
to either POPFILE_ROOT or POPFILE_USER. This two helpers simply
call the relevant public interface in POPFile/Configuration.pm.
POPFile/Configuration.pm:
Add two methods
get_root_path
get_user_path
that convert passed in relative paths to absolute paths relative
to either POPFILE_ROOT or POPFILE_USER.
Classifer/WordMangle.pm:
Make this a PLM (with name 'wordmangle') so that it can get access
to the POPFILE_USER variable so that stopwords are per user.
Classifier/Bayes.pm:
Remove unused Classifier::WordMangle object.
Change all path usage to call get_user_path_ to set the path
correctly relative to the current user.
UI/HTML.pm:
Change path usage to call get_root_path_ or get_user_path_ to get
the path relative to the current root or user. The root is used to
access skins, manual and language files. Everything else is in the
user directory.
POPFile/Module.pm:
Use the POPFILE_ROOT to control the loading of modules.
popfile.pl:
If POPFILE_ROOT is defined the add it to @INC so that we can load
the POPFile::Loader module.
tests/TestWordMangle.tst:
Since Classifier::WordMangle is now a PLM the tests need to be
updated to load the mangler correctly and link it in with the
other POPFile modules that is depends on.
tests/TestPOP3.tst
tests/TestMailParse.tst
tests/TestBayes.tst:
Since Classifier::WordMangle is now a PLM test suites that relied
upon Classifier::MailParse creating the mangler needed updating to
actually create and pass in the mangler object.
tests/TestHTTP.tst:
Make tests work on non-Windows systems. One test was relying on
\n being \r\n.
TODO
Write tests for get_user_path and get_root_path, is_absolute_path,
root_path and path_join
Write tests for POPFILE_ROOT and POPFILE_USER
Make HTML test suite run on Linux
Debug MailParse test suite, fix Japanese handling (026).
Debug POP3 suite/TOP handling
Index: MailParse.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Classifier/MailParse.pm,v
retrieving revision 1.174
retrieving revision 1.175
diff -C2 -d -r1.174 -r1.175
*** MailParse.pm 31 Oct 2003 16:49:45 -0000 1.174
--- MailParse.pm 10 Nov 2003 20:48:16 -0000 1.175
***************
*** 27,36 ****
use strict;
use locale;
- use Classifier::WordMangle;
use MIME::Base64;
use MIME::QuotedPrint;
-
# Korean characters definition
--- 27,34 ----
***************
*** 124,131 ****
my $self;
- # Used to mangle words into the right shape for classification
-
- $self->{mangle__} = new Classifier::WordMangle;
-
# Hash of word frequences
--- 122,125 ----
***************
*** 1822,1825 ****
--- 1816,1826 ----
return $self->{quickmagnets__};
+ }
+
+ sub mangle
+ {
+ my ( $self, $value ) = @_;
+
+ $self->{mangle__} = $value;
}
|
|
From: <jgr...@us...> - 2003-11-10 20:48:19
|
Update of /cvsroot/popfile/engine
In directory sc8-pr-cvs1:/tmp/cvs-serv13702
Modified Files:
popfile.pl
Log Message:
Multi-user Phase #1
-------------------
Make POPFile work relative to two special environment variables:
POPFILE_ROOT The location where popfile.pl is installed
POPFILE_USER The location where this user's config is kept
POPFile/Module.pm:
Add two methods
get_root_path_
get_user_path_
that convert passed in relative paths to absolute paths relative
to either POPFILE_ROOT or POPFILE_USER. This two helpers simply
call the relevant public interface in POPFile/Configuration.pm.
POPFile/Configuration.pm:
Add two methods
get_root_path
get_user_path
that convert passed in relative paths to absolute paths relative
to either POPFILE_ROOT or POPFILE_USER.
Classifer/WordMangle.pm:
Make this a PLM (with name 'wordmangle') so that it can get access
to the POPFILE_USER variable so that stopwords are per user.
Classifier/Bayes.pm:
Remove unused Classifier::WordMangle object.
Change all path usage to call get_user_path_ to set the path
correctly relative to the current user.
UI/HTML.pm:
Change path usage to call get_root_path_ or get_user_path_ to get
the path relative to the current root or user. The root is used to
access skins, manual and language files. Everything else is in the
user directory.
POPFile/Module.pm:
Use the POPFILE_ROOT to control the loading of modules.
popfile.pl:
If POPFILE_ROOT is defined the add it to @INC so that we can load
the POPFile::Loader module.
tests/TestWordMangle.tst:
Since Classifier::WordMangle is now a PLM the tests need to be
updated to load the mangler correctly and link it in with the
other POPFile modules that is depends on.
tests/TestPOP3.tst
tests/TestMailParse.tst
tests/TestBayes.tst:
Since Classifier::WordMangle is now a PLM test suites that relied
upon Classifier::MailParse creating the mangler needed updating to
actually create and pass in the mangler object.
tests/TestHTTP.tst:
Make tests work on non-Windows systems. One test was relying on
\n being \r\n.
TODO
Write tests for get_user_path and get_root_path, is_absolute_path,
root_path and path_join
Write tests for POPFILE_ROOT and POPFILE_USER
Make HTML test suite run on Linux
Debug MailParse test suite, fix Japanese handling (026).
Debug POP3 suite/TOP handling
Index: popfile.pl
===================================================================
RCS file: /cvsroot/popfile/engine/popfile.pl,v
retrieving revision 1.218
retrieving revision 1.219
diff -C2 -d -r1.218 -r1.219
*** popfile.pl 10 Nov 2003 20:15:13 -0000 1.218
--- popfile.pl 10 Nov 2003 20:48:16 -0000 1.219
***************
*** 33,36 ****
--- 33,38 ----
use locale;
+ use lib $ENV{POPFILE_ROOT};
+
use POPFile::Loader;
|
|
From: <jgr...@us...> - 2003-11-10 20:33:17
|
Update of /cvsroot/popfile/engine/POPFile
In directory sc8-pr-cvs1:/tmp/cvs-serv8191/POPFile
Modified Files:
Loader.pm
Log Message:
Multi-user Phase #1
-------------------
Make POPFile work relative to two special environment variables:
POPFILE_ROOT The location where popfile.pl is installed
POPFILE_USER The location where this user's config is kept
POPFile/Module.pm:
Add two methods
get_root_path_
get_user_path_
that convert passed in relative paths to absolute paths relative
to either POPFILE_ROOT or POPFILE_USER. This two helpers simply
call the relevant public interface in POPFile/Configuration.pm.
POPFile/Configuration.pm:
Add two methods
get_root_path
get_user_path
that convert passed in relative paths to absolute paths relative
to either POPFILE_ROOT or POPFILE_USER.
Classifer/WordMangle.pm:
Make this a PLM (with name 'wordmangle') so that it can get access
to the POPFILE_USER variable so that stopwords are per user.
Classifier/Bayes.pm:
Remove unused Classifier::WordMangle object.
Change all path usage to call get_user_path_ to set the path
correctly relative to the current user.
UI/HTML.pm:
Change path usage to call get_root_path_ or get_user_path_ to get
the path relative to the current root or user. The root is used to
access skins, manual and language files. Everything else is in the
user directory.
POPFile/Module.pm:
Use the POPFILE_ROOT to control the loading of modules.
popfile.pl:
If POPFILE_ROOT is defined the add it to @INC so that we can load
the POPFile::Loader module.
tests/TestWordMangle.tst:
Since Classifier::WordMangle is now a PLM the tests need to be
updated to load the mangler correctly and link it in with the
other POPFile modules that is depends on.
tests/TestPOP3.tst
tests/TestMailParse.tst
tests/TestBayes.tst:
Since Classifier::WordMangle is now a PLM test suites that relied
upon Classifier::MailParse creating the mangler needed updating to
actually create and pass in the mangler object.
tests/TestHTTP.tst:
Make tests work on non-Windows systems. One test was relying on
\n being \r\n.
TODO
Write tests for get_user_path and get_root_path, is_absolute_path,
root_path and path_join
Write tests for POPFILE_ROOT and POPFILE_USER
Make HTML test suite run on Linux
Debug MailParse test suite, fix Japanese handling (026).
Debug POP3 suite/TOP handling
Index: Loader.pm
===================================================================
RCS file: /cvsroot/popfile/engine/POPFile/Loader.pm,v
retrieving revision 1.14
retrieving revision 1.15
diff -C2 -d -r1.14 -r1.15
*** Loader.pm 10 Nov 2003 20:15:15 -0000 1.14
--- Loader.pm 10 Nov 2003 20:33:13 -0000 1.15
***************
*** 51,60 ****
$self->{components__} = {};
- $self->{disabled_components__} = {};
-
- # Do not allow disabling of the following components (group or name)
-
- $self->{required_components__} = qr/^(core|html|bayes)$/;
-
# A handy boolean that tells us whether we are alive or not. When this is set to 1 then the
# proxy works normally, when set to 0 (typically by the aborting() function called from a signal)
--- 51,54 ----
***************
*** 65,69 ****
# This must be 1 for POPFile::Loader to create any output on STDOUT
! $self->{debug__} = 0;
# This stuff lets us do some things in a way that tolerates some window-isms
--- 59,63 ----
# This must be 1 for POPFile::Loader to create any output on STDOUT
! $self->{debug__} = 1;
# This stuff lets us do some things in a way that tolerates some window-isms
***************
*** 91,94 ****
--- 85,92 ----
$self->{version_string__} = '';
+ # Where POPFile is installed
+
+ $self->{popfile_root__} = './';
+
bless $self, $type;
***************
*** 107,110 ****
--- 105,112 ----
my ( $self ) = @_;
+ if ( defined( $ENV{POPFILE_ROOT} ) ) {
+ $self->{popfile_root__} = $ENV{POPFILE_ROOT};
+ }
+
# These anonymous subroutine references allow us to call these important
# functions from anywhere using the reference, granting internal access
***************
*** 120,124 ****
# POPFile version number
! my $version_file = 'POPFile/popfile_version';
if ( -e $version_file ) {
--- 122,126 ----
# POPFile version number
! my $version_file = $self->root_path__( 'POPFile/popfile_version' );
if ( -e $version_file ) {
***************
*** 314,318 ****
# hash getting the name from the module by calling name()
! opendir MODULES, $directory;
while ( my $entry = readdir MODULES ) {
--- 316,320 ----
# hash getting the name from the module by calling name()
! opendir MODULES, $self->root_path__( $directory );
while ( my $entry = readdir MODULES ) {
***************
*** 371,375 ****
my $mod;
! if ( open MODULE, "<$module" ) {
my $first = <MODULE>;
close MODULE;
--- 373,377 ----
my $mod;
! if ( open MODULE, '<' . $self->root_path__( $module ) ) {
my $first = <MODULE>;
close MODULE;
***************
*** 377,381 ****
if ( $first =~ /^# POPFILE LOADABLE MODULE/ ) {
require $module;
!
$module =~ s/\//::/;
$module =~ s/\.pm//;
--- 379,383 ----
if ( $first =~ /^# POPFILE LOADABLE MODULE/ ) {
require $module;
!
$module =~ s/\//::/;
$module =~ s/\.pm//;
***************
*** 509,512 ****
--- 511,520 ----
$self->{components__}{proxy}{$name}->classifier( $self->{components__}{classifier}{bayes} );
}
+
+ # TODO Clean this up so that the Loader doesn't have to know so much about
+ # Bayes.
+
+ $self->{components__}{classifier}{bayes}->{parser__}->mangle(
+ $self->{components__}{classifier}{wordmangle} );
}
***************
*** 611,648 ****
#---------------------------------------------------------------------------------------------
#
- # CORE_enabled_check
- #
- # Prevents calling of start and service of disabled optional modules
- #
- #---------------------------------------------------------------------------------------------
- sub CORE_enabled_check
- {
- my ( $self ) = @_;
-
- # Check all currently enabled components
-
- foreach my $type (keys %{$self->{components__}}) {
- unless ( $type =~ $self->{required_components__} ) {
- foreach my $name (keys %{$self->{components__}{$type}}) {
- unless ( ( $name =~ $self->{required_components__} )
- || ( defined($self->{components__}{$type}{$name}->config_( 'enabled' ) )
- && $self->{components__}{$type}{$name}->config_( 'enabled' ) ) ) {
-
- # If the component is optional and is disabled, move it to a holding
- # hash. This is done this way to allow recovery/re-enabling of objects
- # (eg, HUP) and to leave them intact for interface plugin configuration.
- $self->{disabled_components__}{$type}{$name} = $self->{components__}{$type}{$name};
- delete $self->{components__}{$type}{$name};
- }
- }
- }
- }
-
- # Re-enable any disabled components that are now enabled
- # TODO: implement this when POPFile needs to be able to handle a HUP.
- }
-
- #---------------------------------------------------------------------------------------------
- #
# CORE_service
#
--- 619,622 ----
***************
*** 819,822 ****
--- 793,815 ----
delete($self->{components__}{$type}{$name});
+ }
+
+ # ---------------------------------------------------------------------------------------------
+ #
+ # root_path__
+ #
+ # Joins the path passed in with the POPFile root
+ #
+ # $path RHS of path
+ #
+ # ---------------------------------------------------------------------------------------------
+ sub root_path__
+ {
+ my ( $self, $path ) = @_;
+
+ $self->{popfile_root__} =~ s/[\/\\]$//;
+ $path =~ s/^[\/\\]//;
+
+ return "$self->{popfile_root__}/$path";
}
|
|
From: <jgr...@us...> - 2003-11-10 20:16:25
|
Update of /cvsroot/popfile/engine/POPFile
In directory sc8-pr-cvs1:/tmp/cvs-serv4335/POPFile
Modified Files:
Configuration.pm Loader.pm Module.pm
Log Message:
"Unixification of POPFile"
--------------------------
1. Change command line parsing to use Getopt so that in future
we can have real command line options. In the past an option
was equivalent to a configuration file item. So you could set
module_param value
inside popfile.cfg, but you could also to
popfile.pl -module_param value
on the command line. The new form of the latter is
popfile.pl --set module_param=value
For the ultimate in laziness you can also use the old style
if you precede the first old style parameter with --, e.g.
the old style command line above would work in the new scheme
if specified as follows
popfile.pl -- -module_param value
It is still even possible to use very old style parameters
from pre-OO days of POPFile with the addition of the --
popfile.pl -- -ui_port 8080
2. Make it possible for a module to disable itself and hence be
unloaded. Unloadable modules have an 'enabled' paramter (currently
supported by all proxies (POP3, NNTP and SMTP) and XML-RPC). If
this parameter is 0 then use if to return the value '2' from start()
which indicates to Loader that the module wishes to be removed.
POPFile/Configuration.pm:
Use Getopt to handle new style command line options. Make
parse_command_line return 0 if there's an error.
POPFile/Module.pm:
Update documentation on start().
POPFile/Loader.pm:
Check the return code from start() and if it is 2 unload the module.
Check the return code from parse_command_line so we halt if there's an
error in command-line parsing.
Proxy/Proxy.pm:
Initialize the 'enabled' parameter to 1.
Proxy/POP3.pm
Proxy/SMTP.pm
Proxy/NNTP.pm:
Use the 'enabled' parameter to return 2 from start() so that if we
are not enabled we get unloaded. Also if not enabled don't register
any UI components.
UI/XMLRPC.pm:
Use the 'enabled' parameter to return 2 from start() so that if we
are not enabled we get unloaded. Also if not enabled don't register
any UI components.
Classifier/Bayes.pm:
When classifying a message without saving to disk, still add the
XPL link.
tests.pl:
Code layout clean up.
tests/TestConfiguration.pm:
Update and improve tests for command-line parsing.
tests/TestProxy.pm:
Check for the initial setting of the 'enabled' parameter.
tests/TestPOP3.pm:
Check that the enabled parameter is interpreted by start() to mean
no start and return 2. Make the XTP tests less time sensitive.
Index: Configuration.pm
===================================================================
RCS file: /cvsroot/popfile/engine/POPFile/Configuration.pm,v
retrieving revision 1.29
retrieving revision 1.30
diff -C2 -d -r1.29 -r1.30
*** Configuration.pm 10 Nov 2003 19:55:35 -0000 1.29
--- Configuration.pm 10 Nov 2003 20:15:15 -0000 1.30
***************
*** 36,39 ****
--- 36,41 ----
use locale;
+ use Getopt::Long;
+
#----------------------------------------------------------------------------
# new
***************
*** 69,80 ****
$self->{save_needed__} = 0;
- # The location where POPFile is installed
-
- $self->{popfile_root__} = './';
-
- # Where the current user's configuration is
-
- $self->{popfile_user__} = './';
-
bless $self, $type;
--- 71,74 ----
***************
*** 135,146 ****
$self->global_config_( 'msgdir', 'messages/' );
- # Read the POPFILE_ROOT and POPFILE_USER variables into
- # the local store, set up defaults if they are not defined
-
- my ( $root, $user ) = ( $ENV{POPFILE_ROOT}, $ENV{POPFILE_USER} );
-
- $self->{popfile_root__} = $root if defined( $root );
- $self->{popfile_user__} = $user if defined( $user );
-
return 1;
}
--- 129,132 ----
***************
*** 160,164 ****
# may be running, warn the user and terminate
! $self->{pid_file__} = $self->get_user_path( $self->config_( 'piddir' ) . 'popfile.pid' );
if (defined($self->live_check_())) {
--- 146,150 ----
# may be running, warn the user and terminate
! $self->{pid_file__} = $self->config_( 'piddir' ) . 'popfile.pid';
if (defined($self->live_check_())) {
***************
*** 251,255 ****
}
-
# ---------------------------------------------------------------------------------------------
#
--- 237,240 ----
***************
*** 266,270 ****
}
-
# ---------------------------------------------------------------------------------------------
#
--- 251,254 ----
***************
*** 319,323 ****
}
-
# ---------------------------------------------------------------------------------------------
#
--- 303,306 ----
***************
*** 333,367 ****
my ( $self ) = @_;
! # It's ok for the command line to be blank, the values of configuration will be drawn from
! # the default values defined at the start of the code and those read from the configuration
! # file
! if ( $#ARGV >= 0 ) {
my $i = 0;
! while ( $i <= $#ARGV ) {
# A command line argument must start with a -
! if ( $ARGV[$i] =~ /^-(.+)$/ ) {
my $parameter = $self->upgrade_parameter__($1);
if ( defined($self->{configuration_parameters__}{$parameter}) ) {
! if ( $i < $#ARGV ) {
! $self->{configuration_parameters__}{$parameter} = $ARGV[$i+1];
$i += 2;
} else {
! print STDERR "Missing argument for $ARGV[$i]\n";
! last;
}
} else {
! print STDERR "Unknown command line option $ARGV[$i]\n";
! last;
}
} else {
! print STDERR "Expected a command line option and got $ARGV[$i]\n";
! last;
}
}
}
}
--- 316,387 ----
my ( $self ) = @_;
! # Options from the command line specified with the --set parameter
! my @set_options;
!
! # The following command line options are supported:
! #
! # --set Permanently sets a configuration item for the current user
! # -- Everything after this point is an old style POPFile option
! #
! # So its possible to do
! #
! # --set bayes_param=value --set=-bayes_parem=value --set -bayes_parem=value -- -bayes_parem value
!
! if ( !GetOptions( "set=s" => \@set_options ) ) {
! return 0;
! }
!
! # Join together the options specified with --set and those after the --, the
! # options in @set_options are going to be of the form foo=bar and hence need to
! # be split into foo bar
!
! my @options;
!
! for my $i (0..$#set_options) {
! $set_options[$i] =~ /-?(.+)=(.+)/;
!
! if ( !defined( $1 ) ) {
! print STDERR "\nBad option: $set_options[$i]\n";
! return 0;
! }
!
! push @options, ("-$1");
! if ( defined( $2 ) ) {
! push @options, ($2);
! }
! }
!
! push @options, @ARGV;
!
! if ( $#options >= 0 ) {
my $i = 0;
! while ( $i <= $#options ) {
# A command line argument must start with a -
! if ( $options[$i] =~ /^-(.+)$/ ) {
my $parameter = $self->upgrade_parameter__($1);
if ( defined($self->{configuration_parameters__}{$parameter}) ) {
! if ( $i < $#options ) {
! $self->{configuration_parameters__}{$parameter} = $options[$i+1];
$i += 2;
} else {
! print STDERR "\nMissing argument for $options[$i]\n";
! return 0;
}
} else {
! print STDERR "\nUnknown option $options[$i]\n";
! return 0;
}
} else {
! print STDERR "\nExpected a command line option and got $options[$i]\n";
! return 0;
}
}
}
+
+ return 1;
}
***************
*** 457,461 ****
my ( $self ) = @_;
! if ( open CONFIG, '<' . $self->get_user_path( 'popfile.cfg' ) ) {
while ( <CONFIG> ) {
s/(\015|\012)//g;
--- 477,481 ----
my ( $self ) = @_;
! if ( open CONFIG, "<popfile.cfg" ) {
while ( <CONFIG> ) {
s/(\015|\012)//g;
***************
*** 491,495 ****
}
! if ( open CONFIG, '>' . $self->get_user_path( 'popfile.cfg' ) ) {
$self->{save_needed__} = 0;
--- 511,515 ----
}
! if ( open CONFIG, ">popfile.cfg" ) {
$self->{save_needed__} = 0;
***************
*** 526,630 ****
}
! # ---------------------------------------------------------------------------------------------
! #
! # get_root_path
! #
! # The POPFILE_ROOT environment variable is converted by the configuration
! # module into an internal variable. This method take a relative or absolute
! # path and returns the same path relative to the POPFILE_ROOT. Hence if the
! # passed in path is absolute it simply returns it, if relative then it returns
! # the full path consisting of the concatenation of the POPFILE_ROOT and the
! # passed in path
! #
! # $path The path to convert
! #
! # ---------------------------------------------------------------------------------------------
! sub get_root_path
! {
! my ( $self, $path ) = @_;
!
! if ( $self->is_absolute_path__( $path ) ) {
! return $path;
! } else {
! return $self->path_join__( $self->{popfile_root__}, $path );
! }
! }
!
! # ---------------------------------------------------------------------------------------------
! #
! # get_user_path
! #
! # The POPFILE_USER environment variable is converted by the configuration
! # module into an internal variable. This method take a relative or absolute
! # path and returns the same path relative to the POPFILE_USER. Hence if the
! # passed in path is absolute it simply returns it, if relative then it returns
! # the full path consisting of the concatenation of the POPFILE_USER and the
! # passed in path
! #
! # $path The path to convert
! #
! # ---------------------------------------------------------------------------------------------
! sub get_user_path
! {
! my ( $self, $path ) = @_;
!
! if ( $self->is_absolute_path__( $path ) ) {
! return $path;
! } else {
! return $self->path_join__( $self->{popfile_user__}, $path );
! }
! }
!
! # ---------------------------------------------------------------------------------------------
! #
! # is_absolute_path__
! #
! # Returns 1 is the path is absolute (i.e. start with / or a drive letter followed by /)
! #
! # $path Path to check
! #
! # ---------------------------------------------------------------------------------------------
! sub is_absolute_path__
! {
! my ( $self, $path ) = @_;
!
! if ( $path =~ /^\// ) {
! return 1;
! }
!
! if ( $path =~ /^[A-Z]:[\/\\]/i ) {
! return 1;
! }
!
! return 0;
! }
!
! # ---------------------------------------------------------------------------------------------
! #
! # path_join__
! #
! # Joins two paths together making sure that the appropriate path separator is inserted
! #
! # $left First part of path
! # $right Second part of path
! #
! # ---------------------------------------------------------------------------------------------
! sub path_join__
! {
! my ( $self, $left, $right ) = @_;
!
! $left =~ s/[\/\\]$//;
! $right =~ s/^[\/\\]//;
!
! my $path = "$left/$right";
!
! # Strip any amount of leading ./
!
! $path =~ s/^(\.\/)+//;
!
! return $path;
! }
!
! # GETTER
sub configuration_parameters
--- 546,550 ----
}
! # GETTERS
sub configuration_parameters
***************
*** 636,637 ****
--- 556,558 ----
1;
+
Index: Loader.pm
===================================================================
RCS file: /cvsroot/popfile/engine/POPFile/Loader.pm,v
retrieving revision 1.13
retrieving revision 1.14
diff -C2 -d -r1.13 -r1.14
*** Loader.pm 10 Nov 2003 10:37:27 -0000 1.13
--- Loader.pm 10 Nov 2003 20:15:15 -0000 1.14
***************
*** 531,542 ****
print " $name" if $self->{debug__};
flush STDOUT;
! if ( $self->{components__}{$type}{$name}->initialize() == 0 ) {
die "Failed to start while initializing the $name module";
}
! $self->{components__}{$type}{$name}->alive( 1 );
! $self->{components__}{$type}{$name}->forker( $self->{forker__} );
! $self->{components__}{$type}{$name}->pipeready( $self->{pipeready__} );
}
print '} ' if $self->{debug__};
--- 531,547 ----
print " $name" if $self->{debug__};
flush STDOUT;
!
! my $code = $self->{components__}{$type}{$name}->initialize();
!
! if ( $code == 0 ) {
die "Failed to start while initializing the $name module";
}
! if ( $code == 1 ) {
! $self->{components__}{$type}{$name}->alive( 1 );
! $self->{components__}{$type}{$name}->forker( $self->{forker__} );
! $self->{components__}{$type}{$name}->pipeready( $self->{pipeready__} );
! }
}
print '} ' if $self->{debug__};
***************
*** 560,564 ****
$self->{components__}{core}{config}->load_configuration();
! $self->{components__}{core}{config}->parse_command_line();
}
--- 565,569 ----
$self->{components__}{core}{config}->load_configuration();
! return $self->{components__}{core}{config}->parse_command_line();
}
***************
*** 581,588 ****
print "\n {$type:" if $self->{debug__};
foreach my $name (keys %{$self->{components__}{$type}}) {
! print " $name" if $self->{debug__};
! flush STDOUT;
! if ( $self->{components__}{$type}{$name}->start() == 0 ) {
die "Failed to start while starting the $name module";
}
}
--- 586,603 ----
print "\n {$type:" if $self->{debug__};
foreach my $name (keys %{$self->{components__}{$type}}) {
! my $code = $self->{components__}{$type}{$name}->start();
!
! if ( $code == 0 ) {
die "Failed to start while starting the $name module";
+ }
+
+ # If the module said that it didn't want to be loaded then
+ # unload it.
+
+ if ( $code == 2 ) {
+ delete $self->{components__}{$type}{$name};
+ } else {
+ print " $name" if $self->{debug__};
+ flush STDOUT;
}
}
Index: Module.pm
===================================================================
RCS file: /cvsroot/popfile/engine/POPFile/Module.pm,v
retrieving revision 1.13
retrieving revision 1.14
diff -C2 -d -r1.13 -r1.14
*** Module.pm 10 Nov 2003 19:55:35 -0000 1.13
--- Module.pm 10 Nov 2003 20:15:16 -0000 1.14
***************
*** 74,83 ****
# register_configuration_item_() register a UI configuration item
#
- # get_root_path_() Converts a relative path to an absolute based on the POPFile
- # root path (set through the environment variable POPFILE_ROOT)
- #
- # get_user_path_() Converts a relative path to an absolute based on the POPFile
- # user path (set through the environment variable POPFILE_USER)
- #
# A note on the naming
#
--- 74,77 ----
***************
*** 183,187 ****
#
# The method should return 1 to indicate that it started correctly, if it returns
! # 0 then POPFile will abort loading immediately
#
# ---------------------------------------------------------------------------------------------
--- 177,182 ----
#
# The method should return 1 to indicate that it started correctly, if it returns
! # 0 then POPFile will abort loading immediately, returns 2 if everything OK but this
! # module does not want to continue to be used.
#
# ---------------------------------------------------------------------------------------------
***************
*** 429,474 ****
}
- # ---------------------------------------------------------------------------------------------
- #
- # get_root_path_
- #
- # The POPFILE_ROOT environment variable is converted by the configuration
- # module into an internal variable. This method take a relative or absolute
- # path and returns the same path relative to the POPFILE_ROOT. Hence if the
- # passed in path is absolute it simply returns it, if relative then it returns
- # the full path consisting of the concatenation of the POPFILE_ROOT and the
- # passed in path
- #
- # $path The path to convert
- #
- # ---------------------------------------------------------------------------------------------
- sub get_root_path_
- {
- my ( $self, $path ) = @_;
-
- $self->{configuration__}->get_root_path( $path );
- }
-
- # ---------------------------------------------------------------------------------------------
- #
- # get_user_path_
- #
- # The POPFILE_USER environment variable is converted by the configuration
- # module into an internal variable. This method take a relative or absolute
- # path and returns the same path relative to the POPFILE_USER. Hence if the
- # passed in path is absolute it simply returns it, if relative then it returns
- # the full path consisting of the concatenation of the POPFILE_USER and the
- # passed in path
- #
- # $path The path to convert
- #
- # ---------------------------------------------------------------------------------------------
- sub get_user_path_
- {
- my ( $self, $path ) = @_;
-
- $self->{configuration__}->get_user_path( $path );
- }
-
# GETTER/SETTER methods. Note that I do not expect documentation of these unless they
# are non-trivial since the documentation would be a waste of space
--- 424,427 ----
***************
*** 587,588 ****
--- 540,542 ----
1;
+
|
|
From: <jgr...@us...> - 2003-11-10 20:15:55
|
Update of /cvsroot/popfile/engine/UI
In directory sc8-pr-cvs1:/tmp/cvs-serv4335/UI
Modified Files:
XMLRPC.pm
Log Message:
"Unixification of POPFile"
--------------------------
1. Change command line parsing to use Getopt so that in future
we can have real command line options. In the past an option
was equivalent to a configuration file item. So you could set
module_param value
inside popfile.cfg, but you could also to
popfile.pl -module_param value
on the command line. The new form of the latter is
popfile.pl --set module_param=value
For the ultimate in laziness you can also use the old style
if you precede the first old style parameter with --, e.g.
the old style command line above would work in the new scheme
if specified as follows
popfile.pl -- -module_param value
It is still even possible to use very old style parameters
from pre-OO days of POPFile with the addition of the --
popfile.pl -- -ui_port 8080
2. Make it possible for a module to disable itself and hence be
unloaded. Unloadable modules have an 'enabled' paramter (currently
supported by all proxies (POP3, NNTP and SMTP) and XML-RPC). If
this parameter is 0 then use if to return the value '2' from start()
which indicates to Loader that the module wishes to be removed.
POPFile/Configuration.pm:
Use Getopt to handle new style command line options. Make
parse_command_line return 0 if there's an error.
POPFile/Module.pm:
Update documentation on start().
POPFile/Loader.pm:
Check the return code from start() and if it is 2 unload the module.
Check the return code from parse_command_line so we halt if there's an
error in command-line parsing.
Proxy/Proxy.pm:
Initialize the 'enabled' parameter to 1.
Proxy/POP3.pm
Proxy/SMTP.pm
Proxy/NNTP.pm:
Use the 'enabled' parameter to return 2 from start() so that if we
are not enabled we get unloaded. Also if not enabled don't register
any UI components.
UI/XMLRPC.pm:
Use the 'enabled' parameter to return 2 from start() so that if we
are not enabled we get unloaded. Also if not enabled don't register
any UI components.
Classifier/Bayes.pm:
When classifying a message without saving to disk, still add the
XPL link.
tests.pl:
Code layout clean up.
tests/TestConfiguration.pm:
Update and improve tests for command-line parsing.
tests/TestProxy.pm:
Check for the initial setting of the 'enabled' parameter.
tests/TestPOP3.pm:
Check that the enabled parameter is interpreted by start() to mean
no start and return 2. Make the XTP tests less time sensitive.
Index: XMLRPC.pm
===================================================================
RCS file: /cvsroot/popfile/engine/UI/XMLRPC.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** XMLRPC.pm 10 Nov 2003 10:37:03 -0000 1.8
--- XMLRPC.pm 10 Nov 2003 20:15:21 -0000 1.9
***************
*** 74,80 ****
my ( $self ) = @_;
! # Disabled by default
! $self->config_( 'enabled', 0);
# XML-RPC is available on port 8081 initially
--- 74,80 ----
my ( $self ) = @_;
! # By default we are disabled
! $self->config_( 'disabled', 1 );
# XML-RPC is available on port 8081 initially
***************
*** 86,100 ****
$self->config_( 'local', 1 );
- # Tell the user interface module that we having a configuration
- # item that needs a UI component
-
- $self->register_configuration_item_( 'configuration', # PROFILE BLOCK START
- 'xmlrpc_port',
- $self ); # PROFILE BLOCK STOP
-
- $self->register_configuration_item_( 'security', # PROFILE BLOCK START
- 'xmlrpc_local',
- $self ); # PROFILE BLOCK STOP
-
return 1;
}
--- 86,89 ----
***************
*** 110,113 ****
--- 99,117 ----
{
my ( $self ) = @_;
+
+ if ( $self->config_( 'enabled' ) == 0 ) {
+ return 2;
+ }
+
+ # Tell the user interface module that we having a configuration
+ # item that needs a UI component
+
+ $self->register_configuration_item_( 'configuration', # PROFILE BLOCK START
+ 'xmlrpc_port',
+ $self ); # PROFILE BLOCK STOP
+
+ $self->register_configuration_item_( 'security', # PROFILE BLOCK START
+ 'xmlrpc_local',
+ $self ); # PROFILE BLOCK STOP
# We use a single XMLRPC::Lite object to handle requests for access to the
|
|
From: <jgr...@us...> - 2003-11-10 20:15:54
|
Update of /cvsroot/popfile/engine/Proxy
In directory sc8-pr-cvs1:/tmp/cvs-serv4335/Proxy
Modified Files:
NNTP.pm POP3.pm Proxy.pm SMTP.pm
Log Message:
"Unixification of POPFile"
--------------------------
1. Change command line parsing to use Getopt so that in future
we can have real command line options. In the past an option
was equivalent to a configuration file item. So you could set
module_param value
inside popfile.cfg, but you could also to
popfile.pl -module_param value
on the command line. The new form of the latter is
popfile.pl --set module_param=value
For the ultimate in laziness you can also use the old style
if you precede the first old style parameter with --, e.g.
the old style command line above would work in the new scheme
if specified as follows
popfile.pl -- -module_param value
It is still even possible to use very old style parameters
from pre-OO days of POPFile with the addition of the --
popfile.pl -- -ui_port 8080
2. Make it possible for a module to disable itself and hence be
unloaded. Unloadable modules have an 'enabled' paramter (currently
supported by all proxies (POP3, NNTP and SMTP) and XML-RPC). If
this parameter is 0 then use if to return the value '2' from start()
which indicates to Loader that the module wishes to be removed.
POPFile/Configuration.pm:
Use Getopt to handle new style command line options. Make
parse_command_line return 0 if there's an error.
POPFile/Module.pm:
Update documentation on start().
POPFile/Loader.pm:
Check the return code from start() and if it is 2 unload the module.
Check the return code from parse_command_line so we halt if there's an
error in command-line parsing.
Proxy/Proxy.pm:
Initialize the 'enabled' parameter to 1.
Proxy/POP3.pm
Proxy/SMTP.pm
Proxy/NNTP.pm:
Use the 'enabled' parameter to return 2 from start() so that if we
are not enabled we get unloaded. Also if not enabled don't register
any UI components.
UI/XMLRPC.pm:
Use the 'enabled' parameter to return 2 from start() so that if we
are not enabled we get unloaded. Also if not enabled don't register
any UI components.
Classifier/Bayes.pm:
When classifying a message without saving to disk, still add the
XPL link.
tests.pl:
Code layout clean up.
tests/TestConfiguration.pm:
Update and improve tests for command-line parsing.
tests/TestProxy.pm:
Check for the initial setting of the 'enabled' parameter.
tests/TestPOP3.pm:
Check that the enabled parameter is interpreted by start() to mean
no start and return 2. Make the XTP tests less time sensitive.
Index: NNTP.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Proxy/NNTP.pm,v
retrieving revision 1.22
retrieving revision 1.23
diff -C2 -d -r1.22 -r1.23
*** NNTP.pm 10 Nov 2003 10:37:56 -0000 1.22
--- NNTP.pm 10 Nov 2003 20:15:17 -0000 1.23
***************
*** 95,98 ****
--- 95,118 ----
$self->config_( 'welcome_string', "NNTP POPFile ($self->{version_}) server ready" );
+ return $self->SUPER::initialize();;
+ }
+
+ # ---------------------------------------------------------------------------------------------
+ #
+ # start
+ #
+ # Called to start the NNTP proxy module
+ #
+ # ---------------------------------------------------------------------------------------------
+ sub start
+ {
+ my ( $self ) = @_;
+
+ # If we are not enabled then no further work happens in this module
+
+ if ( $self->config_( 'enabled' ) == 0 ) {
+ return 2;
+ }
+
# Tell the user interface module that we having a configuration
# item that needs a UI component
***************
*** 114,118 ****
$self );
! return 1;
}
--- 134,138 ----
$self );
! return $self->SUPER::start();;
}
Index: POP3.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Proxy/POP3.pm,v
retrieving revision 1.81
retrieving revision 1.82
diff -C2 -d -r1.81 -r1.82
*** POP3.pm 10 Nov 2003 10:37:58 -0000 1.81
--- POP3.pm 10 Nov 2003 20:15:18 -0000 1.82
***************
*** 98,101 ****
--- 98,119 ----
$self->config_( 'welcome_string', "POP3 POPFile ($self->{version_}) server ready" );
+ return $self->SUPER::initialize();;
+ }
+
+ # ---------------------------------------------------------------------------------------------
+ #
+ # start
+ #
+ # ---------------------------------------------------------------------------------------------
+ sub start
+ {
+ my ( $self ) = @_;
+
+ # If we are not enabled then no further work happens in this module
+
+ if ( $self->config_( 'enabled' ) == 0 ) {
+ return 2;
+ }
+
# Tell the user interface module that we having a configuration
# item that needs a UI component
***************
*** 124,139 ****
'pop3_secure_server_port',
$self ); # PROFILE BLOCK STOP
-
- return 1;
- }
-
- # ---------------------------------------------------------------------------------------------
- #
- # start
- #
- # ---------------------------------------------------------------------------------------------
- sub start
- {
- my ( $self ) = @_;
if ( $self->config_( 'welcome_string' ) =~ /^POP3 POPFile \(v\d+\.\d+\.\d+\) server ready$/ ) {
--- 142,145 ----
Index: Proxy.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Proxy/Proxy.pm,v
retrieving revision 1.38
retrieving revision 1.39
diff -C2 -d -r1.38 -r1.39
*** Proxy.pm 31 Oct 2003 16:17:15 -0000 1.38
--- Proxy.pm 10 Nov 2003 20:15:20 -0000 1.39
***************
*** 93,96 ****
--- 93,113 ----
# ---------------------------------------------------------------------------------------------
#
+ # initialize
+ #
+ # Called to initialize the Proxy, most of this is handled by a subclass of this
+ # but here we set the 'enabled' flag
+ #
+ # ---------------------------------------------------------------------------------------------
+ sub initialize
+ {
+ my ( $self ) = @_;
+
+ $self->config_( 'enabled', 1 );
+
+ return 1;
+ }
+
+ # ---------------------------------------------------------------------------------------------
+ #
# start
#
Index: SMTP.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Proxy/SMTP.pm,v
retrieving revision 1.23
retrieving revision 1.24
diff -C2 -d -r1.23 -r1.24
*** SMTP.pm 10 Nov 2003 10:38:01 -0000 1.23
--- SMTP.pm 10 Nov 2003 20:15:21 -0000 1.24
***************
*** 27,32 ****
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
- # Modified by Sam Schinke (ssc...@us...)
- #
# ---------------------------------------------------------------------------------------------
--- 27,30 ----
***************
*** 73,79 ****
my ( $self ) = @_;
- # Disabled by default
- $self->config_( 'enabled', 0);
-
# By default we don't fork on Windows
$self->config_( 'force_fork', ($^O eq 'MSWin32')?0:1 );
--- 71,74 ----
***************
*** 92,95 ****
--- 87,110 ----
$self->config_( 'welcome_string', "SMTP POPFile ($self->{version_}) welcome" );
+ return $self->SUPER::initialize();;
+ }
+
+ # ---------------------------------------------------------------------------------------------
+ #
+ # start
+ #
+ # Called to start the SMTP proxy module
+ #
+ # ---------------------------------------------------------------------------------------------
+ sub start
+ {
+ my ( $self ) = @_;
+
+ # If we are not enabled then no further work happens in this module
+
+ if ( $self->config_( 'enabled' ) == 0 ) {
+ return 2;
+ }
+
# Tell the user interface module that we having a configuration
# item that needs a UI component
***************
*** 115,119 ****
$self );
! return 1;
}
--- 130,134 ----
$self );
! return $self->SUPER::start();;
}
***************
*** 169,175 ****
next;
}
!
# Handle EHLO specially so we can control what ESMTP extensions are negotiated
!
if ( $command =~ /EHLO/i ) {
if ( $self->config_( 'chain_server' ) ) {
--- 184,190 ----
next;
}
!
# Handle EHLO specially so we can control what ESMTP extensions are negotiated
!
if ( $command =~ /EHLO/i ) {
if ( $self->config_( 'chain_server' ) ) {
***************
*** 182,187 ****
my $unsupported;
!
!
# RFC 1830, http://www.faqs.org/rfcs/rfc1830.html
# CHUNKING and BINARYMIME both require the support of the "BDAT" command
--- 197,202 ----
my $unsupported;
!
!
# RFC 1830, http://www.faqs.org/rfcs/rfc1830.html
# CHUNKING and BINARYMIME both require the support of the "BDAT" command
***************
*** 190,199 ****
$unsupported .= "CHUNKING|BINARYMIME";
!
# append unsupported ESMTP extensions to $unsupported here, important to maintain
# format of OPTION|OPTION2|OPTION3
!
$unsupported = qr/250\-$unsupported/;
!
$self->smtp_echo_response_( $mail, $client, $command, $unsupported );
--- 205,214 ----
$unsupported .= "CHUNKING|BINARYMIME";
!
# append unsupported ESMTP extensions to $unsupported here, important to maintain
# format of OPTION|OPTION2|OPTION3
!
$unsupported = qr/250\-$unsupported/;
!
$self->smtp_echo_response_( $mail, $client, $command, $unsupported );
***************
*** 442,443 ****
--- 457,460 ----
1;
+
+
|
|
From: <jgr...@us...> - 2003-11-10 20:15:49
|
Update of /cvsroot/popfile/engine/Classifier
In directory sc8-pr-cvs1:/tmp/cvs-serv4335/Classifier
Modified Files:
Bayes.pm
Log Message:
"Unixification of POPFile"
--------------------------
1. Change command line parsing to use Getopt so that in future
we can have real command line options. In the past an option
was equivalent to a configuration file item. So you could set
module_param value
inside popfile.cfg, but you could also to
popfile.pl -module_param value
on the command line. The new form of the latter is
popfile.pl --set module_param=value
For the ultimate in laziness you can also use the old style
if you precede the first old style parameter with --, e.g.
the old style command line above would work in the new scheme
if specified as follows
popfile.pl -- -module_param value
It is still even possible to use very old style parameters
from pre-OO days of POPFile with the addition of the --
popfile.pl -- -ui_port 8080
2. Make it possible for a module to disable itself and hence be
unloaded. Unloadable modules have an 'enabled' paramter (currently
supported by all proxies (POP3, NNTP and SMTP) and XML-RPC). If
this parameter is 0 then use if to return the value '2' from start()
which indicates to Loader that the module wishes to be removed.
POPFile/Configuration.pm:
Use Getopt to handle new style command line options. Make
parse_command_line return 0 if there's an error.
POPFile/Module.pm:
Update documentation on start().
POPFile/Loader.pm:
Check the return code from start() and if it is 2 unload the module.
Check the return code from parse_command_line so we halt if there's an
error in command-line parsing.
Proxy/Proxy.pm:
Initialize the 'enabled' parameter to 1.
Proxy/POP3.pm
Proxy/SMTP.pm
Proxy/NNTP.pm:
Use the 'enabled' parameter to return 2 from start() so that if we
are not enabled we get unloaded. Also if not enabled don't register
any UI components.
UI/XMLRPC.pm:
Use the 'enabled' parameter to return 2 from start() so that if we
are not enabled we get unloaded. Also if not enabled don't register
any UI components.
Classifier/Bayes.pm:
When classifying a message without saving to disk, still add the
XPL link.
tests.pl:
Code layout clean up.
tests/TestConfiguration.pm:
Update and improve tests for command-line parsing.
tests/TestProxy.pm:
Check for the initial setting of the 'enabled' parameter.
tests/TestPOP3.pm:
Check that the enabled parameter is interpreted by start() to mean
no start and return 2. Make the XTP tests less time sensitive.
Index: Bayes.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Classifier/Bayes.pm,v
retrieving revision 1.222
retrieving revision 1.223
diff -C2 -d -r1.222 -r1.223
*** Bayes.pm 10 Nov 2003 19:55:35 -0000 1.222
--- Bayes.pm 10 Nov 2003 20:15:15 -0000 1.223
***************
*** 1591,1595 ****
$xpl .= ":" . $self->module_config_( 'html', 'port' ) . "/jump_to_message?view=$nopath_temp_file$crlf";
! if ( $self->global_config_( 'xpl' ) && ( $self->{parameters__}{$classification}{quarantine} == 0 ) && ( !$nosave ) ) {
$msg_head_after .= 'X-POPFile-Link: ' . $xpl;
}
--- 1591,1595 ----
$xpl .= ":" . $self->module_config_( 'html', 'port' ) . "/jump_to_message?view=$nopath_temp_file$crlf";
! if ( $self->global_config_( 'xpl' ) && ( $self->{parameters__}{$classification}{quarantine} == 0 ) ) {
$msg_head_after .= 'X-POPFile-Link: ' . $xpl;
}
***************
*** 1618,1622 ****
print $client "Subject:$msg_subject$crlf";
print $client "X-Text-Classification: $classification$crlf" if ( $self->global_config_( 'xtc' ) );
! print $client 'X-POPFile-Link: ' . $xpl if ( $self->global_config_( 'xpl' ) && !$nosave );
print $client "MIME-Version: 1.0$crlf";
print $client "Content-Type: multipart/report; boundary=\"$nopath_temp_file\"$crlf$crlf--$nopath_temp_file$crlf";
--- 1618,1622 ----
print $client "Subject:$msg_subject$crlf";
print $client "X-Text-Classification: $classification$crlf" if ( $self->global_config_( 'xtc' ) );
! print $client 'X-POPFile-Link: ' . $xpl if ( $self->global_config_( 'xpl' ) );
print $client "MIME-Version: 1.0$crlf";
print $client "Content-Type: multipart/report; boundary=\"$nopath_temp_file\"$crlf$crlf--$nopath_temp_file$crlf";
***************
*** 1628,1632 ****
print $client "Original Subject: " . $self->{parser__}->get_header('subject') . "$crlf";
print $client "To examine the email open the attachment. ";
! print $client "To change this mail's classification go to $xpl" unless $nosave;
print $client "$crlf";
print $client "The first 20 words found in the email are:$crlf$crlf";
--- 1628,1632 ----
print $client "Original Subject: " . $self->{parser__}->get_header('subject') . "$crlf";
print $client "To examine the email open the attachment. ";
! print $client "To change this mail's classification go to $xpl";
print $client "$crlf";
print $client "The first 20 words found in the email are:$crlf$crlf";
|
|
From: <jgr...@us...> - 2003-11-10 20:15:48
|
Update of /cvsroot/popfile/engine
In directory sc8-pr-cvs1:/tmp/cvs-serv4335
Modified Files:
popfile.pl tests.pl
Log Message:
"Unixification of POPFile"
--------------------------
1. Change command line parsing to use Getopt so that in future
we can have real command line options. In the past an option
was equivalent to a configuration file item. So you could set
module_param value
inside popfile.cfg, but you could also to
popfile.pl -module_param value
on the command line. The new form of the latter is
popfile.pl --set module_param=value
For the ultimate in laziness you can also use the old style
if you precede the first old style parameter with --, e.g.
the old style command line above would work in the new scheme
if specified as follows
popfile.pl -- -module_param value
It is still even possible to use very old style parameters
from pre-OO days of POPFile with the addition of the --
popfile.pl -- -ui_port 8080
2. Make it possible for a module to disable itself and hence be
unloaded. Unloadable modules have an 'enabled' paramter (currently
supported by all proxies (POP3, NNTP and SMTP) and XML-RPC). If
this parameter is 0 then use if to return the value '2' from start()
which indicates to Loader that the module wishes to be removed.
POPFile/Configuration.pm:
Use Getopt to handle new style command line options. Make
parse_command_line return 0 if there's an error.
POPFile/Module.pm:
Update documentation on start().
POPFile/Loader.pm:
Check the return code from start() and if it is 2 unload the module.
Check the return code from parse_command_line so we halt if there's an
error in command-line parsing.
Proxy/Proxy.pm:
Initialize the 'enabled' parameter to 1.
Proxy/POP3.pm
Proxy/SMTP.pm
Proxy/NNTP.pm:
Use the 'enabled' parameter to return 2 from start() so that if we
are not enabled we get unloaded. Also if not enabled don't register
any UI components.
UI/XMLRPC.pm:
Use the 'enabled' parameter to return 2 from start() so that if we
are not enabled we get unloaded. Also if not enabled don't register
any UI components.
Classifier/Bayes.pm:
When classifying a message without saving to disk, still add the
XPL link.
tests.pl:
Code layout clean up.
tests/TestConfiguration.pm:
Update and improve tests for command-line parsing.
tests/TestProxy.pm:
Check for the initial setting of the 'enabled' parameter.
tests/TestPOP3.pm:
Check that the enabled parameter is interpreted by start() to mean
no start and return 2. Make the XTP tests less time sensitive.
Index: popfile.pl
===================================================================
RCS file: /cvsroot/popfile/engine/popfile.pl,v
retrieving revision 1.217
retrieving revision 1.218
diff -C2 -d -r1.217 -r1.218
*** popfile.pl 10 Nov 2003 10:35:34 -0000 1.217
--- popfile.pl 10 Nov 2003 20:15:13 -0000 1.218
***************
*** 58,73 ****
$POPFile->CORE_link_components();
$POPFile->CORE_initialize();
! $POPFile->CORE_config();
! $POPFile->CORE_enabled_check();
! $POPFile->CORE_start();
! # This is the main POPFile loop that services requests, it will exit only when we
! # need to exit
! $POPFile->CORE_service();
! # Shutdown every POPFile module
! $POPFile->CORE_stop();
# END
--- 58,73 ----
$POPFile->CORE_link_components();
$POPFile->CORE_initialize();
! if ( $POPFile->CORE_config() ) {
! $POPFile->CORE_start();
! # This is the main POPFile loop that services requests, it will exit only when we
! # need to exit
! $POPFile->CORE_service();
! # Shutdown every POPFile module
! $POPFile->CORE_stop();
! }
# END
Index: tests.pl
===================================================================
RCS file: /cvsroot/popfile/engine/tests.pl,v
retrieving revision 1.31
retrieving revision 1.32
diff -C2 -d -r1.31 -r1.32
*** tests.pl 13 Oct 2003 20:23:40 -0000 1.31
--- tests.pl 10 Nov 2003 20:15:14 -0000 1.32
***************
*** 52,58 ****
{
my ( $ok, $test, $file, $line, $context ) = @_;
!
$test_count += 1;
!
if ( !$ok ) {
$fail_messages .= "\n $file:$line failed '$test'";
--- 52,58 ----
{
my ( $ok, $test, $file, $line, $context ) = @_;
!
$test_count += 1;
!
if ( !$ok ) {
$fail_messages .= "\n $file:$line failed '$test'";
***************
*** 65,69 ****
# print "Test pass at $file:$line ($context)\n";
}
!
flush STDOUT;
}
--- 65,69 ----
# print "Test pass at $file:$line ($context)\n";
}
!
flush STDOUT;
}
***************
*** 86,90 ****
{
my ( $file, $line, $test, $context ) = @_;
!
test_report( eval( $test ), $test, $file, $line, $context );
}
--- 86,90 ----
{
my ( $file, $line, $test, $context ) = @_;
!
test_report( eval( $test ), $test, $file, $line, $context );
}
***************
*** 109,126 ****
sub test_assert_equal
{
! my ( $file, $line, $test, $expected, $context ) = @_;
! my $result;
! if ( !( $expected =~ /[^0-9]/ ) ) {
!
! # This int() and is so that we don't get bitten by odd
! # floating point problems
! my $scale = 1e10;
! $result = ( int( $test * $scale ) == int( $expected * $scale ) );
! } else {
! $result = ( $test eq $expected );
! }
! test_report( $result, "expecting [$expected] and got [$test]", $file, $line, $context );
}
--- 109,127 ----
sub test_assert_equal
{
! my ( $file, $line, $test, $expected, $context ) = @_;
! my $result;
! if ( !( $expected =~ /[^0-9]/ ) ) {
! # This int() and is so that we don't get bitten by odd
! # floating point problems
!
! my $scale = 1e10;
! $result = ( int( $test * $scale ) == int( $expected * $scale ) );
! } else {
! $result = ( $test eq $expected );
! }
!
! test_report( $result, "expecting [$expected] and got [$test]", $file, $line, $context );
}
|
|
From: <jgr...@us...> - 2003-11-10 20:15:31
|
Update of /cvsroot/popfile/engine/tests
In directory sc8-pr-cvs1:/tmp/cvs-serv4335/tests
Modified Files:
TestConfiguration.tst TestPOP3.tst TestProxy.tst
Log Message:
"Unixification of POPFile"
--------------------------
1. Change command line parsing to use Getopt so that in future
we can have real command line options. In the past an option
was equivalent to a configuration file item. So you could set
module_param value
inside popfile.cfg, but you could also to
popfile.pl -module_param value
on the command line. The new form of the latter is
popfile.pl --set module_param=value
For the ultimate in laziness you can also use the old style
if you precede the first old style parameter with --, e.g.
the old style command line above would work in the new scheme
if specified as follows
popfile.pl -- -module_param value
It is still even possible to use very old style parameters
from pre-OO days of POPFile with the addition of the --
popfile.pl -- -ui_port 8080
2. Make it possible for a module to disable itself and hence be
unloaded. Unloadable modules have an 'enabled' paramter (currently
supported by all proxies (POP3, NNTP and SMTP) and XML-RPC). If
this parameter is 0 then use if to return the value '2' from start()
which indicates to Loader that the module wishes to be removed.
POPFile/Configuration.pm:
Use Getopt to handle new style command line options. Make
parse_command_line return 0 if there's an error.
POPFile/Module.pm:
Update documentation on start().
POPFile/Loader.pm:
Check the return code from start() and if it is 2 unload the module.
Check the return code from parse_command_line so we halt if there's an
error in command-line parsing.
Proxy/Proxy.pm:
Initialize the 'enabled' parameter to 1.
Proxy/POP3.pm
Proxy/SMTP.pm
Proxy/NNTP.pm:
Use the 'enabled' parameter to return 2 from start() so that if we
are not enabled we get unloaded. Also if not enabled don't register
any UI components.
UI/XMLRPC.pm:
Use the 'enabled' parameter to return 2 from start() so that if we
are not enabled we get unloaded. Also if not enabled don't register
any UI components.
Classifier/Bayes.pm:
When classifying a message without saving to disk, still add the
XPL link.
tests.pl:
Code layout clean up.
tests/TestConfiguration.pm:
Update and improve tests for command-line parsing.
tests/TestProxy.pm:
Check for the initial setting of the 'enabled' parameter.
tests/TestPOP3.pm:
Check that the enabled parameter is interpreted by start() to mean
no start and return 2. Make the XTP tests less time sensitive.
Index: TestConfiguration.tst
===================================================================
RCS file: /cvsroot/popfile/engine/tests/TestConfiguration.tst,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** TestConfiguration.tst 8 Sep 2003 18:03:57 -0000 1.8
--- TestConfiguration.tst 10 Nov 2003 20:15:22 -0000 1.9
***************
*** 199,230 ****
# Check command line parsing
! @ARGV = ( '-config_piddir', 'test2/' );
! $c->parse_command_line();
test_assert_equal( $c->module_config_( 'config', 'piddir' ), 'test2/' );
! @ARGV = ( 'config_piddir', 'test3/' );
open (STDERR, ">stdout.tmp");
! $c->parse_command_line();
close STDERR;
open OUTPUT, "<stdout.tmp";
my $line = <OUTPUT>;
close OUTPUT;
! test_assert_regexp( $line, 'Expected a command line option and got config_piddir' );
! test_assert_equal( $c->module_config_( 'config', 'piddir' ), 'test2/' );
! @ARGV = ( '-config_piddir' );
open (STDERR, ">stdout.tmp");
! $c->parse_command_line();
close STDERR;
open OUTPUT, "<stdout.tmp";
my $line = <OUTPUT>;
close OUTPUT;
! test_assert_regexp( $line, 'Missing argument for -config_piddir' );
! test_assert_equal( $c->module_config_( 'config', 'piddir' ), 'test2/' );
! @ARGV = ( '-config_foobar' );
open (STDERR, ">stdout.tmp");
! $c->parse_command_line();
close STDERR;
open OUTPUT, "<stdout.tmp";
my $line = <OUTPUT>;
close OUTPUT;
! test_assert_regexp( $line, 'Unknown command line option -config_foobar' );
--- 199,237 ----
# Check command line parsing
! @ARGV = ( '--set', '-config_piddir=test2/' );
! test_assert( $c->parse_command_line() );
test_assert_equal( $c->module_config_( 'config', 'piddir' ), 'test2/' );
! @ARGV = ( '--set', 'config_piddir=test3/' );
! test_assert( $c->parse_command_line() );
! test_assert_equal( $c->module_config_( 'config', 'piddir' ), 'test3/' );
! @ARGV = ( '--', '-config_piddir' );
open (STDERR, ">stdout.tmp");
! test_assert( !$c->parse_command_line() );
close STDERR;
open OUTPUT, "<stdout.tmp";
+ <OUTPUT>;
my $line = <OUTPUT>;
close OUTPUT;
! test_assert_regexp( $line, 'Missing argument for -config_piddir' );
! test_assert_equal( $c->module_config_( 'config', 'piddir' ), 'test3/' );
! @ARGV = ( '--', '-config_foobar' );
open (STDERR, ">stdout.tmp");
! test_assert( !$c->parse_command_line() );
close STDERR;
open OUTPUT, "<stdout.tmp";
+ <OUTPUT>;
my $line = <OUTPUT>;
close OUTPUT;
! test_assert_regexp( $line, 'Unknown option -config_foobar' );
! @ARGV = ( '--', '-config_piddir', 'test4/' );
! test_assert( $c->parse_command_line() );
! test_assert_equal( $c->module_config_( 'config', 'piddir' ), 'test4/' );
! @ARGV = ( '--doesnotexist', '-config_piddir', 'test4/' );
open (STDERR, ">stdout.tmp");
! test_assert( !$c->parse_command_line() );
close STDERR;
open OUTPUT, "<stdout.tmp";
my $line = <OUTPUT>;
close OUTPUT;
! test_assert_regexp( $line, 'Unknown option: doesnotexist' );
Index: TestPOP3.tst
===================================================================
RCS file: /cvsroot/popfile/engine/tests/TestPOP3.tst,v
retrieving revision 1.17
retrieving revision 1.18
diff -C2 -d -r1.17 -r1.18
*** TestPOP3.tst 10 Nov 2003 19:55:36 -0000 1.17
--- TestPOP3.tst 10 Nov 2003 20:15:24 -0000 1.18
***************
*** 387,391 ****
$p->config_( 'force_fork', 1 );
$p->global_config_( 'timeout', 1 );
! $p->start();
while ( 1 ) {
--- 387,395 ----
$p->config_( 'force_fork', 1 );
$p->global_config_( 'timeout', 1 );
!
! $p->config_( 'enabled', 0 );
! test_assert_equal( $p->start(), 2 );
! $p->config_( 'enabled', 1 );
! test_assert_equal( $p->start(), 1 );
while ( 1 ) {
***************
*** 779,783 ****
$result = <$client>;
$result =~ s/popfile2=8/popfile0=0/;
! test_assert_equal( $result, $line );
if ( $headers == 0 ) {
$countdown -= 1;
--- 783,787 ----
$result = <$client>;
$result =~ s/popfile2=8/popfile0=0/;
! test_assert_equal( $result, $line, "[$result][$line]" );
if ( $headers == 0 ) {
$countdown -= 1;
***************
*** 973,977 ****
while ( <FILE> ) {
my $line = $_;
! $result = <$client>;
$result =~ s/popfile3=1/popfile0=0/;
test_assert_equal( $result, $line );
--- 977,987 ----
while ( <FILE> ) {
my $line = $_;
! while ( $result = <$client> ) {
! if ( $result =~ /TimeoutPrevention/ ) {
! next;
! } else {
! last;
! }
! }
$result =~ s/popfile3=1/popfile0=0/;
test_assert_equal( $result, $line );
Index: TestProxy.tst
===================================================================
RCS file: /cvsroot/popfile/engine/tests/TestProxy.tst,v
retrieving revision 1.16
retrieving revision 1.17
diff -C2 -d -r1.16 -r1.17
*** TestProxy.tst 13 Oct 2003 20:23:41 -0000 1.16
--- TestProxy.tst 10 Nov 2003 20:15:24 -0000 1.17
***************
*** 97,100 ****
--- 97,102 ----
$p->logger( $l );
+ test_assert_equal( $p->config_( 'enabled' ), 1 );
+
# Start a generic proxy on port 9999
my $port = 9000 + int(rand(1000));
|
|
From: <jgr...@us...> - 2003-11-10 19:55:41
|
Update of /cvsroot/popfile/engine/tests
In directory sc8-pr-cvs1:/tmp/cvs-serv311/tests
Modified Files:
TestWordMangle.tst TestPOP3.tst TestMailParse.tst
TestBayes.tst TestHTTP.tst
Log Message:
Multi-user Phase #1
-------------------
Make POPFile work relative to two special environment variables:
POPFILE_ROOT The location where popfile.pl is installed
POPFILE_USER The location where this user's config is kept
POPFile/Module.pm:
Add two methods
get_root_path_
get_user_path_
that convert passed in relative paths to absolute paths relative
to either POPFILE_ROOT or POPFILE_USER. This two helpers simply
call the relevant public interface in POPFile/Configuration.pm.
POPFile/Configuration.pm:
Add two methods
get_root_path
get_user_path
that convert passed in relative paths to absolute paths relative
to either POPFILE_ROOT or POPFILE_USER.
Classifer/WordMangle.pm:
Make this a PLM (with name 'wordmangle') so that it can get access
to the POPFILE_USER variable so that stopwords are per user.
Classifier/Bayes.pm:
Remove unused Classifier::WordMangle object.
Change all path usage to call get_user_path_ to set the path
correctly relative to the current user.
UI/HTML.pm:
Change path usage to call get_root_path_ or get_user_path_ to get
the path relative to the current root or user. The root is used to
access skins, manual and language files. Everything else is in the
user directory.
POPFile/Module.pm:
Use the POPFILE_ROOT to control the loading of modules.
popfile.pl:
If POPFILE_ROOT is defined the add it to @INC so that we can load
the POPFile::Loader module.
tests/TestWordMangle.tst:
Since Classifier::WordMangle is now a PLM the tests need to be
updated to load the mangler correctly and link it in with the
other POPFile modules that is depends on.
tests/TestPOP3.tst
tests/TestMailParse.tst
tests/TestBayes.tst:
Since Classifier::WordMangle is now a PLM test suites that relied
upon Classifier::MailParse creating the mangler needed updating to
actually create and pass in the mangler object.
tests/TestHTTP.tst:
Make tests work on non-Windows systems. One test was relying on
\n being \r\n.
TODO
Write tests for get_user_path and get_root_path, is_absolute_path,
root_path and path_join
Write tests for POPFILE_ROOT and POPFILE_USER
Make HTML test suite run on Linux
Debug MailParse test suite, fix Japanese handling (026).
Debug POP3 suite/TOP handling
Index: TestWordMangle.tst
===================================================================
RCS file: /cvsroot/popfile/engine/tests/TestWordMangle.tst,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** TestWordMangle.tst 4 Nov 2003 20:01:16 -0000 1.7
--- TestWordMangle.tst 10 Nov 2003 19:55:35 -0000 1.8
***************
*** 24,31 ****
use Classifier::WordMangle;
unlink 'stopwords';
! my $w = new Classifier::WordMangle;
# Test basic mangling functions
--- 24,62 ----
use Classifier::WordMangle;
+ use POPFile::Configuration;
+ use POPFile::MQ;
+ use POPFile::Logger;
+
+ # Load the test corpus
+ my $c = new POPFile::Configuration;
+ my $mq = new POPFile::MQ;
+ my $l = new POPFile::Logger;
+ my $w = new Classifier::WordMangle;
+
+ $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 );
+
+ $w->configuration( $c );
+ $w->mq( $mq );
+ $w->logger( $l );
+
+ $w->initialize();
unlink 'stopwords';
! $w->start();
# Test basic mangling functions
***************
*** 79,84 ****
# Make sure that stopping and starting reloads the stopwords
test_assert_equal( $w->add_stopword( 'anotherbigword', 'English' ), 1 );
! my $w2 = new Classifier::WordMangle;
! my @stopwords = $w2->stopwords();
test_assert_equal( $#stopwords, 0 );
test_assert_equal( $stopwords[0], 'anotherbigword' );
--- 110,118 ----
# Make sure that stopping and starting reloads the stopwords
test_assert_equal( $w->add_stopword( 'anotherbigword', 'English' ), 1 );
!
! $w->stop();
!
! $w->start();
! my @stopwords = $w->stopwords();
test_assert_equal( $#stopwords, 0 );
test_assert_equal( $stopwords[0], 'anotherbigword' );
Index: TestPOP3.tst
===================================================================
RCS file: /cvsroot/popfile/engine/tests/TestPOP3.tst,v
retrieving revision 1.16
retrieving revision 1.17
diff -C2 -d -r1.16 -r1.17
*** TestPOP3.tst 13 Oct 2003 20:23:41 -0000 1.16
--- TestPOP3.tst 10 Nov 2003 19:55:36 -0000 1.17
***************
*** 28,31 ****
--- 28,32 ----
use Proxy::POP3;
use Classifier::Bayes;
+ use Classifier::WordMangle;
use IO::Handle;
use IO::Socket;
***************
*** 241,244 ****
--- 242,246 ----
my $l = new POPFile::Logger;
my $b = new Classifier::Bayes;
+ my $w = new Classifier::WordMangle;
sub forker
***************
*** 281,284 ****
--- 283,292 ----
$l->initialize();
+ $w->configuration( $c );
+ $w->mq( $mq );
+ $w->logger( $l );
+
+ $w->start();
+
$mq->configuration( $c );
$mq->mq( $mq );
***************
*** 293,296 ****
--- 301,305 ----
$b->module_config_( 'html', 'language', 'English' );
$b->config_( 'hostname', '127.0.0.1' );
+ $b->{parser__}->mangle( $w );
$b->start();
Index: TestMailParse.tst
===================================================================
RCS file: /cvsroot/popfile/engine/tests/TestMailParse.tst,v
retrieving revision 1.23
retrieving revision 1.24
diff -C2 -d -r1.23 -r1.24
*** TestMailParse.tst 20 Oct 2003 22:00:37 -0000 1.23
--- TestMailParse.tst 10 Nov 2003 19:55:36 -0000 1.24
***************
*** 32,35 ****
--- 32,36 ----
use Classifier::MailParse;
use Classifier::Bayes;
+ use Classifier::WordMangle;
use POPFile::Configuration;
use POPFile::MQ;
***************
*** 41,44 ****
--- 42,46 ----
my $l = new POPFile::Logger;
my $b = new Classifier::Bayes;
+ my $w = new Classifier::WordMangle;
$c->configuration( $c );
***************
*** 52,55 ****
--- 54,63 ----
$l->initialize();
+ $w->configuration( $c );
+ $w->mq( $mq );
+ $w->logger( $l );
+
+ $w->start();
+
$mq->configuration( $c );
$mq->mq( $mq );
***************
*** 60,63 ****
--- 68,72 ----
$b->logger( $l );
+ $b->{parser__}->mangle( $w );
$b->initialize();
test_assert( $b->start() );
***************
*** 65,68 ****
--- 74,78 ----
my $cl = new Classifier::MailParse;
+ $cl->mangle( $w );
# map_color()
test_assert_equal( $cl->map_color( 'red' ), 'ff0000' );
Index: TestBayes.tst
===================================================================
RCS file: /cvsroot/popfile/engine/tests/TestBayes.tst,v
retrieving revision 1.34
retrieving revision 1.35
diff -C2 -d -r1.34 -r1.35
*** TestBayes.tst 30 Oct 2003 14:57:12 -0000 1.34
--- TestBayes.tst 10 Nov 2003 19:55:36 -0000 1.35
***************
*** 37,40 ****
--- 37,41 ----
use POPFile::MQ;
use POPFile::Logger;
+ use Classifier::WordMangle;
# Load the test corpus
***************
*** 43,46 ****
--- 44,48 ----
my $l = new POPFile::Logger;
my $b = new Classifier::Bayes;
+ my $w = new Classifier::WordMangle;
$c->configuration( $c );
***************
*** 54,57 ****
--- 56,65 ----
$l->initialize();
+ $w->configuration( $c );
+ $w->mq( $mq );
+ $w->logger( $l );
+
+ $w->start();
+
$mq->configuration( $c );
$mq->mq( $mq );
***************
*** 63,67 ****
$b->module_config_( 'html', 'language', 'English' );
!
$b->initialize();
--- 71,75 ----
$b->module_config_( 'html', 'language', 'English' );
! $b->{parser__}->mangle( $w );
$b->initialize();
Index: TestHTTP.tst
===================================================================
RCS file: /cvsroot/popfile/engine/tests/TestHTTP.tst,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** TestHTTP.tst 13 Oct 2003 20:23:41 -0000 1.5
--- TestHTTP.tst 10 Nov 2003 19:55:36 -0000 1.6
***************
*** 185,189 ****
open FILE, ">send.tmp";
! print FILE "somechars\n";
close FILE;
--- 185,189 ----
open FILE, ">send.tmp";
! print FILE "somechars$eol";
close FILE;
|
|
From: <jgr...@us...> - 2003-11-10 19:55:40
|
Update of /cvsroot/popfile/engine/UI
In directory sc8-pr-cvs1:/tmp/cvs-serv311/UI
Modified Files:
HTML.pm
Log Message:
Multi-user Phase #1
-------------------
Make POPFile work relative to two special environment variables:
POPFILE_ROOT The location where popfile.pl is installed
POPFILE_USER The location where this user's config is kept
POPFile/Module.pm:
Add two methods
get_root_path_
get_user_path_
that convert passed in relative paths to absolute paths relative
to either POPFILE_ROOT or POPFILE_USER. This two helpers simply
call the relevant public interface in POPFile/Configuration.pm.
POPFile/Configuration.pm:
Add two methods
get_root_path
get_user_path
that convert passed in relative paths to absolute paths relative
to either POPFILE_ROOT or POPFILE_USER.
Classifer/WordMangle.pm:
Make this a PLM (with name 'wordmangle') so that it can get access
to the POPFILE_USER variable so that stopwords are per user.
Classifier/Bayes.pm:
Remove unused Classifier::WordMangle object.
Change all path usage to call get_user_path_ to set the path
correctly relative to the current user.
UI/HTML.pm:
Change path usage to call get_root_path_ or get_user_path_ to get
the path relative to the current root or user. The root is used to
access skins, manual and language files. Everything else is in the
user directory.
POPFile/Module.pm:
Use the POPFILE_ROOT to control the loading of modules.
popfile.pl:
If POPFILE_ROOT is defined the add it to @INC so that we can load
the POPFile::Loader module.
tests/TestWordMangle.tst:
Since Classifier::WordMangle is now a PLM the tests need to be
updated to load the mangler correctly and link it in with the
other POPFile modules that is depends on.
tests/TestPOP3.tst
tests/TestMailParse.tst
tests/TestBayes.tst:
Since Classifier::WordMangle is now a PLM test suites that relied
upon Classifier::MailParse creating the mangler needed updating to
actually create and pass in the mangler object.
tests/TestHTTP.tst:
Make tests work on non-Windows systems. One test was relying on
\n being \r\n.
TODO
Write tests for get_user_path and get_root_path, is_absolute_path,
root_path and path_join
Write tests for POPFILE_ROOT and POPFILE_USER
Make HTML test suite run on Linux
Debug MailParse test suite, fix Japanese handling (026).
Debug POP3 suite/TOP handling
Index: HTML.pm
===================================================================
RCS file: /cvsroot/popfile/engine/UI/HTML.pm,v
retrieving revision 1.220
retrieving revision 1.221
diff -C2 -d -r1.220 -r1.221
*** HTML.pm 30 Oct 2003 14:42:33 -0000 1.220
--- HTML.pm 10 Nov 2003 19:55:35 -0000 1.221
***************
*** 399,423 ****
if ( $url =~ /\/(.+\.gif)/ ) {
! $self->http_file_( $client, $1, 'image/gif' );
return 1;
}
if ( $url =~ /\/(.+\.png)/ ) {
! $self->http_file_( $client, $1, 'image/png' );
return 1;
}
if ( $url =~ /\/(.+\.ico)/ ) {
! $self->http_file_( $client, $1, 'image/x-icon' );
return 1;
}
if ( $url =~ /(skins\/.+\.css)/ ) {
! $self->http_file_( $client, $1, 'text/css' );
return 1;
}
if ( $url =~ /(manual\/.+\.html)/ ) {
! $self->http_file_( $client, $1, 'text/html' );
return 1;
}
--- 399,423 ----
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' );
return 1;
}
if ( $url =~ /(skins\/.+\.css)/ ) {
! $self->http_file_( $client, $self->get_root_path_( $1 ), 'text/css' );
return 1;
}
if ( $url =~ /(manual\/.+\.html)/ ) {
! $self->http_file_( $client, $self->get_root_path_( $1 ), 'text/html' );
return 1;
}
***************
*** 645,649 ****
if ( $selected == -1 ) {
$result .= "<style type=\"text/css\">\n";
! if ( open FILE, '<skins/' . $self->config_( 'skin' ) . '.css' ) {
while (<FILE>) {
$result .= $_;
--- 645,649 ----
if ( $selected == -1 ) {
$result .= "<style type=\"text/css\">\n";
! if ( open FILE, '<' . $self->get_root_path_( 'skins/' . $self->config_( 'skin' ) . '.css' ) ) {
while (<FILE>) {
$result .= $_;
***************
*** 1892,1896 ****
if ( ( defined($self->{form_}{color}) ) && ( defined($self->{form_}{bucket}) ) ) {
! open COLOR, '>' . $self->module_config_( 'bayes', 'corpus' ) . "/$self->{form_}{bucket}/color";
print COLOR "$self->{form_}{color}\n";
close COLOR;
--- 1892,1896 ----
if ( ( defined($self->{form_}{color}) ) && ( defined($self->{form_}{bucket}) ) ) {
! open COLOR, '>' . $self->get_user_path_( $self->module_config_( 'bayes', 'corpus' ) . "/$self->{form_}{bucket}/color" );
print COLOR "$self->{form_}{color}\n";
close COLOR;
***************
*** 2440,2444 ****
my ( $self ) = @_;
! my $cache_file = $self->global_config_( 'msgdir' ) . 'history_cache';
if ( !(-e $cache_file) ) {
return;
--- 2440,2444 ----
my ( $self ) = @_;
! my $cache_file = $self->get_user_path_( $self->global_config_( 'msgdir' ) . 'history_cache' );
if ( !(-e $cache_file) ) {
return;
***************
*** 2498,2502 ****
}
! open CACHE, '>' . $self->global_config_( 'msgdir' ) . 'history_cache';
print CACHE "___HISTORY__ __ VERSION__ 1\n";
foreach my $key (keys %{$self->{history__}}) {
--- 2498,2502 ----
}
! open CACHE, '>' . $self->get_user_path_( $self->global_config_( 'msgdir' ) . 'history_cache' );
print CACHE "___HISTORY__ __ VERSION__ 1\n";
foreach my $key (keys %{$self->{history__}}) {
***************
*** 2550,2554 ****
# for non-culling and new entries that need to be added to the end
! opendir MESSAGES, $self->global_config_( 'msgdir' );
my @history_files;
--- 2550,2554 ----
# for non-culling and new entries that need to be added to the end
! opendir MESSAGES, $self->get_user_path_( $self->global_config_( 'msgdir' ) );
my @history_files;
***************
*** 2620,2624 ****
my $long_header = '';
! if ( open MAIL, '<'. $self->global_config_( 'msgdir' ) . $file ) {
while ( <MAIL> ) {
last if ( /^(\r\n|\r|\n)/ );
--- 2620,2624 ----
my $long_header = '';
! if ( open MAIL, '<'. $self->get_user_path_( $self->global_config_( 'msgdir' ) . $file ) ) {
while ( <MAIL> ) {
last if ( /^(\r\n|\r|\n)/ );
***************
*** 3493,3497 ****
if ( $self->{history__}{$mail_file}{magnet} eq '' ) {
! $body .= $self->{classifier__}->get_html_colored_message($self->global_config_( 'msgdir' ) . $mail_file);
# We want to insert a link to change the output format at the start of the word
--- 3493,3497 ----
if ( $self->{history__}{$mail_file}{magnet} eq '' ) {
! $body .= $self->{classifier__}->get_html_colored_message( $self->get_user_path_( $self->global_config_( 'msgdir' ) . $mail_file ) );
# We want to insert a link to change the output format at the start of the word
***************
*** 3553,3557 ****
$body .= "<tt>";
! open MESSAGE, '<' . $self->global_config_( 'msgdir' ) . $mail_file;
my $line;
# process each line of the message
--- 3553,3557 ----
$body .= "<tt>";
! open MESSAGE, '<' . $self->get_user_path_( $self->global_config_( 'msgdir' ) . $mail_file );
my $line;
# process each line of the message
***************
*** 3663,3667 ****
my ( $self ) = @_;
! @{$self->{skins__}} = glob 'skins/*.css';
for my $i (0..$#{$self->{skins__}}) {
--- 3663,3667 ----
my ( $self ) = @_;
! @{$self->{skins__}} = glob $self->get_root_path_( 'skins/*.css' );
for my $i (0..$#{$self->{skins__}}) {
***************
*** 3681,3685 ****
my ( $self ) = @_;
! @{$self->{languages__}} = glob 'languages/*.msg';
for my $i (0..$#{$self->{languages__}}) {
--- 3681,3685 ----
my ( $self ) = @_;
! @{$self->{languages__}} = glob $self->get_root_path_( 'languages/*.msg' );
for my $i (0..$#{$self->{languages__}}) {
***************
*** 3740,3744 ****
my ( $self, $lang ) = @_;
! if ( open LANG, "<languages/$lang.msg" ) {
while ( <LANG> ) {
next if ( /[ \t]*#/ );
--- 3740,3744 ----
my ( $self, $lang ) = @_;
! if ( open LANG, '<' . $self->get_root_path_( "languages/$lang.msg" ) ) {
while ( <LANG> ) {
next if ( /[ \t]*#/ );
***************
*** 3796,3800 ****
my ( $self ) = @_;
! opendir MESSAGES, $self->global_config_( 'msgdir' );
while ( my $mail_file = readdir MESSAGES ) {
--- 3796,3800 ----
my ( $self ) = @_;
! opendir MESSAGES, $self->get_user_path_( $self->global_config_( 'msgdir' ) );
while ( my $mail_file = readdir MESSAGES ) {
|
|
From: <jgr...@us...> - 2003-11-10 19:55:40
|
Update of /cvsroot/popfile/engine/Classifier
In directory sc8-pr-cvs1:/tmp/cvs-serv311/Classifier
Modified Files:
WordMangle.pm Bayes.pm
Log Message:
Multi-user Phase #1
-------------------
Make POPFile work relative to two special environment variables:
POPFILE_ROOT The location where popfile.pl is installed
POPFILE_USER The location where this user's config is kept
POPFile/Module.pm:
Add two methods
get_root_path_
get_user_path_
that convert passed in relative paths to absolute paths relative
to either POPFILE_ROOT or POPFILE_USER. This two helpers simply
call the relevant public interface in POPFile/Configuration.pm.
POPFile/Configuration.pm:
Add two methods
get_root_path
get_user_path
that convert passed in relative paths to absolute paths relative
to either POPFILE_ROOT or POPFILE_USER.
Classifer/WordMangle.pm:
Make this a PLM (with name 'wordmangle') so that it can get access
to the POPFILE_USER variable so that stopwords are per user.
Classifier/Bayes.pm:
Remove unused Classifier::WordMangle object.
Change all path usage to call get_user_path_ to set the path
correctly relative to the current user.
UI/HTML.pm:
Change path usage to call get_root_path_ or get_user_path_ to get
the path relative to the current root or user. The root is used to
access skins, manual and language files. Everything else is in the
user directory.
POPFile/Module.pm:
Use the POPFILE_ROOT to control the loading of modules.
popfile.pl:
If POPFILE_ROOT is defined the add it to @INC so that we can load
the POPFile::Loader module.
tests/TestWordMangle.tst:
Since Classifier::WordMangle is now a PLM the tests need to be
updated to load the mangler correctly and link it in with the
other POPFile modules that is depends on.
tests/TestPOP3.tst
tests/TestMailParse.tst
tests/TestBayes.tst:
Since Classifier::WordMangle is now a PLM test suites that relied
upon Classifier::MailParse creating the mangler needed updating to
actually create and pass in the mangler object.
tests/TestHTTP.tst:
Make tests work on non-Windows systems. One test was relying on
\n being \r\n.
TODO
Write tests for get_user_path and get_root_path, is_absolute_path,
root_path and path_join
Write tests for POPFILE_ROOT and POPFILE_USER
Make HTML test suite run on Linux
Debug MailParse test suite, fix Japanese handling (026).
Debug POP3 suite/TOP handling
Index: WordMangle.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Classifier/WordMangle.pm,v
retrieving revision 1.33
retrieving revision 1.34
diff -C2 -d -r1.33 -r1.34
*** WordMangle.pm 4 Nov 2003 20:01:16 -0000 1.33
--- WordMangle.pm 10 Nov 2003 19:55:35 -0000 1.34
***************
*** 1,4 ****
--- 1,8 ----
+ # POPFILE LOADABLE MODULE
package Classifier::WordMangle;
+ use POPFile::Module;
+ @ISA = ("POPFile::Module");
+
# ---------------------------------------------------------------------------------------------
#
***************
*** 45,49 ****
{
my $type = shift;
! my $self;
$self->{stop__} = {};
--- 49,53 ----
{
my $type = shift;
! my $self = POPFile::Module->new();
$self->{stop__} = {};
***************
*** 51,59 ****
bless $self, $type;
! $self->load_stopwords();
return $self;
}
# ---------------------------------------------------------------------------------------------
#
--- 55,72 ----
bless $self, $type;
! $self->name( 'wordmangle' );
return $self;
}
+ sub start
+ {
+ my ( $self ) = @_;
+
+ $self->load_stopwords();
+
+ return 1;
+ }
+
# ---------------------------------------------------------------------------------------------
#
***************
*** 65,69 ****
my ($self) = @_;
! if ( open STOPS, "<stopwords" ) {
delete $self->{stop__};
while ( <STOPS> ) {
--- 78,82 ----
my ($self) = @_;
! if ( open STOPS, '<' . $self->get_user_path_( 'stopwords' ) ) {
delete $self->{stop__};
while ( <STOPS> ) {
***************
*** 80,84 ****
my ($self) = @_;
! if ( open STOPS, ">stopwords" ) {
for my $word (keys %{$self->{stop__}}) {
print STOPS "$word\n";
--- 93,97 ----
my ($self) = @_;
! if ( open STOPS, '>' . $self->get_user_path_( 'stopwords' ) ) {
for my $word (keys %{$self->{stop__}}) {
print STOPS "$word\n";
Index: Bayes.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Classifier/Bayes.pm,v
retrieving revision 1.221
retrieving revision 1.222
diff -C2 -d -r1.221 -r1.222
*** Bayes.pm 9 Nov 2003 22:33:47 -0000 1.221
--- Bayes.pm 10 Nov 2003 19:55:35 -0000 1.222
***************
*** 35,39 ****
use locale;
use Classifier::MailParse;
- use Classifier::WordMangle;
use IO::Handle;
--- 35,38 ----
***************
*** 88,94 ****
$self->{full_total__} = 0;
- # Used to mangle the corpus when loaded
- $self->{mangler__} = new Classifier::WordMangle;
-
# Used to parse mail messages
$self->{parser__} = new Classifier::MailParse;
--- 87,90 ----
***************
*** 297,301 ****
for my $bucket (keys %{$self->{matrix__}}) {
! open PARAMS, '>' . $self->config_( 'corpus' ) . "/$bucket/params";
for my $param (keys %{$self->{parameters__}{$bucket}}) {
print PARAMS "$param $self->{parameters__}{$bucket}{$param}\n";
--- 293,297 ----
for my $bucket (keys %{$self->{matrix__}}) {
! open PARAMS, '>' . $self->get_user_path_( $self->config_( 'corpus' ) . "/$bucket/params" );
for my $param (keys %{$self->{parameters__}{$bucket}}) {
print PARAMS "$param $self->{parameters__}{$bucket}{$param}\n";
***************
*** 500,504 ****
$self->{full_total__} = 0;
! my @buckets = glob $self->config_( 'corpus' ) . '/*';
foreach my $bucket (@buckets) {
--- 496,500 ----
$self->{full_total__} = 0;
! my @buckets = glob $self->get_user_path_( $self->config_( 'corpus' ) . '/*' );
foreach my $bucket (@buckets) {
***************
*** 585,589 ****
$self->{db__}{$bucket} = tie %{$self->{matrix__}{$bucket}}, "BerkeleyDB::Hash", # PROFILE BLOCK START
-Cachesize => $self->config_( 'db_cache_size' ),
! -Filename => $self->config_( 'corpus' ) . "/$bucket/table.db",
-Flags => DB_CREATE; # PROFILE BLOCK STOP
--- 581,585 ----
$self->{db__}{$bucket} = tie %{$self->{matrix__}{$bucket}}, "BerkeleyDB::Hash", # PROFILE BLOCK START
-Cachesize => $self->config_( 'db_cache_size' ),
! -Filename => $self->get_user_path_( $self->config_( 'corpus' ) . "/$bucket/table.db" ),
-Flags => DB_CREATE; # PROFILE BLOCK STOP
***************
*** 648,652 ****
# See if there's a color file specified
! if ( open PARAMS, '<' . $self->config_( 'corpus' ) . "/$bucket/params" ) {
while ( <PARAMS> ) {
s/[\r\n]//g;
--- 644,648 ----
# See if there's a color file specified
! if ( open PARAMS, '<' . $self->get_user_path_( $self->config_( 'corpus' ) . "/$bucket/params" ) ) {
while ( <PARAMS> ) {
s/[\r\n]//g;
***************
*** 661,665 ****
# See if there are magnets defined
! if ( open MAGNETS, '<' . $self->config_( 'corpus' ) . "/$bucket/magnets" ) {
while ( <MAGNETS> ) {
s/[\r\n]//g;
--- 657,661 ----
# See if there are magnets defined
! if ( open MAGNETS, '<' . $self->get_user_path_( $self->config_( 'corpus' ) . "/$bucket/magnets" ) ) {
while ( <MAGNETS> ) {
s/[\r\n]//g;
***************
*** 710,719 ****
$self->tie_bucket__( $bucket );
! if ( -e $self->config_( 'corpus' ) . "/$bucket/table" ) {
$self->log_( "Performing automatic upgrade of $bucket corpus from flat file to BerkeleyDB" );
my $ft = $self->{full_total__};
! if ( open WORDS, '<' . $self->config_( 'corpus' ) . "/$bucket/table" ) {
my $wc = 1;
--- 706,715 ----
$self->tie_bucket__( $bucket );
! if ( -e $self->get_user_path_( $self->config_( 'corpus' ) . "/$bucket/table" ) ) {
$self->log_( "Performing automatic upgrade of $bucket corpus from flat file to BerkeleyDB" );
my $ft = $self->{full_total__};
! if ( open WORDS, '<' . $self->get_user_path_( $self->config_( 'corpus' ) . "/$bucket/table" ) ) {
my $wc = 1;
***************
*** 758,762 ****
$self->tie_bucket__( $bucket );
! if ( open WORDS, '<' . $self->config_( 'corpus' ) . "/$bucket/table" ) {
my $wc = 1;
my $bucket_total = 0;
--- 754,758 ----
$self->tie_bucket__( $bucket );
! if ( open WORDS, '<' . $self->get_user_path_( $self->config_( 'corpus' ) . "/$bucket/table" ) ) {
my $wc = 1;
my $bucket_total = 0;
***************
*** 869,873 ****
for my $bucket (keys %{$self->{matrix__}}) {
! open MAGNET, '>' . $self->config_( 'corpus' ). "/$bucket/magnets";
for my $type (keys %{$self->{magnets__}{$bucket}}) {
--- 865,869 ----
for my $bucket (keys %{$self->{matrix__}}) {
! open MAGNET, '>' . $self->get_user_path_( $self->config_( 'corpus' ). "/$bucket/magnets" );
for my $type (keys %{$self->{magnets__}{$bucket}}) {
***************
*** 1271,1275 ****
$path = 0 if (!defined($path));
! return ($path?$self->global_config_( 'msgdir' ):'') . "popfile$dcount" . "=$mcount" . (defined $ext?$ext:'.msg');
}
--- 1267,1271 ----
$path = 0 if (!defined($path));
! return ($path?$self->get_user_path_( $self->global_config_( 'msgdir' ) ):'') . "popfile$dcount" . "=$mcount" . (defined $ext?$ext:'.msg');
}
***************
*** 1291,1295 ****
$filename =~ s/msg$/cls/;
! open CLASS, '>' . $self->global_config_( 'msgdir' ) . $filename;
if ( defined( $magnet ) && ( $magnet ne '' ) ) {
--- 1287,1291 ----
$filename =~ s/msg$/cls/;
! open CLASS, '>' . $self->get_user_path_( $self->global_config_( 'msgdir' ) . $filename );
if ( defined( $magnet ) && ( $magnet ne '' ) ) {
***************
*** 1335,1339 ****
my $magnet = '';
! if ( open CLASS, '<' . $self->global_config_( 'msgdir' ) . $filename ) {
$bucket = <CLASS>;
if ( $bucket =~ /([^ ]+) MAGNET ([^\r\n]+)/ ) {
--- 1331,1335 ----
my $magnet = '';
! if ( open CLASS, '<' . $self->get_user_path_( $self->global_config_( 'msgdir' ) . $filename ) ) {
$bucket = <CLASS>;
if ( $bucket =~ /([^ ]+) MAGNET ([^\r\n]+)/ ) {
***************
*** 1993,1997 ****
{
my ( $self, $bucket ) = @_;
! my $bucket_directory = $self->config_( 'corpus' ) . "/$bucket";
unlink( "$bucket_directory/table.db" );
--- 1989,1993 ----
{
my ( $self, $bucket ) = @_;
! my $bucket_directory = $self->get_user_path_( $self->config_( 'corpus' ) . "/$bucket" );
unlink( "$bucket_directory/table.db" );
|
|
From: <jgr...@us...> - 2003-11-10 19:55:39
|
Update of /cvsroot/popfile/engine/POPFile
In directory sc8-pr-cvs1:/tmp/cvs-serv311/POPFile
Modified Files:
Module.pm Configuration.pm
Log Message:
Multi-user Phase #1
-------------------
Make POPFile work relative to two special environment variables:
POPFILE_ROOT The location where popfile.pl is installed
POPFILE_USER The location where this user's config is kept
POPFile/Module.pm:
Add two methods
get_root_path_
get_user_path_
that convert passed in relative paths to absolute paths relative
to either POPFILE_ROOT or POPFILE_USER. This two helpers simply
call the relevant public interface in POPFile/Configuration.pm.
POPFile/Configuration.pm:
Add two methods
get_root_path
get_user_path
that convert passed in relative paths to absolute paths relative
to either POPFILE_ROOT or POPFILE_USER.
Classifer/WordMangle.pm:
Make this a PLM (with name 'wordmangle') so that it can get access
to the POPFILE_USER variable so that stopwords are per user.
Classifier/Bayes.pm:
Remove unused Classifier::WordMangle object.
Change all path usage to call get_user_path_ to set the path
correctly relative to the current user.
UI/HTML.pm:
Change path usage to call get_root_path_ or get_user_path_ to get
the path relative to the current root or user. The root is used to
access skins, manual and language files. Everything else is in the
user directory.
POPFile/Module.pm:
Use the POPFILE_ROOT to control the loading of modules.
popfile.pl:
If POPFILE_ROOT is defined the add it to @INC so that we can load
the POPFile::Loader module.
tests/TestWordMangle.tst:
Since Classifier::WordMangle is now a PLM the tests need to be
updated to load the mangler correctly and link it in with the
other POPFile modules that is depends on.
tests/TestPOP3.tst
tests/TestMailParse.tst
tests/TestBayes.tst:
Since Classifier::WordMangle is now a PLM test suites that relied
upon Classifier::MailParse creating the mangler needed updating to
actually create and pass in the mangler object.
tests/TestHTTP.tst:
Make tests work on non-Windows systems. One test was relying on
\n being \r\n.
TODO
Write tests for get_user_path and get_root_path, is_absolute_path,
root_path and path_join
Write tests for POPFILE_ROOT and POPFILE_USER
Make HTML test suite run on Linux
Debug MailParse test suite, fix Japanese handling (026).
Debug POP3 suite/TOP handling
Index: Module.pm
===================================================================
RCS file: /cvsroot/popfile/engine/POPFile/Module.pm,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -d -r1.12 -r1.13
*** Module.pm 10 Sep 2003 03:54:15 -0000 1.12
--- Module.pm 10 Nov 2003 19:55:35 -0000 1.13
***************
*** 1,540 ****
! #----------------------------------------------------------------------------
! #
! # This is POPFile's top level Module object.
! #
! # Copyright (c) 2001-2003 John Graham-Cumming
! #
! # This file is part of POPFile
! #
! # POPFile is free software; you can redistribute it and/or modify
! # it under the terms of the GNU General Public License as published by
[...1099 lines suppressed...]
!
! sub version
! {
! my ( $self, $value ) = @_;
!
! if ( defined( $value ) ) {
! $self->{version_} = $value;
! }
!
! return $self->{version_};
! }
!
! sub last_ten_log_entries
! {
! my ( $self ) = @_;
!
! return $self->{logger__}->last_ten();
! }
!
! 1;
Index: Configuration.pm
===================================================================
RCS file: /cvsroot/popfile/engine/POPFile/Configuration.pm,v
retrieving revision 1.28
retrieving revision 1.29
diff -C2 -d -r1.28 -r1.29
*** Configuration.pm 20 Oct 2003 12:53:50 -0000 1.28
--- Configuration.pm 10 Nov 2003 19:55:35 -0000 1.29
***************
*** 1,521 ****
! # POPFILE LOADABLE MODULE
! package POPFile::Configuration;
!
! use POPFile::Module;
! @ISA = ( "POPFile::Module" );
!
! #----------------------------------------------------------------------------
! #
! # This module handles POPFile's configuration parameters. It is used to
! # load and save from the popfile.cfg file and individual POPFile modules
[...1129 lines suppressed...]
!
! my $path = "$left/$right";
!
! # Strip any amount of leading ./
!
! $path =~ s/^(\.\/)+//;
!
! return $path;
! }
!
! # GETTER
!
! sub configuration_parameters
! {
! my ( $self ) = @_;
!
! return sort keys %{$self->{configuration_parameters__}};
! }
!
! 1;
|
|
From: <ssc...@us...> - 2003-11-10 10:38:05
|
Update of /cvsroot/popfile/engine/Proxy
In directory sc8-pr-cvs1:/tmp/cvs-serv18002
Modified Files:
NNTP.pm POP3.pm SMTP.pm
Log Message:
Roadmap feature addition: Dis/enabling of optional POPFile Loadable Modules.
Updating past this point may require re-setting some modules as enabled
Optional modules (All Proxies, and non-html UI's) have a -module_enabled
boolean configuration parameter
Index: NNTP.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Proxy/NNTP.pm,v
retrieving revision 1.21
retrieving revision 1.22
diff -C2 -d -r1.21 -r1.22
*** NNTP.pm 6 Oct 2003 13:54:30 -0000 1.21
--- NNTP.pm 10 Nov 2003 10:37:56 -0000 1.22
***************
*** 27,30 ****
--- 27,32 ----
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
+ # Modified by Sam Schinke (ssc...@us...)
+ #
# ---------------------------------------------------------------------------------------------
***************
*** 70,73 ****
--- 72,78 ----
{
my ( $self ) = @_;
+
+ # Disabled by default
+ $self->config_( 'enabled', 0);
# By default we don't fork on Windows
Index: POP3.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Proxy/POP3.pm,v
retrieving revision 1.80
retrieving revision 1.81
diff -C2 -d -r1.80 -r1.81
*** POP3.pm 14 Oct 2003 16:15:27 -0000 1.80
--- POP3.pm 10 Nov 2003 10:37:58 -0000 1.81
***************
*** 27,30 ****
--- 27,32 ----
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
+ # Modified by Sam Schinke (ssc...@us...)
+ #
# ---------------------------------------------------------------------------------------------
***************
*** 71,74 ****
--- 73,79 ----
my ( $self ) = @_;
+ # Enabled by default
+ $self->config_( 'enabled', 1);
+
# By default we don't fork on Windows
$self->config_( 'force_fork', ($^O eq 'MSWin32')?0:1 );
***************
*** 448,458 ****
--- 453,473 ----
my ( $reclassified, $bucket, $usedtobe, $magnet) = $self->{classifier__}->history_read_class($short_file);
+ $self->log_( "Message is: long($file) short($short_file)");
+
+ $self->log_( "Message is: reclassified($reclassified) bucket($bucket) usedtobe($usedtobe) magnet($magnet)" );
+
if ($bucket ne 'unknown class') {
# echo file, inserting known classification, without saving
+ $self->log_( "known class, printing");
+
$class = $self->{classifier__}->classify_and_modify( \*RETRFILE, $client, $download_count, $count, 1, $bucket );
+
+ $self->log_( "done printing" );
} else {
+ $self->log_( "unknown class, classifying");
+
# If the class wasn't saved properly, classify from disk normally
***************
*** 466,469 ****
--- 481,485 ----
close RETRFILE;
print $client ".$eol";
+ $self->log_( "message complete" );
} else {
Index: SMTP.pm
===================================================================
RCS file: /cvsroot/popfile/engine/Proxy/SMTP.pm,v
retrieving revision 1.22
retrieving revision 1.23
diff -C2 -d -r1.22 -r1.23
*** SMTP.pm 6 Oct 2003 13:54:30 -0000 1.22
--- SMTP.pm 10 Nov 2003 10:38:01 -0000 1.23
***************
*** 1,438 ****
! # POPFILE LOADABLE MODULE
! package Proxy::SMTP;
!
! use Proxy::Proxy;
! @ISA = ("Proxy::Proxy");
!
! # ---------------------------------------------------------------------------------------------
! #
! # This module handles proxying the SMTP protocol for POPFile.
! #
! # Copyright (c) 2001-2003 John Graham-Cumming
! #
! # This file is part of POPFile
! #
! # POPFile is free software; you can redistribute it and/or modify
! # it under the terms of the GNU General Public License as published by
! # the Free Software Foundation; either version 2 of the License, or
! # (at your option) any later version.
! #
! # POPFile is distributed in the hope that it will be useful,
! # but WITHOUT ANY WARRANTY; without even the implied warranty of
! # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! # GNU General Public License for more details.
! #
! # You should have received a copy of the GNU General Public License
! # along with POPFile; if not, write to the Free Software
! # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
! #
! # ---------------------------------------------------------------------------------------------
!
! use strict;
! use warnings;
! use locale;
!
! # A handy variable containing the value of an EOL for networks
! my $eol = "\015\012";
!
! #----------------------------------------------------------------------------
! # new
! #
! # Class new() function
! #----------------------------------------------------------------------------
! sub new
! {
! my $type = shift;
! my $self = Proxy::Proxy->new();
!
! # Must call bless before attempting to call any methods
!
! bless $self, $type;
!
! $self->name( 'smtp' );
!
! $self->{child_} = \&child__;
! $self->{connection_timeout_error_} = '554 Transaction failed';
! $self->{connection_failed_error_} = '554 Transaction failed, can\'t connect to';
! $self->{good_response_} = '^[23]';
!
! return $self;
! }
!
! # ---------------------------------------------------------------------------------------------
! #
! # initialize
! #
! # Called to initialize the SMTP proxy module
! #
! # ---------------------------------------------------------------------------------------------
! sub initialize
! {
! my ( $self ) = @_;
!
! # By default we don't fork on Windows
! $self->config_( 'force_fork', ($^O eq 'MSWin32')?0:1 );
!
! # Default port for SMTP service
! $self->config_( 'port', 25 );
!
! # Where to forward on to
! $self->config_( 'chain_server', '' );
! $self->config_( 'chain_port', 25 );
!
! # Only accept connections from the local machine for smtp
! $self->config_( 'local', 1 );
!
! # The welcome string from the proxy is configurable
! $self->config_( 'welcome_string', "SMTP POPFile ($self->{version_}) welcome" );
!
! # Tell the user interface module that we having a configuration
! # item that needs a UI component
!
! $self->register_configuration_item_( 'configuration',
! 'smtp_port',
! $self );
!
! $self->register_configuration_item_( 'configuration', # PROFILE BLOCK START
! 'smtp_force_fork',
! $self ); # PROFILE BLOCK STOP
!
! $self->register_configuration_item_( 'security',
! 'smtp_local',
! $self );
!
! $self->register_configuration_item_( 'chain',
! 'smtp_server',
! $self );
!
! $self->register_configuration_item_( 'chain',
! 'smtp_server_port',
! $self );
!
! return 1;
! }
!
! # ---------------------------------------------------------------------------------------------
! #
! # child__
! #
! # The worker method that is called when we get a good connection from a client
! #
! # $client - an open stream to a SMTP client
! # $download_count - The unique download count for this session
! #
! # ---------------------------------------------------------------------------------------------
! sub child__
! {
! my ( $self, $client, $download_count, $pipe, $ppipe, $pid ) = @_;
!
! # 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, "220 " . $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;
!
! $command = $_;
!
! # Clean up the command so that it has a nice clean $eol at the end
! $command =~ s/(\015|\012)//g;
!
! $self->log_( "Command: --$command--" );
!
! if ( $command =~ /HELO/i ) {
! if ( $self->config_( 'chain_server' ) ) {
! if ( $mail = $self->verify_connected_( $mail, $client, $self->config_( 'chain_server' ), $self->config_( 'chain_port' ) ) ) {
!
! $self->smtp_echo_response_( $mail, $client, $command );
!
!
! } else {
! last;
! }
! } else {
! $self->tee_( $client, "421 service not available$eol" );
! }
!
! next;
! }
!
! # Handle EHLO specially so we can control what ESMTP extensions are negotiated
!
! if ( $command =~ /EHLO/i ) {
! if ( $self->config_( 'chain_server' ) ) {
! if ( $mail = $self->verify_connected_( $mail, $client, $self->config_( 'chain_server' ), $self->config_( 'chain_port' ) ) ) {
!
! # TODO: Make this user-configurable (-smtp_add_unsupported, -smtp_remove_unsupported)
!
! # Stores a list of unsupported ESMTP extensions
!
! my $unsupported;
!
!
!
! # RFC 1830, http://www.faqs.org/rfcs/rfc1830.html
! # CHUNKING and BINARYMIME both require the support of the "BDAT" command
! # support of BDAT requires extensive changes to POPFile's internals and
! # will not be implemented at this time
!
! $unsupported .= "CHUNKING|BINARYMIME";
!
! # append unsupported ESMTP extensions to $unsupported here, important to maintain
! # format of OPTION|OPTION2|OPTION3
!
! $unsupported = qr/250\-$unsupported/;
!
! $self->smtp_echo_response_( $mail, $client, $command, $unsupported );
!
!
! } else {
! last;
! }
! } else {
! $self->tee_( $client, "421 service not available$eol" );
! }
!
! next;
! }
!
! if ( ( $command =~ /MAIL FROM:/i ) ||
! ( $command =~ /RCPT TO:/i ) ||
! ( $command =~ /VRFY/i ) ||
! ( $command =~ /EXPN/i ) ||
! ( $command =~ /NOOP/i ) ||
! ( $command =~ /HELP/i ) ||
! ( $command =~ /RSET/i ) ) {
! $self->smtp_echo_response_( $mail, $client, $command );
! next;
! }
!
! if ( $command =~ /DATA/i ) {
! # 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->smtp_echo_response_( $mail, $client, $command ) ) {
! $count += 1;
!
! my ( $class, $history_file ) = $self->{classifier__}->classify_and_modify( $client, $mail, $download_count, $count, 0, '' );
!
! # Tell the parent that we just handled a mail
! print $pipe "CLASS:$class$eol";
! print $pipe "NEWFL:$history_file$eol";
! flush $pipe;
! $self->yield_( $ppipe, $pid );
!
! my $response = <$mail>;
! $self->tee_( $client, $response );
! next;
! }
! }
!
! # The mail client wants to stop using the server, so send that message through to the
! # 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 ) {
! $self->smtp_echo_response_( $mail, $client, $command );
! close $mail;
! } else {
! $self->tee_( $client, "221 goodbye$eol" );
! }
! last;
! }
!
! # Don't know what this is so let's just pass it through and hope for the best
! if ( $mail && $mail->connected ) {
! $self->smtp_echo_response_( $mail, $client, $command );
! next;
! } else {
! $self->tee_( $client, "500 unknown command or bad syntax$eol" );
! last;
! }
! }
!
! close $mail if defined( $mail );
! close $client;
! print $pipe "CMPLT$eol";
! flush $pipe;
! $self->yield_( $ppipe, $pid );
! close $pipe;
! }
!
! # ---------------------------------------------------------------------------------------------
! #
! # smtp_echo_response_
! #
! # $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
! # $command The text of the command to send (we add an EOL)
! # $suppress (OPTIONAL) suppress any lines that match, compile using qr/pattern/
! #
! # Send $command to $mail, receives the response and echoes it to the $client and the debug
! # output.
! #
! # This subroutine returns responses from the server as defined in appendix E of
! # RFC 821, allowing multi-line SMTP responses.
! #
! # Returns true if the initial response is a 2xx or 3xx series (as defined by {good_response_}
! #
! # ---------------------------------------------------------------------------------------------
! sub smtp_echo_response_
! {
! my ($self, $mail, $client, $command, $suppress) = @_;
! my ( $response, $ok ) = $self->get_response_( $mail, $client, $command );
!
! if ( $response =~ /^\d\d\d-/ ) {
! $self->echo_to_regexp_($mail, $client, qr/^\d\d\d /, 1, $suppress);
! }
! return ( $response =~ /$self->{good_response_}/ );
! }
!
! # ---------------------------------------------------------------------------------------------
! #
! # configure_item
! #
! # $name The name of the item being configured, was passed in by the call
! # to register_configuration_item
! # $language Reference to the hash holding the current language
! # $session_key The current session key
! #
! # Must return the HTML for this item
! # ---------------------------------------------------------------------------------------------
!
! sub configure_item
! {
! my ( $self, $name, $language, $session_key ) = @_;
!
! my $body;
!
! if ( $name eq 'smtp_port' ) {
! $body .= "<form action=\"/configuration\">\n";
! $body .= "<label class=\"configurationLabel\" for=\"configPopPort\">$$language{Configuration_SMTPPort}:</label><br />\n";
! $body .= "<input name=\"smtp_port\" type=\"text\" id=\"configPopPort\" value=\"" . $self->config_( 'port' ) . "\" />\n";
! $body .= "<input type=\"submit\" class=\"submit\" name=\"update_smtp_port\" value=\"$$language{Apply}\" />\n";
! $body .= "<input type=\"hidden\" name=\"session\" value=\"$session_key\" />\n</form>\n";
! }
!
! if ( $name eq 'smtp_local' ) {
! $body .= "<span class=\"securityLabel\">$$language{Security_SMTP}:</span><br />\n";
!
! $body .= "<table border=\"0\" cellpadding=\"0\" cellspacing=\"0\" summary=\"\"><tr><td nowrap=\"nowrap\">\n";
! if ( $self->config_( 'local' ) == 1 ) {
! $body .= "<form class=\"securitySwitch\" action=\"/security\">\n";
! $body .= "<span class=\"securityWidgetStateOff\">$$language{Security_NoStealthMode}</span>\n";
! $body .= "<input type=\"submit\" class=\"toggleOn\" id=\"securityAcceptPOP3On\" name=\"toggle\" value=\"$$language{ChangeToYes}\" />\n";
! $body .= "<input type=\"hidden\" name=\"smtp_local\" value=\"1\" />\n";
! $body .= "<input type=\"hidden\" name=\"session\" value=\"$session_key\" />\n</form>\n";
! } else {
! $body .= "<form class=\"securitySwitch\" action=\"/security\">\n";
! $body .= "<span class=\"securityWidgetStateOn\">$$language{Yes}</span>\n";
! $body .= "<input type=\"submit\" class=\"toggleOff\" id=\"securityAcceptPOP3Off\" name=\"toggle\" value=\"$$language{ChangeToNo} (Stealth Mode)\" />\n";
! $body .= "<input type=\"hidden\" name=\"smtp_local\" value=\"2\" />\n";
! $body .= "<input type=\"hidden\" name=\"session\" value=\"$session_key\" />\n</form>\n";
! }
! $body .= "</td></tr></table>\n";
! }
!
! if ( $name eq 'smtp_server' ) {
! $body .= "<form action=\"/security\">\n";
! $body .= "<label class=\"securityLabel\" for=\"securitySecureServer\">$$language{Security_SMTPServer}:</label><br />\n";
! $body .= "<input type=\"text\" name=\"smtp_chain_server\" id=\"securitySecureServer\" value=\"" . $self->config_( 'chain_server' ) . "\" />\n";
! $body .= "<input type=\"submit\" class=\"submit\" name=\"update_smtp_server\" value=\"$$language{Apply}\" />\n";
! $body .= "<input type=\"hidden\" name=\"session\" value=\"$session_key\" />\n</form>\n";
! }
!
! if ( $name eq 'smtp_server_port' ) {
! $body .= "<form action=\"/security\">\n";
! $body .= "<label class=\"securityLabel\" for=\"securitySecurePort\">$$language{Security_SMTPPort}:</label><br />\n";
! $body .= "<input type=\"text\" name=\"smtp_chain_server_port\" id=\"securitySecurePort\" value=\"" . $self->config_( 'chain_port' ) . "\" />\n";
! $body .= "<input type=\"submit\" class=\"submit\" name=\"update_smtp_server_port\" value=\"$$language{Apply}\" />\n";
! $body .= "<input type=\"hidden\" name=\"session\" value=\"$session_key\" />\n</form>\n";
! }
!
! if ( $name eq 'smtp_force_fork' ) {
! $body .= "<span class=\"configurationLabel\">$$language{Configuration_SMTPFork}:</span><br />\n";
! $body .= "<table border=\"0\" cellpadding=\"0\" cellspacing=\"0\" summary=\"\"><tr><td nowrap=\"nowrap\">\n";
!
! if ( $self->config_( 'force_fork' ) == 0 ) {
! $body .= "<form action=\"/configuration\">\n";
! $body .= "<span class=\"securityWidgetStateOff\">$$language{No}</span>\n";
! $body .= "<input type=\"submit\" class=\"toggleOn\" id=\"windowTrayIconOn\" name=\"toggle\" value=\"$$language{ChangeToYes}\" />\n";
! $body .= "<input type=\"hidden\" name=\"smtp_force_fork\" value=\"1\" />\n";
! $body .= "<input type=\"hidden\" name=\"session\" value=\"$session_key\" />\n</form>\n";
! } else {
! $body .= "<form action=\"/configuration\">\n";
! $body .= "<span class=\"securityWidgetStateOn\">$$language{Yes}</span>\n";
! $body .= "<input type=\"submit\" class=\"toggleOn\" id=\"windowTrayIconOff\" name=\"toggle\" value=\"$$language{ChangeToNo}\" />\n";
! $body .= "<input type=\"hidden\" name=\"smtp_force_fork\" value=\"0\" />\n";
! $body .= "<input type=\"hidden\" name=\"session\" value=\"$session_key\" />\n</form>\n";
! }
! $body .= "</td></tr></table>\n";
! }
!
! return $body;
! }
!
! # ---------------------------------------------------------------------------------------------
! #
! # validate_item
! #
! # $name The name of the item being configured, was passed in by the call
! # to register_configuration_item
! # $language Reference to the hash holding the current language
! # $form Hash containing all form items
! #
! # Must return the HTML for this item
! # ---------------------------------------------------------------------------------------------
!
! sub validate_item
! {
! my ( $self, $name, $language, $form ) = @_;
!
! if ( $name eq 'smtp_port' ) {
! if ( defined($$form{smtp_port}) ) {
! if ( ( $$form{smtp_port} >= 1 ) && ( $$form{smtp_port} < 65536 ) ) {
! $self->config_( 'port', $$form{smtp_port} );
! return '<blockquote>' . sprintf( $$language{Configuration_POP3Update} . '</blockquote>' , $self->config_( 'port' ) );
! } else {
! return "<blockquote><div class=\"error01\">$$language{Configuration_Error3}</div></blockquote>";
! }
! }
! }
!
! if ( $name eq 'smtp_local' ) {
! $self->config_( 'local', $$form{smtp_local}-1 ) if ( defined($$form{smtp_local}) );
! }
!
! if ( $name eq 'smtp_server' ) {
! $self->config_( 'chain_server', $$form{smtp_chain_server} ) if ( defined($$form{smtp_chain_server}) );
! return sprintf( "<blockquote>" . $$language{Security_SMTPServerUpdate} . "</blockquote>", $self->config_( 'chain_server' ) ) if ( defined($$form{smtp_chain_server}) );
! }
!
! if ( $name eq 'smtp_server_port' ) {
! if ( defined($$form{smtp_chain_server_port}) ) {
! if ( ( $$form{smtp_chain_server_port} >= 1 ) && ( $$form{smtp_chain_server_port} < 65536 ) ) {
! $self->config_( 'chain_port', $$form{smtp_chain_server_port} );
! return sprintf( "<blockquote>" . $$language{Security_SMTPPortUpdate} . "</blockquote>", $self->config_( 'chain_port' ) ) if ( defined($$form{smtp_chain_chain_port}) );
! } else {
! return "<blockquote><div class=\"error01\">$$language{Security_Error1}</div></blockquote>";
! }
! }
! }
!
! if ( $name eq 'smtp_force_fork' ) {
! if ( defined($$form{smtp_force_fork}) ) {
! $self->config_( 'force_fork', $$form{smtp_force_fork} );
! }
! }
!
! return '';
! }
!
! 1;
--- 1,443 ----
! # POPFILE LOADABLE MODULE
! package Proxy::SMTP;
!
! use Proxy::Proxy;
! @ISA = ("Proxy::Proxy");
!
! # ---------------------------------------------------------------------------------------------
! #
! # This module handles proxying the SMTP protocol for POPFile.
! #
! # Copyright (c) 2001-2003 John Graham-Cumming
! #
! # This file is part of POPFile
! #
! # POPFile is free software; you can redistribute it and/or modify
! # it under the terms of the GNU General Public License as published by
! # the Free Software Foundation; either version 2 of the License, or
! # (at your option) any later version.
! #
! # POPFile is distributed in the hope that it will be useful,
! # but WITHOUT ANY WARRANTY; without even the implied warranty of
! # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! # GNU General Public License for more details.
! #
! # You should have received a copy of the GNU General Public License
! # along with POPFile; if not, write to the Free Software
! # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
! #
! # Modified by Sam Schinke (ssc...@us...)
! #
! # ---------------------------------------------------------------------------------------------
!
! use strict;
! use warnings;
! use locale;
!
! # A handy variable containing the value of an EOL for networks
! my $eol = "\015\012";
!
! #----------------------------------------------------------------------------
! # new
! #
! # Class new() function
! #----------------------------------------------------------------------------
! sub new
! {
! my $type = shift;
! my $self = Proxy::Proxy->new();
!
! # Must call bless before attempting to call any methods
!
! bless $self, $type;
!
! $self->name( 'smtp' );
!
! $self->{child_} = \&child__;
! $self->{connection_timeout_error_} = '554 Transaction failed';
! $self->{connection_failed_error_} = '554 Transaction failed, can\'t connect to';
! $self->{good_response_} = '^[23]';
!
! return $self;
! }
!
! # ---------------------------------------------------------------------------------------------
! #
! # initialize
! #
! # Called to initialize the SMTP proxy module
! #
! # ---------------------------------------------------------------------------------------------
! sub initialize
! {
! my ( $self ) = @_;
!
! # Disabled by default
! $self->config_( 'enabled', 0);
!
! # By default we don't fork on Windows
! $self->config_( 'force_fork', ($^O eq 'MSWin32')?0:1 );
!
! # Default port for SMTP service
! $self->config_( 'port', 25 );
!
! # Where to forward on to
! $self->config_( 'chain_server', '' );
! $self->config_( 'chain_port', 25 );
!
! # Only accept connections from the local machine for smtp
! $self->config_( 'local', 1 );
!
! # The welcome string from the proxy is configurable
! $self->config_( 'welcome_string', "SMTP POPFile ($self->{version_}) welcome" );
!
! # Tell the user interface module that we having a configuration
! # item that needs a UI component
!
! $self->register_configuration_item_( 'configuration',
! 'smtp_port',
! $self );
!
! $self->register_configuration_item_( 'configuration', # PROFILE BLOCK START
! 'smtp_force_fork',
! $self ); # PROFILE BLOCK STOP
!
! $self->register_configuration_item_( 'security',
! 'smtp_local',
! $self );
!
! $self->register_configuration_item_( 'chain',
! 'smtp_server',
! $self );
!
! $self->register_configuration_item_( 'chain',
! 'smtp_server_port',
! $self );
!
! return 1;
! }
!
! # ---------------------------------------------------------------------------------------------
! #
! # child__
! #
! # The worker method that is called when we get a good connection from a client
! #
! # $client - an open stream to a SMTP client
! # $download_count - The unique download count for this session
! #
! # ---------------------------------------------------------------------------------------------
! sub child__
! {
! my ( $self, $client, $download_count, $pipe, $ppipe, $pid ) = @_;
!
! # 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, "220 " . $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;
!
! $command = $_;
!
! # Clean up the command so that it has a nice clean $eol at the end
! $command =~ s/(\015|\012)//g;
!
! $self->log_( "Command: --$command--" );
!
! if ( $command =~ /HELO/i ) {
! if ( $self->config_( 'chain_server' ) ) {
! if ( $mail = $self->verify_connected_( $mail, $client, $self->config_( 'chain_server' ), $self->config_( 'chain_port' ) ) ) {
!
! $self->smtp_echo_response_( $mail, $client, $command );
!
!
! } else {
! last;
! }
! } else {
! $self->tee_( $client, "421 service not available$eol" );
! }
!
! next;
! }
!
! # Handle EHLO specially so we can control what ESMTP extensions are negotiated
!
! if ( $command =~ /EHLO/i ) {
! if ( $self->config_( 'chain_server' ) ) {
! if ( $mail = $self->verify_connected_( $mail, $client, $self->config_( 'chain_server' ), $self->config_( 'chain_port' ) ) ) {
!
! # TODO: Make this user-configurable (-smtp_add_unsupported, -smtp_remove_unsupported)
!
! # Stores a list of unsupported ESMTP extensions
!
! my $unsupported;
!
!
!
! # RFC 1830, http://www.faqs.org/rfcs/rfc1830.html
! # CHUNKING and BINARYMIME both require the support of the "BDAT" command
! # support of BDAT requires extensive changes to POPFile's internals and
! # will not be implemented at this time
!
! $unsupported .= "CHUNKING|BINARYMIME";
!
! # append unsupported ESMTP extensions to $unsupported here, important to maintain
! # format of OPTION|OPTION2|OPTION3
!
! $unsupported = qr/250\-$unsupported/;
!
! $self->smtp_echo_response_( $mail, $client, $command, $unsupported );
!
!
! } else {
! last;
! }
! } else {
! $self->tee_( $client, "421 service not available$eol" );
! }
!
! next;
! }
!
! if ( ( $command =~ /MAIL FROM:/i ) ||
! ( $command =~ /RCPT TO:/i ) ||
! ( $command =~ /VRFY/i ) ||
! ( $command =~ /EXPN/i ) ||
! ( $command =~ /NOOP/i ) ||
! ( $command =~ /HELP/i ) ||
! ( $command =~ /RSET/i ) ) {
! $self->smtp_echo_response_( $mail, $client, $command );
! next;
! }
!
! if ( $command =~ /DATA/i ) {
! # 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->smtp_echo_response_( $mail, $client, $command ) ) {
! $count += 1;
!
! my ( $class, $history_file ) = $self->{classifier__}->classify_and_modify( $client, $mail, $download_count, $count, 0, '' );
!
! # Tell the parent that we just handled a mail
! print $pipe "CLASS:$class$eol";
! print $pipe "NEWFL:$history_file$eol";
! flush $pipe;
! $self->yield_( $ppipe, $pid );
!
! my $response = <$mail>;
! $self->tee_( $client, $response );
! next;
! }
! }
!
! # The mail client wants to stop using the server, so send that message through to the
! # 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 ) {
! $self->smtp_echo_response_( $mail, $client, $command );
! close $mail;
! } else {
! $self->tee_( $client, "221 goodbye$eol" );
! }
! last;
! }
!
! # Don't know what this is so let's just pass it through and hope for the best
! if ( $mail && $mail->connected ) {
! $self->smtp_echo_response_( $mail, $client, $command );
! next;
! } else {
! $self->tee_( $client, "500 unknown command or bad syntax$eol" );
! last;
! }
! }
!
! close $mail if defined( $mail );
! close $client;
! print $pipe "CMPLT$eol";
! flush $pipe;
! $self->yield_( $ppipe, $pid );
! close $pipe;
! }
!
! # ---------------------------------------------------------------------------------------------
! #
! # smtp_echo_response_
! #
! # $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
! # $command The text of the command to send (we add an EOL)
! # $suppress (OPTIONAL) suppress any lines that match, compile using qr/pattern/
! #
! # Send $command to $mail, receives the response and echoes it to the $client and the debug
! # output.
! #
! # This subroutine returns responses from the server as defined in appendix E of
! # RFC 821, allowing multi-line SMTP responses.
! #
! # Returns true if the initial response is a 2xx or 3xx series (as defined by {good_response_}
! #
! # ---------------------------------------------------------------------------------------------
! sub smtp_echo_response_
! {
! my ($self, $mail, $client, $command, $suppress) = @_;
! my ( $response, $ok ) = $self->get_response_( $mail, $client, $command );
!
! if ( $response =~ /^\d\d\d-/ ) {
! $self->echo_to_regexp_($mail, $client, qr/^\d\d\d /, 1, $suppress);
! }
! return ( $response =~ /$self->{good_response_}/ );
! }
!
! # ---------------------------------------------------------------------------------------------
! #
! # configure_item
! #
! # $name The name of the item being configured, was passed in by the call
! # to register_configuration_item
! # $language Reference to the hash holding the current language
! # $session_key The current session key
! #
! # Must return the HTML for this item
! # ---------------------------------------------------------------------------------------------
!
! sub configure_item
! {
! my ( $self, $name, $language, $session_key ) = @_;
!
! my $body;
!
! if ( $name eq 'smtp_port' ) {
! $body .= "<form action=\"/configuration\">\n";
! $body .= "<label class=\"configurationLabel\" for=\"configPopPort\">$$language{Configuration_SMTPPort}:</label><br />\n";
! $body .= "<input name=\"smtp_port\" type=\"text\" id=\"configPopPort\" value=\"" . $self->config_( 'port' ) . "\" />\n";
! $body .= "<input type=\"submit\" class=\"submit\" name=\"update_smtp_port\" value=\"$$language{Apply}\" />\n";
! $body .= "<input type=\"hidden\" name=\"session\" value=\"$session_key\" />\n</form>\n";
! }
!
! if ( $name eq 'smtp_local' ) {
! $body .= "<span class=\"securityLabel\">$$language{Security_SMTP}:</span><br />\n";
!
! $body .= "<table border=\"0\" cellpadding=\"0\" cellspacing=\"0\" summary=\"\"><tr><td nowrap=\"nowrap\">\n";
! if ( $self->config_( 'local' ) == 1 ) {
! $body .= "<form class=\"securitySwitch\" action=\"/security\">\n";
! $body .= "<span class=\"securityWidgetStateOff\">$$language{Security_NoStealthMode}</span>\n";
! $body .= "<input type=\"submit\" class=\"toggleOn\" id=\"securityAcceptPOP3On\" name=\"toggle\" value=\"$$language{ChangeToYes}\" />\n";
! $body .= "<input type=\"hidden\" name=\"smtp_local\" value=\"1\" />\n";
! $body .= "<input type=\"hidden\" name=\"session\" value=\"$session_key\" />\n</form>\n";
! } else {
! $body .= "<form class=\"securitySwitch\" action=\"/security\">\n";
! $body .= "<span class=\"securityWidgetStateOn\">$$language{Yes}</span>\n";
! $body .= "<input type=\"submit\" class=\"toggleOff\" id=\"securityAcceptPOP3Off\" name=\"toggle\" value=\"$$language{ChangeToNo} (Stealth Mode)\" />\n";
! $body .= "<input type=\"hidden\" name=\"smtp_local\" value=\"2\" />\n";
! $body .= "<input type=\"hidden\" name=\"session\" value=\"$session_key\" />\n</form>\n";
! }
! $body .= "</td></tr></table>\n";
! }
!
! if ( $name eq 'smtp_server' ) {
! $body .= "<form action=\"/security\">\n";
! $body .= "<label class=\"securityLabel\" for=\"securitySecureServer\">$$language{Security_SMTPServer}:</label><br />\n";
! $body .= "<input type=\"text\" name=\"smtp_chain_server\" id=\"securitySecureServer\" value=\"" . $self->config_( 'chain_server' ) . "\" />\n";
! $body .= "<input type=\"submit\" class=\"submit\" name=\"update_smtp_server\" value=\"$$language{Apply}\" />\n";
! $body .= "<input type=\"hidden\" name=\"session\" value=\"$session_key\" />\n</form>\n";
! }
!
! if ( $name eq 'smtp_server_port' ) {
! $body .= "<form action=\"/security\">\n";
! $body .= "<label class=\"securityLabel\" for=\"securitySecurePort\">$$language{Security_SMTPPort}:</label><br />\n";
! $body .= "<input type=\"text\" name=\"smtp_chain_server_port\" id=\"securitySecurePort\" value=\"" . $self->config_( 'chain_port' ) . "\" />\n";
! $body .= "<input type=\"submit\" class=\"submit\" name=\"update_smtp_server_port\" value=\"$$language{Apply}\" />\n";
! $body .= "<input type=\"hidden\" name=\"session\" value=\"$session_key\" />\n</form>\n";
! }
!
! if ( $name eq 'smtp_force_fork' ) {
! $body .= "<span class=\"configurationLabel\">$$language{Configuration_SMTPFork}:</span><br />\n";
! $body .= "<table border=\"0\" cellpadding=\"0\" cellspacing=\"0\" summary=\"\"><tr><td nowrap=\"nowrap\">\n";
!
! if ( $self->config_( 'force_fork' ) == 0 ) {
! $body .= "<form action=\"/configuration\">\n";
! $body .= "<span class=\"securityWidgetStateOff\">$$language{No}</span>\n";
! $body .= "<input type=\"submit\" class=\"toggleOn\" id=\"windowTrayIconOn\" name=\"toggle\" value=\"$$language{ChangeToYes}\" />\n";
! $body .= "<input type=\"hidden\" name=\"smtp_force_fork\" value=\"1\" />\n";
! $body .= "<input type=\"hidden\" name=\"session\" value=\"$session_key\" />\n</form>\n";
! } else {
! $body .= "<form action=\"/configuration\">\n";
! $body .= "<span class=\"securityWidgetStateOn\">$$language{Yes}</span>\n";
! $body .= "<input type=\"submit\" class=\"toggleOn\" id=\"windowTrayIconOff\" name=\"toggle\" value=\"$$language{ChangeToNo}\" />\n";
! $body .= "<input type=\"hidden\" name=\"smtp_force_fork\" value=\"0\" />\n";
! $body .= "<input type=\"hidden\" name=\"session\" value=\"$session_key\" />\n</form>\n";
! }
! $body .= "</td></tr></table>\n";
! }
!
! return $body;
! }
!
! # ---------------------------------------------------------------------------------------------
! #
! # validate_item
! #
! # $name The name of the item being configured, was passed in by the call
! # to register_configuration_item
! # $language Reference to the hash holding the current language
! # $form Hash containing all form items
! #
! # Must return the HTML for this item
! # ---------------------------------------------------------------------------------------------
!
! sub validate_item
! {
! my ( $self, $name, $language, $form ) = @_;
!
! if ( $name eq 'smtp_port' ) {
! if ( defined($$form{smtp_port}) ) {
! if ( ( $$form{smtp_port} >= 1 ) && ( $$form{smtp_port} < 65536 ) ) {
! $self->config_( 'port', $$form{smtp_port} );
! return '<blockquote>' . sprintf( $$language{Configuration_POP3Update} . '</blockquote>' , $self->config_( 'port' ) );
! } else {
! return "<blockquote><div class=\"error01\">$$language{Configuration_Error3}</div></blockquote>";
! }
! }
! }
!
! if ( $name eq 'smtp_local' ) {
! $self->config_( 'local', $$form{smtp_local}-1 ) if ( defined($$form{smtp_local}) );
! }
!
! if ( $name eq 'smtp_server' ) {
! $self->config_( 'chain_server', $$form{smtp_chain_server} ) if ( defined($$form{smtp_chain_server}) );
! return sprintf( "<blockquote>" . $$language{Security_SMTPServerUpdate} . "</blockquote>", $self->config_( 'chain_server' ) ) if ( defined($$form{smtp_chain_server}) );
! }
!
! if ( $name eq 'smtp_server_port' ) {
! if ( defined($$form{smtp_chain_server_port}) ) {
! if ( ( $$form{smtp_chain_server_port} >= 1 ) && ( $$form{smtp_chain_server_port} < 65536 ) ) {
! $self->config_( 'chain_port', $$form{smtp_chain_server_port} );
! return sprintf( "<blockquote>" . $$language{Security_SMTPPortUpdate} . "</blockquote>", $self->config_( 'chain_port' ) ) if ( defined($$form{smtp_chain_chain_port}) );
! } else {
! return "<blockquote><div class=\"error01\">$$language{Security_Error1}</div></blockquote>";
! }
! }
! }
!
! if ( $name eq 'smtp_force_fork' ) {
! if ( defined($$form{smtp_force_fork}) ) {
! $self->config_( 'force_fork', $$form{smtp_force_fork} );
! }
! }
!
! return '';
! }
!
! 1;
|
|
From: <ssc...@us...> - 2003-11-10 10:37:30
|
Update of /cvsroot/popfile/engine/POPFile
In directory sc8-pr-cvs1:/tmp/cvs-serv17911
Modified Files:
Loader.pm
Log Message:
Roadmap feature addition: Dis/enabling of optional POPFile Loadable Modules.
Updating past this point may require re-setting some modules as enabled
Optional modules (All Proxies, and non-html UI's) have a -module_enabled
boolean configuration parameter
Index: Loader.pm
===================================================================
RCS file: /cvsroot/popfile/engine/POPFile/Loader.pm,v
retrieving revision 1.12
retrieving revision 1.13
diff -C2 -d -r1.12 -r1.13
*** Loader.pm 5 Nov 2003 15:08:23 -0000 1.12
--- Loader.pm 10 Nov 2003 10:37:27 -0000 1.13
***************
*** 7,13 ****
#
# Subroutine names beginning with CORE indicate a subroutine designed for exclusive use of
! # POPFile's core application (popfile.pl).
#
! # Subroutines not so marked are suitable for use by POPFile-based utilities to assist in loading
# and executing modules
#
--- 7,13 ----
#
# Subroutine names beginning with CORE indicate a subroutine designed for exclusive use of
! # POPFile's core application (popfile.pl).
#
! # Subroutines not so marked are suitable for use by POPFile-based utilities to assist in loading
# and executing modules
#
***************
*** 30,33 ****
--- 30,35 ----
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
+ # Modified by Sam Schinke (ssc...@us...)
+ #
# ---------------------------------------------------------------------------------------------
***************
*** 49,52 ****
--- 51,60 ----
$self->{components__} = {};
+ $self->{disabled_components__} = {};
+
+ # Do not allow disabling of the following components (group or name)
+
+ $self->{required_components__} = qr/^(core|html|bayes)$/;
+
# A handy boolean that tells us whether we are alive or not. When this is set to 1 then the
# proxy works normally, when set to 0 (typically by the aborting() function called from a signal)
***************
*** 534,537 ****
--- 542,546 ----
print '} ' if $self->{debug__};
}
+ print "\n";
}
***************
*** 565,569 ****
my ( $self ) = @_;
! print "\n\n Starting... " if $self->{debug__};
# Now that the configuration is set tell each module to begin operation
--- 574,578 ----
my ( $self ) = @_;
! print "\n Starting... " if $self->{debug__};
# Now that the configuration is set tell each module to begin operation
***************
*** 583,586 ****
--- 592,629 ----
print "\n\nPOPFile Engine ", scalar($self->CORE_version()), " running\n" if $self->{debug__};
flush STDOUT;
+ }
+
+ #---------------------------------------------------------------------------------------------
+ #
+ # CORE_enabled_check
+ #
+ # Prevents calling of start and service of disabled optional modules
+ #
+ #---------------------------------------------------------------------------------------------
+ sub CORE_enabled_check
+ {
+ my ( $self ) = @_;
+
+ # Check all currently enabled components
+
+ foreach my $type (keys %{$self->{components__}}) {
+ unless ( $type =~ $self->{required_components__} ) {
+ foreach my $name (keys %{$self->{components__}{$type}}) {
+ unless ( ( $name =~ $self->{required_components__} )
+ || ( defined($self->{components__}{$type}{$name}->config_( 'enabled' ) )
+ && $self->{components__}{$type}{$name}->config_( 'enabled' ) ) ) {
+
+ # If the component is optional and is disabled, move it to a holding
+ # hash. This is done this way to allow recovery/re-enabling of objects
+ # (eg, HUP) and to leave them intact for interface plugin configuration.
+ $self->{disabled_components__}{$type}{$name} = $self->{components__}{$type}{$name};
+ delete $self->{components__}{$type}{$name};
+ }
+ }
+ }
+ }
+
+ # Re-enable any disabled components that are now enabled
+ # TODO: implement this when POPFile needs to be able to handle a HUP.
}
|
11 messages has been excluded from this view by a project administrator.
