Menu
▾
▴
[popfile-commit] engine/POPFile Configuration.pm, 1.65, 1.66 Database.pm, 1.9, 1.10 History.pm, 1.53, 1.54 Loader.pm, 1.37, 1.38 Logger.pm, 1.46, 1.47 MQ.pm, 1.24, 1.25 Module.pm, 1.54, 1.55 Mutex.pm, 1.5, 1.6
Update of /cvsroot/popfile/engine/POPFile In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv20326/POPFile Modified Files: Configuration.pm Database.pm History.pm Loader.pm Logger.pm MQ.pm Module.pm Mutex.pm Log Message: Change Log 1. UI and POP3 proxy are now able to be connected via SSL 2. New Proxy module 'Proxy::POP3S' (POP3 over SSL) 3. New global options: GLOBAL_cert_file, GLOBAL_key_file, GLOBAL_ca_file 4. New html options: html_https_enabled, html_https_port 5. Secure cookies are used when accessed to the HTTPS server Proxy/POP3S.pm Proxy/POP3.pm Proxy/Proxy.pm UI/HTML.pm UI/HTTP.pm POPFile/Configuration.pm Classifier/Bayes.pm skins/default/pop3s-configuration-panel.thtml skins/default/pop3s-security-panel.thtml tests/Configuration.tst The new Proxy::POP3S module supports connections via SSL. It has following options: pop3s_enabled Enable(=1)/Disable(=0;default) the module pop3s_force_fork Enable(=1)/Disable(=0) forking pop3s_local Allow(=1)/Disallow(=0) connections from remote pop3s_port POP3S proxy port(default:995) pop3s_socks_port SOCKS proxy port pop3s_socks_server SOCKS proxy server pop3s_welcome_string POP3S proxy welcome string The other POP3 options (e.g. pop3_separator) are same as the Proxy::POP3 module. Here's the new options of the UI::HTML module: html_https_enabled Enable(=1)/Disable(=0;default) the HTTPS server html_https_port HTTPS server port(default:8443) The new global options: GLOBAL_cert_file Location of the certification file of the server GLOBAL_key_file Location of the key file of the server GLOBAL_ca_file Location of the CA file NOTE: I've implemented POP3S and the HTTPS in the different way. I've made a new module Proxy::POP3S for POP3S, but I don't make the module for HTTPS. This is because I think making the new module for HTTPS ( UI:HTTPS ? ) is very hard. BUG: Concurrent POP3S connections cause an error in some environment: SSL3 alert write:fatal:bad record mac 7664:error:1408F119:SSL routines:SSL3_GET_RECORD:decryption failed or bad record mac:s3_pkt.c:424: 6. AUTH PLAIN support Proxy/POP3.pm 7. Supress the verbose status messages on the administration tab 8. Add some status messages (administration tab) UI/HTML.pm UI/XMLRPC.pm Proxy/Proxy.pm Proxy/POP3.pm Proxy/NNTP.pm Proxy/SMTP.pm languages/English.msg languages/Nihongo.msg tests/TestPOP3.tst tests/TestHTML.script 9. The message files are no longer cached by the web browser UI/HTTP.pm 10. if html_allow_javascript == 0, don't disable the radio buttons skins/default/administration-page.thtml skins/default/pop3-security-panel.thtml skins/default/nntp-security-local.thtml skins/default/smtp-security-local.thtml skins/default/xmlrpc-local.thtml 11. Minor updates of the skins skins/smtp-chain-server.thtml skins/smtp-chain-server-port.thtml (merged to the above file) skins/pop3-chain-panel.thtml 12. Source code cleanup UI/HTML.pm UI/HTTP.pm UI/XMLRPC.pm Proxy/POP3.pm Proxy/Proxy.pm Proxy/NNTP.pm Proxy/SMTP.pm Classifier/Bayes.pm Classifier/MailParse.pm POPFile/Configuration.pm POPFile/Database.pm POPFile/History.pm POPFile/Loader.pm POPFile/Logger.pm POPFile/Module.pm POPFile/MQ.pm POPFile/Mutex.pm Add some 'PROFILE BLOCK START' and 'PROFILE BLOCK STOP's. These are used by Devel::TestCoverage to get the correct coverage. 13. Add some tests tests/TestBayes.tst Current state of the test suite: TestBayesScript PASS TestBayes PASS TestConfiguration PASS * TestHistory PASS TestHTML PASS * TestHTTP PASS TestIMAP PASS TestInsertScript PASS * TestLogger PASS TestMailParse PASS TestModule PASS TestMQ PASS TestMutex PASS TestPipeScript PASS TestPOP3 PASS TestProxy PASS TestWordMangle PASS TestXMLRPC PASS * : TODO : needs to add tests for multi user support Index: History.pm =================================================================== RCS file: /cvsroot/popfile/engine/POPFile/History.pm,v retrieving revision 1.53 retrieving revision 1.54 diff -C2 -d -r1.53 -r1.54 *** History.pm 17 Apr 2008 15:13:04 -0000 1.53 --- History.pm 25 Apr 2008 16:26:17 -0000 1.54 *************** *** 36,41 **** use Digest::MD5 qw( md5_hex ); ! my $fields_slot = 'history.id, hdr_from, hdr_to, hdr_cc, hdr_subject, ! hdr_date, hash, inserted, buckets.name, usedtobe, history.bucketid, magnets.val, size, history.magnetid'; #---------------------------------------------------------------------------- --- 36,42 ---- use Digest::MD5 qw( md5_hex ); ! my $fields_slot = # PROFILE BLOCK START ! 'history.id, hdr_from, hdr_to, hdr_cc, hdr_subject, hdr_date, hash, inserted, ! buckets.name, usedtobe, history.bucketid, magnets.val, size, history.magnetid'; # PROFILE BLOCK STOP #---------------------------------------------------------------------------- *************** *** 255,260 **** $self->db_()->begin_work unless ($in_transaction); ! my $test = $self->db_()->selectrow_arrayref( ! "select id from history where committed = $r limit 1;"); if ( defined( $test ) ) { --- 256,261 ---- $self->db_()->begin_work unless ($in_transaction); ! my $test = $self->db_()->selectrow_arrayref( # PROFILE BLOCK START ! "select id from history where committed = $r limit 1;" ); # PROFILE BLOCK STOP if ( defined( $test ) ) { *************** *** 268,278 **** my $now = time; ! $self->db_()->do( ! "insert into history ( userid, committed, inserted ) values ( $userid, $r, $now );" ); last; } ! my $result = $self->db_()->selectrow_arrayref( ! "select id from history where committed = $r limit 1;"); $self->db_()->commit unless ($in_transaction); --- 269,279 ---- my $now = time; ! $self->db_()->do( # PROFILE BLOCK START ! "insert into history ( userid, committed, inserted ) values ( $userid, $r, $now );" ); # PROFILE BLOCK STOP last; } ! my $result = $self->db_()->selectrow_arrayref( # PROFILE BLOCK START ! "select id from history where committed = $r limit 1;" ); # PROFILE BLOCK STOP $self->db_()->commit unless ($in_transaction); *************** *** 377,382 **** # and update the database ! my $bucketid = $self->classifier_()->get_bucket_id( ! $session, $class ); my $oldbucketid = 0; --- 378,383 ---- # and update the database ! my $bucketid = $self->classifier_()->get_bucket_id( # PROFILE BLOCK START ! $session, $class ); # PROFILE BLOCK STOP my $oldbucketid = 0; *************** *** 386,392 **** } ! $self->db_()->do( "update history set bucketid = $bucketid, ! usedtobe = $oldbucketid ! where id = $slot;" ); $self->force_requery__(); } --- 387,394 ---- } ! $self->db_()->do( # PROFILE BLOCK START ! "update history set bucketid = $bucketid, ! usedtobe = $oldbucketid ! where id = $slot;" ); # PROFILE BLOCK STOP $self->force_requery__(); } *************** *** 410,416 **** my $oldbucketid = $fields[9]; ! $self->db_()->do( "update history set bucketid = $oldbucketid, ! usedtobe = 0 ! where id = $slot;" ); $self->force_requery__(); } --- 412,419 ---- my $oldbucketid = $fields[9]; ! $self->db_()->do( # PROFILE BLOCK START ! "update history set bucketid = $oldbucketid, ! usedtobe = 0 ! where id = $slot;" ); # PROFILE BLOCK STOP $self->force_requery__(); } *************** *** 433,442 **** return undef if ( !defined($userid) ); ! return $self->db_()->selectrow_array( "select $fields_slot from history, buckets, magnets where history.id = $slot and history.userid = $userid and buckets.id = history.bucketid and ! magnets.id = magnetid;" ); } --- 436,445 ---- return undef if ( !defined($userid) ); ! return $self->db_()->selectrow_array( # PROFILE BLOCK START "select $fields_slot from history, buckets, magnets where history.id = $slot and history.userid = $userid and buckets.id = history.bucketid and ! magnets.id = magnetid;" ); # PROFILE BLOCK STOP } *************** *** 458,465 **** return 0 if ( !defined($userid) ); ! my @row = $self->db_()->selectrow_array( "select id from history where history.id = $slot and ! history.userid = $userid;" ); return ( ( @row ) && ( $row[0] == $slot ) ); --- 461,468 ---- return 0 if ( !defined($userid) ); ! my @row = $self->db_()->selectrow_array( # PROFILE BLOCK START "select id from history where history.id = $slot and ! history.userid = $userid;" ); # PROFILE BLOCK STOP return ( ( @row ) && ( $row[0] == $slot ) ); *************** *** 540,546 **** foreach my $h (@sortable) { ! $sort_headers{$h} = $self->classifier_()->{parser__}->decode_string( ! ${$header{$h}}[0] ); $sort_headers{$h} = lc($sort_headers{$h} || ''); $sort_headers{$h} =~ s/[\"<>]//g; --- 543,549 ---- foreach my $h (@sortable) { ! $sort_headers{$h} = # PROFILE BLOCK START $self->classifier_()->{parser__}->decode_string( ! ${$header{$h}}[0] ); # PROFILE BLOCK STOP $sort_headers{$h} = lc($sort_headers{$h} || ''); $sort_headers{$h} =~ s/[\"<>]//g; *************** *** 556,561 **** } ! $sort_headers{$h} = $self->db_()->quote( ! $sort_headers{$h} ); } --- 559,564 ---- } ! $sort_headers{$h} = $self->db_()->quote( # PROFILE BLOCK START ! $sort_headers{$h} ); # PROFILE BLOCK STOP } *************** *** 566,572 **** foreach my $h (@required) { ! ${$header{$h}}[0] = $self->classifier_()->{parser__}->decode_string( ! ${$header{$h}}[0] ); if ( !defined ${$header{$h}}[0] || ${$header{$h}}[0] =~ /^\s*$/ ) { --- 569,575 ---- foreach my $h (@required) { ! ${$header{$h}}[0] = # PROFILE BLOCK START $self->classifier_()->{parser__}->decode_string( ! ${$header{$h}}[0] ); # PROFILE BLOCK STOP if ( !defined ${$header{$h}}[0] || ${$header{$h}}[0] =~ /^\s*$/ ) { *************** *** 597,602 **** # defined) ! my $bucketid = $self->classifier_()->get_bucket_id( ! $session, $bucket ); my $msg_size = -s $file; --- 600,605 ---- # defined) ! my $bucketid = $self->classifier_()->get_bucket_id( # PROFILE BLOCK START ! $session, $bucket ); # PROFILE BLOCK STOP my $msg_size = -s $file; *************** *** 608,612 **** if ( defined( $bucketid ) ) { ! my $result = $self->db_()->do( "update history set hdr_from = ${$header{from}}[0], hdr_to = ${$header{to}}[0], --- 611,615 ---- if ( defined( $bucketid ) ) { ! my $result = $self->db_()->do( # PROFILE BLOCK START "update history set hdr_from = ${$header{from}}[0], hdr_to = ${$header{to}}[0], *************** *** 624,628 **** hash = $hash, size = $msg_size ! where id = $slot;" ); } else { $self->log_( 0, "Couldn't find bucket ID for bucket $bucket when committing $slot" ); --- 627,631 ---- hash = $hash, size = $msg_size ! where id = $slot;" ); # PROFILE BLOCK STOP } else { $self->log_( 0, "Couldn't find bucket ID for bucket $bucket when committing $slot" ); *************** *** 659,672 **** my @b; if ( $cleanup ) { ! @b = $self->db_()->selectrow_array( "select buckets.name from history, buckets where history.bucketid = buckets.id and ! history.id = $slot;" ); } else { ! @b = $self->db_()->selectrow_array( "select buckets.name from history, buckets where history.bucketid = buckets.id and history.userid = $userid and ! history.id = $slot;" ); } --- 662,675 ---- my @b; if ( $cleanup ) { ! @b = $self->db_()->selectrow_array( # PROFILE BLOCK START "select buckets.name from history, buckets where history.bucketid = buckets.id and ! history.id = $slot;" ); # PROFILE BLOCK STOP } else { ! @b = $self->db_()->selectrow_array( # PROFILE BLOCK START "select buckets.name from history, buckets where history.bucketid = buckets.id and history.userid = $userid and ! history.id = $slot;" ); # PROFILE BLOCK STOP } *************** *** 682,687 **** $self->make_directory__( $path ); ! if ( ( $bucket ne 'unclassified' ) && ! ( $bucket ne 'unknown class' ) ) { $path .= "\/" . $bucket; $self->make_directory__( $path ); --- 685,690 ---- $self->make_directory__( $path ); ! if ( ( $bucket ne 'unclassified' ) && # PROFILE BLOCK START ! ( $bucket ne 'unknown class' ) ) { # PROFILE BLOCK STOP $path .= "\/" . $bucket; $self->make_directory__( $path ); *************** *** 691,696 **** # Archive to a random sub-directory of the bucket archive ! my $subdirectory = int( rand( ! $self->config_( 'archive_classes' ) ) ); $path .= "\/" . $subdirectory; $self->make_directory__( $path ); --- 694,699 ---- # Archive to a random sub-directory of the bucket archive ! my $subdirectory = int( rand( # PROFILE BLOCK START ! $self->config_( 'archive_classes' ) ) ); # PROFILE BLOCK STOP $path .= "\/" . $subdirectory; $self->make_directory__( $path ); *************** *** 773,779 **** my $hex_slot = sprintf( '%8.8x', $slot ); ! my $path = $self->get_user_path_( $self->path_join( $self->global_config_( 'msgdir' ), ! substr( $hex_slot, 0, 2 ) . '/' ), 0 ); $self->make_directory__( $path ); --- 776,782 ---- my $hex_slot = sprintf( '%8.8x', $slot ); ! my $path = $self->get_user_path_( # PROFILE BLOCK START $self->path_join( $self->global_config_( 'msgdir' ), ! substr( $hex_slot, 0, 2 ) . '/' ), 0 ); # PROFILE BLOCK STOP $self->make_directory__( $path ); *************** *** 783,788 **** $self->make_directory__( $path ); ! my $file = 'popfile' . ! substr( $hex_slot, 6, 2 ) . '.msg'; return $path . $file; --- 786,791 ---- $self->make_directory__( $path ); ! my $file = 'popfile' . # PROFILE BLOCK START ! substr( $hex_slot, 6, 2 ) . '.msg'; # PROFILE BLOCK STOP return $path . $file; *************** *** 836,841 **** $hash = $self->db_()->quote( $hash ); ! my $result = $self->db_()->selectrow_arrayref( ! "select id from history where hash = $hash limit 1;" ); return defined( $result )?$result->[0]:''; --- 839,844 ---- $hash = $self->db_()->quote( $hash ); ! my $result = $self->db_()->selectrow_arrayref( # PROFILE BLOCK START ! "select id from history where hash = $hash limit 1;" ); # PROFILE BLOCK STOP return defined( $result )?$result->[0]:''; *************** *** 942,948 **** # then do no work here ! if ( defined( $self->{queries__}{$id}{fields} ) && ( $self->{queries__}{$id}{fields} eq ! "$filter:$search:$sort:$not" ) ) { return; } --- 945,951 ---- # then do no work here ! if ( defined( $self->{queries__}{$id}{fields} ) && # PROFILE BLOCK START ( $self->{queries__}{$id}{fields} eq ! "$filter:$search:$sort:$not" ) ) { # PROFILE BLOCK STOP return; } *************** *** 979,989 **** if ( $filter ne '' ) { if ( $filter eq '__filter__magnet' ) { ! $self->{queries__}{$id}{base} .= ! " and history.magnetid $equal 0"; } else { ! my $bucketid = $self->classifier_()->get_bucket_id( ! $self->{queries__}{$id}{session}, $filter ); ! $self->{queries__}{$id}{base} .= ! " and history.bucketid $not_equal $bucketid"; } } --- 982,992 ---- if ( $filter ne '' ) { if ( $filter eq '__filter__magnet' ) { ! $self->{queries__}{$id}{base} .= # PROFILE BLOCK START ! " and history.magnetid $equal 0"; # PROFILE BLOCK STOP } else { ! my $bucketid = $self->classifier_()->get_bucket_id( # PROFILE BLOCK START ! $self->{queries__}{$id}{session}, $filter ); # PROFILE BLOCK STOP ! $self->{queries__}{$id}{base} .= # PROFILE BLOCK START ! " and history.bucketid $not_equal $bucketid"; # PROFILE BLOCK STOP } } *************** *** 1020,1025 **** $count =~ s/XXX/COUNT(*)/; ! $self->{queries__}{$id}{count} = ! $self->db_()->selectrow_arrayref( $count )->[0]; my $select = $self->{queries__}{$id}{base}; --- 1023,1028 ---- $count =~ s/XXX/COUNT(*)/; ! $self->{queries__}{$id}{count} = # PROFILE BLOCK START ! $self->db_()->selectrow_arrayref( $count )->[0]; # PROFILE BLOCK STOP my $select = $self->{queries__}{$id}{base}; *************** *** 1111,1117 **** $self->log_( 2, "Getting $rows rows from database" ); $self->{queries__}{$id}{query}->execute; ! $self->{queries__}{$id}{cache} = $self->{queries__}{$id}{query}->fetchall_arrayref( ! undef, $start + $count - 1 ); $self->{queries__}{$id}{query}->finish; } --- 1114,1120 ---- $self->log_( 2, "Getting $rows rows from database" ); $self->{queries__}{$id}{query}->execute; ! $self->{queries__}{$id}{cache} = # PROFILE BLOCK START $self->{queries__}{$id}{query}->fetchall_arrayref( ! undef, $start + $count - 1 ); # PROFILE BLOCK STOP $self->{queries__}{$id}{query}->finish; } *************** *** 1182,1188 **** # upgrade them by placing them in the database ! my @msgs = sort compare_mf__ glob $self->get_user_path_( $self->path_join( $self->global_config_( 'msgdir' ), ! 'popfile*.msg' ), 0 ); if ( $#msgs != -1 ) { --- 1185,1191 ---- # upgrade them by placing them in the database ! my @msgs = sort compare_mf__ glob $self->get_user_path_( # PROFILE BLOCK START $self->path_join( $self->global_config_( 'msgdir' ), ! 'popfile*.msg' ), 0 ); # PROFILE BLOCK STOP if ( $#msgs != -1 ) { *************** *** 1204,1209 **** # upgraded history will have no magnet information. ! my ( $reclassified, $bucket, $usedtobe, $magnet ) = ! $self->history_read_class__( $msg ); if ( $bucket ne 'unknown_class' ) { --- 1207,1212 ---- # upgraded history will have no magnet information. ! my ( $reclassified, $bucket, $usedtobe, $magnet ) = # PROFILE BLOCK START ! $self->history_read_class__( $msg ); # PROFILE BLOCK STOP if ( $bucket ne 'unknown_class' ) { *************** *** 1223,1229 **** $self->classifier_()->release_session_key( $session ); ! unlink $self->get_user_path_( $self->path_join( $self->global_config_( 'msgdir' ), ! 'history_cache' ), 0 ); } } --- 1226,1232 ---- $self->classifier_()->release_session_key( $session ); ! unlink $self->get_user_path_( # PROFILE BLOCK START $self->path_join( $self->global_config_( 'msgdir' ), ! 'history_cache' ), 0 ); # PROFILE BLOCK STOP } } *************** *** 1258,1263 **** if ( open CLASS, "<$filename" ) { $bucket = <CLASS>; ! if ( defined( $bucket ) && ! ( $bucket =~ /([^ ]+) MAGNET ([^\r\n]+)/ ) ) { $bucket = $1; $magnet = $2; --- 1261,1266 ---- if ( open CLASS, "<$filename" ) { $bucket = <CLASS>; ! if ( defined( $bucket ) && # PROFILE BLOCK START ! ( $bucket =~ /([^ ]+) MAGNET ([^\r\n]+)/ ) ) { # PROFILE BLOCK STOP $bucket = $1; $magnet = $2; *************** *** 1301,1310 **** my @ids; ! my $d = $self->db_()->prepare( "select id from history ! where userid = ? and ! inserted < ?;" ); foreach my $userid ( keys %$users ) { ! my $old = time - $self->user_config_( $userid, 'history_days' ) * ! $seconds_per_day; $d->execute( $userid, $old ); my @row; --- 1304,1314 ---- my @ids; ! my $d = $self->db_()->prepare( # PROFILE BLOCK START ! "select id from history ! where userid = ? and ! inserted < ?;" ); # PROFILE BLOCK STOP foreach my $userid ( keys %$users ) { ! my $old = time - $self->user_config_( $userid, 'history_days' ) * # PROFILE BLOCK START ! $seconds_per_day; # PROFILE BLOCK STOP $d->execute( $userid, $old ); my @row; Index: Configuration.pm =================================================================== RCS file: /cvsroot/popfile/engine/POPFile/Configuration.pm,v retrieving revision 1.65 retrieving revision 1.66 diff -C2 -d -r1.65 -r1.66 *** Configuration.pm 17 Apr 2008 15:13:04 -0000 1.65 --- Configuration.pm 25 Apr 2008 16:26:17 -0000 1.66 *************** *** 158,161 **** --- 158,167 ---- $self->global_config_( 'session_timeout', 1800 ); + # Files used for the incoming SSL connections + + $self->global_config_( 'cert_file', './certs/server-cert.pem' ); + $self->global_config_( 'key_file', './certs/server-key.pem' ); + $self->global_config_( 'ca_file', './certs/ca.pem' ); + # Register for the TICKD message which is sent hourly by the # Logger module. We use this to hourly save the configuration file *************** *** 200,206 **** } ! $self->{pid_file__} = $self->get_user_path( $self->path_join( $self->config_( 'piddir' ), ! 'popfile.pid' ), 0 ) ; if (defined($self->live_check_())) { --- 206,212 ---- } ! $self->{pid_file__} = $self->get_user_path( $self->path_join( # PROFILE BLOCK START $self->config_( 'piddir' ), ! 'popfile.pid' ), 0 ) ; # PROFILE BLOCK STOP if (defined($self->live_check_())) { *************** *** 594,599 **** if (defined($self->{configuration_parameters__}{$parameter})) { ! $self->{configuration_parameters__}{$parameter}{value} = ! $value; } else { $self->{deprecated_parameters__}{$parameter} = $value; --- 600,605 ---- if (defined($self->{configuration_parameters__}{$parameter})) { ! $self->{configuration_parameters__}{$parameter}{value} = # PROFILE BLOCK START ! $value; # PROFILE BLOCK STOP } else { $self->{deprecated_parameters__}{$parameter} = $value; *************** *** 678,684 **** $sandbox = 1 if ( !defined( $sandbox ) ); ! if ( ( $right =~ /^\// ) || ( $right =~ /^[A-Za-z]:[\/\\]/ ) || ! ( $right =~ /\\\\/ ) ) { if ( $sandbox ) { $self->log_( 0, "Attempt to access path $right outside sandbox" ); --- 684,690 ---- $sandbox = 1 if ( !defined( $sandbox ) ); ! if ( ( $right =~ /^\// ) || # PROFILE BLOCK START ( $right =~ /^[A-Za-z]:[\/\\]/ ) || ! ( $right =~ /\\\\/ ) ) { # PROFILE BLOCK STOP if ( $sandbox ) { $self->log_( 0, "Attempt to access path $right outside sandbox" ); Index: Loader.pm =================================================================== RCS file: /cvsroot/popfile/engine/POPFile/Loader.pm,v retrieving revision 1.37 retrieving revision 1.38 diff -C2 -d -r1.37 -r1.38 *** Loader.pm 20 Feb 2006 02:01:57 -0000 1.37 --- Loader.pm 25 Apr 2008 16:26:17 -0000 1.38 *************** *** 172,178 **** # Parse just the --verbose command-line option ! GetOptions( "verbose!" => \$self->{debug__}, "shutdown" => \$self->{shutdown__}, ! "quiet" => sub{ $self->{debug__} = 0 } ); } --- 172,178 ---- # Parse just the --verbose command-line option ! GetOptions( "verbose!" => \$self->{debug__}, # PROFILE BLOCK START "shutdown" => \$self->{shutdown__}, ! "quiet" => sub{ $self->{debug__} = 0 } ); # PROFILE BLOCK STOP } Index: Database.pm =================================================================== RCS file: /cvsroot/popfile/engine/POPFile/Database.pm,v retrieving revision 1.9 retrieving revision 1.10 diff -C2 -d -r1.9 -r1.10 *** Database.pm 5 Apr 2008 10:32:53 -0000 1.9 --- Database.pm 25 Apr 2008 16:26:17 -0000 1.10 *************** *** 175,182 **** # backup the database by copying it ! if ( ( $self->config_( 'sqlite_tweaks' ) & 2 ) && ! $self->{db_is_sqlite__} ) { if ( !copy( $self->{db_name__}, $self->{db_name__} . ".backup" ) ) { ! $self->log_( 0, "Failed to backup database ".$self->{db_name__} ); } } --- 175,182 ---- # backup the database by copying it ! if ( ( $self->config_( 'sqlite_tweaks' ) & 2 ) && # PROFILE BLOCK START ! $self->{db_is_sqlite__} ) { # PROFILE BLOCK STOP if ( !copy( $self->{db_name__}, $self->{db_name__} . ".backup" ) ) { ! $self->log_( 0, "Failed to backup database ".$self->{db_name__} ); } } *************** *** 198,203 **** my ( $self, $tweak, $state, $db ) = @_; ! if ( $self->{db_is_sqlite__} && ! ( $self->config_( 'sqlite_tweaks' ) & $tweak ) ) { $self->log_( 1, "Performing tweak $tweak to $state" ); --- 198,203 ---- my ( $self, $tweak, $state, $db ) = @_; ! if ( $self->{db_is_sqlite__} && # PROFILE BLOCK START ! ( $self->config_( 'sqlite_tweaks' ) & $tweak ) ) { # PROFILE BLOCK STOP $self->log_( 1, "Performing tweak $tweak to $state" ); *************** *** 350,355 **** foreach my $table (@tables) { if ( $table eq 'popfile' ) { ! my @row = $db->selectrow_array( ! 'select version from popfile;' ); if ( $#row == 0 ) { --- 350,355 ---- foreach my $table (@tables) { if ( $table eq 'popfile' ) { ! my @row = $db->selectrow_array( # PROFILE BLOCK START ! 'select version from popfile;' ); # PROFILE BLOCK STOP if ( $#row == 0 ) { Index: Mutex.pm =================================================================== RCS file: /cvsroot/popfile/engine/POPFile/Mutex.pm,v retrieving revision 1.5 retrieving revision 1.6 diff -C2 -d -r1.5 -r1.6 *** Mutex.pm 20 Feb 2006 02:01:57 -0000 1.5 --- Mutex.pm 25 Apr 2008 16:26:17 -0000 1.6 *************** *** 53,61 **** # and 0 if it fails. # #---------------------------------------------------------------------------- sub acquire { ! my ( $self, # Reference to this object ! $timeout ) = @_; # Timeout in seconds to wait (undef = infinite) # If acquire() has been called without a matching release() then --- 53,63 ---- # and 0 if it fails. # + # $self Reference to this object + # $timeout Timeout in seconds to wait (undef = infinite) + # #---------------------------------------------------------------------------- sub acquire { ! my ( $self, $timeout ) = @_; # If acquire() has been called without a matching release() then Index: Module.pm =================================================================== RCS file: /cvsroot/popfile/engine/POPFile/Module.pm,v retrieving revision 1.54 retrieving revision 1.55 diff -C2 -d -r1.54 -r1.55 *** Module.pm 13 Apr 2008 03:08:09 -0000 1.54 --- Module.pm 25 Apr 2008 16:26:17 -0000 1.55 *************** *** 376,381 **** my ( $package, $file, $line ) = caller; ! $self->logger_()->debug( $level, $self->{name__} . ": $line: " . ! $message ); } --- 376,381 ---- my ( $package, $file, $line ) = caller; ! $self->logger_()->debug( $level, $self->{name__} . ": $line: " . # PROFILE BLOCK START ! $message ); # PROFILE BLOCK STOP } *************** *** 541,549 **** if ( defined( $value ) ) { ! return $self->classifier_()->set_user_parameter_from_id( $user, ! $module . "_" . $name, $value ); } else { ! my ( $val, $def ) = $self->classifier_()->get_user_parameter_from_id( ! $user, $module . "_" . $name ); return $val; } --- 541,549 ---- if ( defined( $value ) ) { ! return $self->classifier_()->set_user_parameter_from_id( $user, # PROFILE BLOCK START ! $module . "_" . $name, $value ); # PROFILE BLOCK STOP } else { ! my ( $val, $def ) = $self->classifier_()->get_user_parameter_from_id( # PROFILE BLOCK START ! $user, $module . "_" . $name ); # PROFILE BLOCK STOP return $val; } Index: MQ.pm =================================================================== RCS file: /cvsroot/popfile/engine/POPFile/MQ.pm,v retrieving revision 1.24 retrieving revision 1.25 diff -C2 -d -r1.24 -r1.25 *** MQ.pm 9 Apr 2008 17:20:47 -0000 1.24 --- MQ.pm 25 Apr 2008 16:26:17 -0000 1.25 *************** *** 71,75 **** # Messages are handled in this order. ! my %message_type_list = ( 'CREAT' => 1, 'LOGIN' => 2, --- 71,75 ---- # Messages are handled in this order. ! my %message_type_list = ( # PROFILE BLOCK START 'CREAT' => 1, 'LOGIN' => 2, *************** *** 78,82 **** 'TICKD' => 5, 'RELSE' => 6, ! ); #---------------------------------------------------------------------------- --- 78,82 ---- 'TICKD' => 5, 'RELSE' => 6, ! ); # PROFILE BLOCK STOP #---------------------------------------------------------------------------- *************** *** 136,141 **** # Iterate through all the messages in all the queues ! for my $type ( sort sort_message__ ! keys %{$self->{queue__}} ) { while ( my $ref = shift @{$self->{queue__}{$type}} ) { --- 136,141 ---- # Iterate through all the messages in all the queues ! for my $type ( sort sort_message__ # PROFILE BLOCK START ! keys %{$self->{queue__}} ) { # PROFILE BLOCK STOP while ( my $ref = shift @{$self->{queue__}{$type}} ) { *************** *** 146,151 **** for my $waiter (@{$self->{waiters__}{$type}}) { ! $self->log_( 2, "Delivering message $type ($flat) to " . ! $waiter->name() ); $waiter->deliver( $type, @message ); --- 146,151 ---- for my $waiter (@{$self->{waiters__}{$type}}) { ! $self->log_( 2, "Delivering message $type ($flat) to " . # PROFILE BLOCK START ! $waiter->name() ); # PROFILE BLOCK STOP $waiter->deliver( $type, @message ); Index: Logger.pm =================================================================== RCS file: /cvsroot/popfile/engine/POPFile/Logger.pm,v retrieving revision 1.46 retrieving revision 1.47 diff -C2 -d -r1.46 -r1.47 *** Logger.pm 20 Feb 2006 02:01:57 -0000 1.46 --- Logger.pm 25 Apr 2008 16:26:17 -0000 1.47 *************** *** 189,195 **** # sandbox ! $self->{debug_filename__} = $self->get_user_path_( $self->path_join( $self->config_( 'logdir' ), ! "popfile$self->{today__}.log" ), 0 ); } --- 189,195 ---- # sandbox ! $self->{debug_filename__} = $self->get_user_path_( # PROFILE BLOCK START $self->path_join( $self->config_( 'logdir' ), ! "popfile$self->{today__}.log" ), 0 ); # PROFILE BLOCK STOP } *************** *** 237,242 **** } ! if ( ( !defined( $self->config_( 'level' ) ) ) || ! ( $level > $self->config_( 'level' ) ) ) { return; } --- 237,242 ---- } ! if ( ( !defined( $self->config_( 'level' ) ) ) || # PROFILE BLOCK START ! ( $level > $self->config_( 'level' ) ) ) { # PROFILE BLOCK STOP return; } *************** *** 257,262 **** $message =~ s/([\x00-\x1f])/sprintf("[%2.2x]", ord($1))/eg; ! my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = ! localtime; $year += 1900; $mon += 1; --- 257,262 ---- $message =~ s/([\x00-\x1f])/sprintf("[%2.2x]", ord($1))/eg; ! my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = # PROFILE BLOCK START ! localtime; # PROFILE BLOCK STOP $year += 1900; $mon += 1; |
