You are viewing a plain text version of this content. The canonical link for it is here.
Posted to commits@spamassassin.apache.org by mm...@apache.org on 2008/09/19 13:26:47 UTC
svn commit: r697056 [1/2] - in /spamassassin/trunk: ./ lib/Mail/
lib/Mail/SpamAssassin/ lib/Mail/SpamAssassin/BayesStore/
lib/Mail/SpamAssassin/Conf/ lib/Mail/SpamAssassin/Locker/
lib/Mail/SpamAssassin/Logger/ lib/Mail/SpamAssassin/Message/ lib/Mail/Sp...
Author: mmartinec
Date: Fri Sep 19 04:26:46 2008
New Revision: 697056
URL: http://svn.apache.org/viewvc?rev=697056&view=rev
Log:
[Bug 5981] Improved error detection and reporting
Modified:
spamassassin/trunk/lib/Mail/SpamAssassin.pm
spamassassin/trunk/lib/Mail/SpamAssassin/AICache.pm
spamassassin/trunk/lib/Mail/SpamAssassin/ArchiveIterator.pm
spamassassin/trunk/lib/Mail/SpamAssassin/BayesStore.pm
spamassassin/trunk/lib/Mail/SpamAssassin/BayesStore/DBM.pm
spamassassin/trunk/lib/Mail/SpamAssassin/BayesStore/SQL.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Client.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Conf/Parser.pm
spamassassin/trunk/lib/Mail/SpamAssassin/DnsResolver.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Locker/Flock.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Locker/UnixNFSSafe.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Locker/Win32.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Logger/File.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Logger/Stderr.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Message.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Message/Node.pm
spamassassin/trunk/lib/Mail/SpamAssassin/PerMsgStatus.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Bayes.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/BodyRuleBaseExtractor.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/DCC.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Hashcash.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/HeaderEval.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/PhishTag.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Pyzor.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Razor2.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Test.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/TextCat.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Reporter.pm
spamassassin/trunk/lib/Mail/SpamAssassin/SpamdForkScaling.pm
spamassassin/trunk/lib/Mail/SpamAssassin/SubProcBackChannel.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Util.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Util/DependencyInfo.pm
spamassassin/trunk/lib/Mail/SpamAssassin/Util/MemoryDump.pm
spamassassin/trunk/sa-compile.raw
spamassassin/trunk/sa-learn.raw
spamassassin/trunk/sa-update.raw
spamassassin/trunk/spamassassin.raw
Modified: spamassassin/trunk/lib/Mail/SpamAssassin.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin.pm Fri Sep 19 04:26:46 2008
@@ -1173,12 +1173,19 @@
return;
}
- my $text = "file start $filename\n"
- . join ('', <IN>)
- # add an extra \n in case file did not end in one.
- . "\nfile end $filename\n";
+ my $text;
+ { local $/ = undef; $! = 0; $text = <IN> }
+ defined $text || $!==0 or die "error reading $filename: $!";
+ close IN or die "error closing $filename: $!";
+
+ if (!defined $text) {
+ dbg("config: read_scoreonly_config: empty file");
+ $text = '';
+ }
- close IN;
+ $text = "file start $filename\n" . $text;
+ # add an extra \n in case file did not end in one.
+ $text .= "\nfile end $filename\n";
$self->{conf}->{main} = $self;
$self->{conf}->parse_scores_only ($text);
@@ -1630,7 +1637,14 @@
# just use the last entry in the array as the default path.
$fname ||= $self->sed_path($default_userprefs_path[-1]);
- if (!-f $fname && !$self->create_default_prefs($fname)) {
+ my $stat_errn = stat($fname) ? 0 : 0+$!;
+ if ($stat_errn == 0 && -f _) {
+ # exists and is a regular file, nothing to do
+ } elsif ($stat_errn == 0) {
+ warn "config: default user preference file $fname is not a regular file\n";
+ } elsif ($stat_errn != ENOENT) {
+ warn "config: default user preference file $fname not accessible: $!\n";
+ } elsif (!$self->create_default_prefs($fname)) {
warn "config: failed to create default user preference file $fname\n";
}
}
@@ -1706,12 +1720,16 @@
{
dbg("config: using \"$path\" for $desc");
- if (-d $path) {
+ my $stat_errn = stat($path) ? 0 : 0+$!;
+ if ($stat_errn == ENOENT) {
+ # no file or directory
+ } elsif ($stat_errn != 0) {
+ dbg("config: file or directory $path not accessible: $!");
+ } elsif (-d _) {
foreach my $file ($self->$filelistmethod($path)) {
$txt .= read_cf_file($file);
}
-
- } elsif (-f $path && -s _ && -r _) {
+ } elsif (-f _ && -s _ && -r _) {
$txt .= read_cf_file($path);
}
}
@@ -1725,11 +1743,20 @@
my $txt = '';
if (open (IN, "<".$path)) {
- $txt = "file start $path\n";
- $txt .= join ('', <IN>);
+
+ { local $/; undef $/; $! = 0; $txt = <IN> }
+ defined $txt || $!==0 or die "error reading $path: $!";
+ close IN or die "error closing $path: $!";
+
+ if (!defined $txt) {
+ dbg("config: read_cf_file: empty file $path");
+ $txt = '';
+ }
+
+ $txt = "file start $path\n" . $txt;
# add an extra \n in case file did not end in one.
$txt .= "\nfile end $path\n";
- close IN;
+
dbg("config: read file $path");
}
else {
@@ -1766,7 +1793,12 @@
dbg("config: using \"$fname\" for user state dir");
}
- if (!-d $fname) {
+ my $stat_errn = stat($fname) ? 0 : 0+$!;
+ if ($stat_errn == 0 && !-d _) {
+ die "config: $fname exists but is not a directory\n";
+ } elsif ($stat_errn != 0 && $stat_errn != ENOENT) {
+ die "config: error accessing $fname: $!\n";
+ } else { # does not exist, create it
# not being able to create the *dir* is not worth a warning at all times
eval {
mkpath($fname, 0, 0700); 1;
@@ -1822,7 +1854,8 @@
# warn "config: hooray! user_dirs don't match! '$userdir' vs '$self->{user_dir}'\n";
# }
- if (!-f $fname)
+ my $stat_errn = stat($fname) ? 0 : 0+$!;
+ if ($stat_errn == ENOENT)
{
# Pass on the value of $userdir for virtual users in vpopmail
# otherwise it is empty and the user's normal homedir is used
@@ -1834,12 +1867,13 @@
if (defined $defprefs && open (IN, "<$defprefs")) {
$fname = Mail::SpamAssassin::Util::untaint_file_path($fname);
if (open (OUT, ">$fname")) {
- while (<IN>) {
+ for ($!=0; <IN>; $!=0) {
/^\#\* / and next;
- print OUT;
+ print OUT or die "cannot write to $fname: $!";
}
- close OUT;
- close IN;
+ defined $_ || $!==0 or die "error reading from $defprefs: $!";
+ close OUT or die "error closing $fname: $!";
+ close IN or die "error closing $defprefs: $!";
if (($< == 0) && ($> == 0) && defined($user)) { # chown it
my ($uid,$gid) = (getpwnam($user))[2,3];
@@ -1851,7 +1885,7 @@
return(1);
}
else {
- warn "config: cannot write to $fname: $!\n";
+ warn "config: cannot create $fname: $!\n";
}
}
elsif (defined $defprefs) {
@@ -1965,7 +1999,8 @@
}
else {
opendir(SA_CF_DIR, $dir) or warn "config: cannot opendir $dir: $!\n";
- my @cfs = grep { /\.${type}$/i && -f "$dir/$_" } readdir(SA_CF_DIR);
+ my @cfs = grep { $_ ne '.' && $_ ne '..' &&
+ /\.${type}$/i && -f "$dir/$_" } readdir(SA_CF_DIR);
closedir SA_CF_DIR;
return map { "$dir/$_" } sort { $a cmp $b } @cfs;
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/AICache.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/AICache.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/AICache.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/AICache.pm Fri Sep 19 04:26:46 2008
@@ -70,7 +70,9 @@
File::Spec->rel2abs($self->{path}),
'.spamassassin_cache');
- $self->{cache_mtime} = (stat($self->{cache_file}))[9] || 0;
+ my @stat = stat($self->{cache_file});
+ @stat or warn "AIcache: no access to $self->{cache_file}: $!";
+ $self->{cache_mtime} = $stat[9] || 0;
}
else {
my @split = File::Spec->splitpath($self->{path});
@@ -79,24 +81,34 @@
File::Spec->rel2abs($split[1]),
join('_', '.spamassassin_cache', $self->{type}, $split[2]));
- $self->{cache_mtime} = (stat($self->{cache_file}))[9] || 0;
+ my @stat = stat($self->{cache_file});
+ @stat or warn "AIcache: no access to $self->{cache_file}: $!";
+ $self->{cache_mtime} = $stat[9] || 0;
# for mbox and mbx, verify whether mtime on cache file is >= mtime of
# messages file. if it is, use it, otherwise don't.
- if ((stat($self->{path}))[9] > $self->{cache_mtime}) {
+ @stat = stat($self->{path});
+ @stat or warn "AIcache: no access to $self->{path}: $!";
+ if ($stat[9] > $self->{cache_mtime}) {
$use_cache = 0;
}
}
$self->{cache_file} = File::Spec->canonpath($self->{cache_file});
# go ahead and read in the cache information
- if ($use_cache && open(CACHE, $self->{cache_file})) {
- while(defined($_=<CACHE>)) {
+ if (!$use_cache) {
+ # not in use
+ } elsif (!open(CACHE, $self->{cache_file})) {
+ die "cannot open AI cache file (".$self->{cache_file}."): $!";
+ } else {
+ for ($!=0; defined($_=<CACHE>); $!=0) {
my($k,$v) = split(/\t/, $_);
next unless (defined $k && defined $v);
$self->{cache}->{$k} = $v;
}
- close(CACHE);
+ defined $_ || $!==0 or die "error reading from AI cache file: $!";
+ close CACHE
+ or die "error closing AI cache file (".$self->{cache_file}."): $!";
}
bless($self,$class);
@@ -148,7 +160,7 @@
1;
} or do {
my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
- warn "Can't mkpath for AI cache file ($self->{cache_file}): $eval_stat\n";
+ warn "cannot mkpath for AI cache file ($self->{cache_file}): $eval_stat\n";
};
my $towrite = '';
@@ -163,13 +175,14 @@
if (!open(CACHE, ">".$self->{cache_file}))
{
- warn "open AI cache file failed (".$self->{cache_file}."): $!";
+ warn "creating AI cache file failed (".$self->{cache_file}."): $!";
# TODO: should we delete it/clean it up?
}
else {
- print CACHE $towrite;
+ print CACHE $towrite
+ or die "error writing to AI cache file: $!";
close CACHE
- or warn "close AI cache file failed (".$self->{cache_file}."): $!";
+ or die "error closing AI cache file (".$self->{cache_file}."): $!";
}
}
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/ArchiveIterator.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/ArchiveIterator.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/ArchiveIterator.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/ArchiveIterator.pm Fri Sep 19 04:26:46 2008
@@ -24,6 +24,7 @@
use bytes;
use re 'taint';
+use Errno qw(ENOENT EACCES);
use Mail::SpamAssassin::Util;
use Mail::SpamAssassin::Constants qw(:sa);
use Mail::SpamAssassin::Logger;
@@ -331,18 +332,19 @@
# skip too-big mails
if (! $self->{opt_all} && -s INPUT > BIG_BYTES) {
info("archive-iterator: skipping large message\n");
- close INPUT;
+ close INPUT or die "error closing input file: $!";
return;
}
my @msg;
my $header;
- while (<INPUT>) {
+ for ($!=0; <INPUT>; $!=0) {
push(@msg, $_);
if (!defined $header && /^\015?$/) {
$header = $#msg;
}
}
- close INPUT;
+ defined $_ || $!==0 or die "error reading: $!";
+ close INPUT or die "error closing input file: $!";
if ($date == AI_TIME_UNKNOWN && $self->{determine_receive_date}) {
$date = Mail::SpamAssassin::Util::receive_date(join('', splice(@msg, 0, $header)));
@@ -361,15 +363,15 @@
$self->{access_problem} = 1;
return;
}
- seek(INPUT,$offset,0);
- while (<INPUT>) {
+ seek(INPUT,$offset,0) or die "cannot reposition file to $offset: $!";
+ for ($!=0; <INPUT>; $!=0) {
last if (substr($_,0,5) eq "From " && @msg && /^From \S+ ?\S\S\S \S\S\S .\d .\d:\d\d:\d\d \d{4}/);
push (@msg, $_);
# skip too-big mails
if (! $self->{opt_all} && @msg > BIG_LINES) {
info("archive-iterator: skipping large message\n");
- close INPUT;
+ close INPUT or die "error closing input file: $!";
return;
}
@@ -377,7 +379,8 @@
$header = $#msg;
}
}
- close INPUT;
+ defined $_ || $!==0 or die "error reading: $!";
+ close INPUT or die "error closing input file: $!";
if ($date == AI_TIME_UNKNOWN && $self->{determine_receive_date}) {
$date = Mail::SpamAssassin::Util::receive_date(join('', splice(@msg, 0, $header)));
@@ -398,16 +401,16 @@
return;
}
- seek(INPUT, $offset, 0);
+ seek(INPUT,$offset,0) or die "cannot reposition file to $offset: $!";
- while (<INPUT>) {
+ for ($!=0; <INPUT>; $!=0) {
last if ($_ =~ MBX_SEPARATOR);
push (@msg, $_);
# skip mails that are too big
if (! $self->{opt_all} && @msg > BIG_LINES) {
info("archive-iterator: skipping large message\n");
- close INPUT;
+ close INPUT or die "error closing input file: $!";
return;
}
@@ -415,7 +418,8 @@
$header = $#msg;
}
}
- close INPUT;
+ defined $_ || $!==0 or die "error reading: $!";
+ close INPUT or die "error closing input file: $!";
if ($date == AI_TIME_UNKNOWN && $self->{determine_receive_date}) {
$date = Mail::SpamAssassin::Util::receive_date(join('', splice(@msg, 0, $header)));
@@ -493,16 +497,24 @@
if ($format eq 'detect') {
# detect the format
- if (!-d $location && $location =~ /\.mbox/i) {
+ my $stat_errn = stat($location) ? 0 : 0+$!;
+ if ($stat_errn == ENOENT) {
+ $thisformat = 'file'; # actually, no file - to be detected later
+ }
+ elsif ($stat_errn != 0) {
+ warn "archive-iterator: no access to $location: $!";
+ $thisformat = 'file';
+ }
+ elsif (-d _) {
+ # it's a directory
+ $thisformat = 'dir';
+ }
+ elsif ($location =~ /\.mbox/i) {
# filename indicates mbox
$thisformat = 'mbox';
}
- elsif (!(-d $location)) {
- $thisformat = 'file';
- }
else {
- # it's a directory
- $thisformat = 'dir';
+ $thisformat = 'file';
}
}
@@ -558,7 +570,7 @@
}
# bug 5249: mail could have 8-bit data, need this on some platforms
- binmode INPUT;
+ binmode INPUT or die "cannot set input file to binmode: $!";
return 1;
}
@@ -643,17 +655,19 @@
my @files;
- opendir(DIR, $folder) || die "archive-iterator: can't open '$folder' dir: $!\n";
+ opendir(DIR, $folder)
+ or die "archive-iterator: can't open '$folder' dir: $!\n";
if (-f "$folder/cyrus.header") {
# cyrus metadata: http://unix.lsa.umich.edu/docs/imap/imap-lsa-srv_3.html
- @files = grep { /^\S+$/ && !/^cyrus\.(?:index|header|cache|seen)/ }
- readdir(DIR);
+ @files = grep { $_ ne '.' && $_ ne '..' &&
+ /^\S+$/ && !/^cyrus\.(?:index|header|cache|seen)/ }
+ readdir(DIR);
}
else {
# ignore ,234 (deleted or refiled messages) and MH metadata dotfiles
@files = grep { !/^[,.]/ } readdir(DIR);
}
- closedir(DIR);
+ closedir(DIR) or die "error closing directory $folder: $!";
@files = map { "$folder/$_" } @files;
@@ -671,7 +685,14 @@
# recurse into directories
foreach my $file (@files) {
- if (-d $file) {
+ my $stat_errn = stat($file) ? 0 : 0+$!;
+ if ($stat_errn == ENOENT) {
+ # no longer there?
+ }
+ elsif ($stat_errn != 0) {
+ warn "archive-iterator: no access to $file: $!";
+ }
+ elsif (-d _) {
$self->_scan_directory($class, $file, $bkfunc);
}
}
@@ -690,6 +711,7 @@
# it's faster to perform lookups in the cache, and more accurate
if (!defined $AICache) {
my @s = stat($mail);
+ @s or warn "archive-iterator: no access to $mail: $!";
return unless $self->_message_is_useful_by_file_modtime($s[9]);
}
@@ -698,18 +720,26 @@
unless (defined $AICache and $date = $AICache->check($mail)) {
# silently skip directories/non-files; some folders may
# contain extraneous dirs etc.
- return if (!-f $mail);
+ my $stat_errn = stat($mail) ? 0 : 0+$!;
+ if ($stat_errn != 0) {
+ warn "archive-iterator: no access to $mail: $!";
+ return;
+ }
+ elsif (!-f _) {
+ return;
+ }
my $header = '';
if (!_mail_open($mail)) {
$self->{access_problem} = 1;
return;
}
- while (<INPUT>) {
+ for ($!=0; <INPUT>; $!=0) {
last if /^\015?$/s;
$header .= $_;
}
- close(INPUT);
+ defined $_ || $!==0 or die "error reading: $!";
+ close INPUT or die "error closing input file: $!";
return if ($self->{opt_skip_empty_messages} && $header eq '');
@@ -735,7 +765,17 @@
my ($self, $class, $folder, $bkfunc) = @_;
my @files;
- if (-d $folder) {
+ my $stat_errn = stat($folder) ? 0 : 0+$!;
+ if ($stat_errn == ENOENT) {
+ # no longer there?
+ }
+ elsif ($stat_errn != 0) {
+ warn "archive-iterator: no access to $folder: $!";
+ }
+ elsif (-f _) {
+ push(@files, $folder);
+ }
+ elsif (-d _) {
# passed a directory of mboxes
$folder =~ s/\/\s*$//; #Remove trailing slash, if there
if (!opendir(DIR, $folder)) {
@@ -743,16 +783,24 @@
$self->{access_problem} = 1;
return;
}
-
while ($_ = readdir(DIR)) {
- if(/^[^\.]\S*$/ && ! -d "$folder/$_") {
+ next if $_ eq '.' || $_ eq '..' || !/^[^\.]\S*$/;
+ # hmmm, ignores folders with spaces in the name???
+ $stat_errn = stat("$folder/$_") ? 0 : 0+$!;
+ if ($stat_errn == ENOENT) {
+ # no longer there?
+ }
+ elsif ($stat_errn != 0) {
+ warn "archive-iterator: no access to $folder/$_: $!";
+ }
+ elsif (-f _) {
push(@files, "$folder/$_");
}
}
- closedir(DIR);
+ closedir(DIR) or die "error closing directory $folder: $!";
}
else {
- push(@files, $folder);
+ warn "archive-iterator: $folder is not a regular file or directory: $!";
}
foreach my $file (@files) {
@@ -764,6 +812,7 @@
}
my @s = stat($file);
+ @s or warn "archive-iterator: no access to $file: $!";
next unless $self->_message_is_useful_by_file_modtime($s[9]);
my $info = {};
@@ -787,11 +836,11 @@
my $where = 0; # current byte offset
my $first = ''; # first line of message
my $header = ''; # header text
- my $in_header = 0; # are in we a header?
+ my $in_header = 0; # are in we a header?
while (!eof INPUT) {
my $offset = $start; # byte offset of this message
my $header = $first; # remember first line
- while (<INPUT>) {
+ for ($!=0; <INPUT>; $!=0) {
if ($in_header) {
if (/^\015?$/s) {
$in_header = 0;
@@ -800,22 +849,26 @@
$header .= $_;
}
}
- if (substr($_,0,5) eq "From " && /^From \S+ ?\S\S\S \S\S\S .\d .\d:\d\d:\d\d \d{4}/) {
+ if (substr($_,0,5) eq "From " &&
+ /^From \S+ ?\S\S\S \S\S\S .\d .\d:\d\d:\d\d \d{4}/) {
$in_header = 1;
$first = $_;
$start = $where;
$where = tell INPUT;
+ $where >= 0 or die "cannot obtain file position: $!";
last;
}
$where = tell INPUT;
+ $where >= 0 or die "cannot obtain file position: $!";
}
- if ($header) {
- next if ($self->{opt_skip_empty_messages} && $header eq '');
+ defined $_ || $!==0 or die "error reading: $!";
+ if ($header ne '') {
+ # next if ($self->{opt_skip_empty_messages} && $header eq '');
$self->_bump_scan_progress();
$info->{$offset} = Mail::SpamAssassin::Util::receive_date($header);
}
}
- close INPUT;
+ close INPUT or die "error closing input file: $!";
}
while(my($k,$v) = each %{$info}) {
@@ -841,7 +894,17 @@
my ($self, $class, $folder, $bkfunc) = @_;
my (@files, $fp);
- if (-d $folder) {
+ my $stat_errn = stat($folder) ? 0 : 0+$!;
+ if ($stat_errn == ENOENT) {
+ # no longer there?
+ }
+ elsif ($stat_errn != 0) {
+ warn "archive-iterator: no access to $folder: $!";
+ }
+ elsif (-f _) {
+ push(@files, $folder);
+ }
+ elsif (-d _) {
# got passed a directory full of mbx folders.
$folder =~ s/\/\s*$//; # remove trailing slash, if there is one
if (!opendir(DIR, $folder)) {
@@ -849,16 +912,24 @@
$self->{access_problem} = 1;
return;
}
-
while ($_ = readdir(DIR)) {
- if(/^[^\.]\S*$/ && ! -d "$folder/$_") {
+ next if $_ eq '.' || $_ eq '..' || !/^[^\.]\S*$/;
+ # hmmm, ignores folders with spaces in the name???
+ $stat_errn = stat("$folder/$_") ? 0 : 0+$!;
+ if ($stat_errn == ENOENT) {
+ # no longer there?
+ }
+ elsif ($stat_errn != 0) {
+ warn "archive-iterator: no access to $folder/$_: $!";
+ }
+ elsif (-f _) {
push(@files, "$folder/$_");
}
}
- closedir(DIR);
+ closedir(DIR) or die "error closing directory $folder: $!";
}
else {
- push(@files, $folder);
+ warn "archive-iterator: $folder is not a regular file or directory: $!";
}
foreach my $file (@files) {
@@ -871,6 +942,7 @@
}
my @s = stat($file);
+ @s or warn "archive-iterator: no access to $file: $!";
next unless $self->_message_is_useful_by_file_modtime($s[9]);
my $info = {};
@@ -891,27 +963,31 @@
}
# check the mailbox is in mbx format
- $fp = <INPUT>;
- if ($fp !~ /\*mbx\*/) {
+ $! = 0; $fp = <INPUT>;
+ defined $fp || $!==0 or die "error reading: $!";
+ if (!defined $fp) {
+ die "archive-iterator: error: mailbox not in mbx format - empty!\n";
+ } elsif ($fp !~ /\*mbx\*/) {
die "archive-iterator: error: mailbox not in mbx format!\n";
}
# skip mbx headers to the first email...
- seek(INPUT, 2048, 0);
-
+ seek(INPUT,2048,0) or die "cannot reposition file to 2048: $!";
my $sep = MBX_SEPARATOR;
- while (<INPUT>) {
+ for ($!=0; <INPUT>; $!=0) {
if ($_ =~ /$sep/) {
my $offset = tell INPUT;
+ $offset >= 0 or die "cannot obtain file position: $!";
my $size = $2;
# gather up the headers...
my $header = '';
- while (<INPUT>) {
+ for ($!=0; <INPUT>; $!=0) {
last if (/^\015?$/s);
$header .= $_;
}
+ defined $_ || $!==0 or die "error reading: $!";
if (!($self->{opt_skip_empty_messages} && $header eq '')) {
$self->_bump_scan_progress();
@@ -919,13 +995,15 @@
}
# go onto the next message
- seek(INPUT, $offset + $size, 0);
+ seek(INPUT, $offset + $size, 0)
+ or die "cannot reposition file to $offset + $size: $!";
}
else {
die "archive-iterator: error: failure to read message body!\n";
}
}
- close INPUT;
+ defined $_ || $!==0 or die "error reading: $!";
+ close INPUT or die "error closing input file: $!";
}
while(my($k,$v) = each %{$info}) {
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/BayesStore.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/BayesStore.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/BayesStore.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/BayesStore.pm Fri Sep 19 04:26:46 2008
@@ -382,9 +382,11 @@
if ($opts->{verbose}) {
my $hapax_pc = ($num_hapaxes * 100) / $kept;
my $lowfreq_pc = ($num_lowfreq * 100) / $kept;
- print "$msg\n$msg2\n";
- printf "token frequency: 1-occurrence tokens: %3.2f%%\n", $hapax_pc;
- printf "token frequency: less than 8 occurrences: %3.2f%%\n", $lowfreq_pc;
+ print "$msg\n$msg2\n" or die "Error writing: $!";
+ printf "token frequency: 1-occurrence tokens: %3.2f%%\n", $hapax_pc
+ or die "Error writing: $!";
+ printf "token frequency: less than 8 occurrences: %3.2f%%\n", $lowfreq_pc
+ or die "Error writing: $!";
}
else {
dbg("bayes: $msg: $msg2");
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/BayesStore/DBM.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/BayesStore/DBM.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/BayesStore/DBM.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/BayesStore/DBM.pm Fri Sep 19 04:26:46 2008
@@ -1122,6 +1122,7 @@
# touches missed.
my $write_failure = 0;
my $original_point = tell OUT;
+ $original_point >= 0 or die "Can't obtain file position: $!";
my $len;
do {
$len = syswrite (OUT, $self->{string_to_journal}, $nbytes);
@@ -1268,7 +1269,7 @@
# Read the journal
- while (<JOURNAL>) {
+ for ($!=0; defined($_=<JOURNAL>); $!=0) {
$total_count++;
if (/^t (\d+) (.+)$/) { # Token timestamp update, cache resultant entries
@@ -1293,7 +1294,8 @@
warn "bayes: gibberish entry found in journal: $_";
}
}
- close JOURNAL;
+ defined $_ || $!==0 or die "Error reading journal file: $!";
+ close(JOURNAL) or die "Can't close journal file: $!";
# Now that we've determined what tokens we need to update and their
# final values, update the DB. Should be much smaller than the full
@@ -1430,9 +1432,9 @@
my $dir = dirname($path);
# make temporary copy since old dbm and new dbm may have same name
- opendir(DIR, $dir) || die "bayes: can't opendir $dir: $!";
+ opendir(DIR, $dir) or die "bayes: can't opendir $dir: $!";
my @files = grep { /^bayes_(?:seen|toks)(?:\.\w+)?$/ } readdir(DIR);
- closedir(DIR);
+ closedir(DIR) or die "bayes: can't close directory $dir: $!";
if (@files < 2 || !grep(/bayes_seen/,@files) || !grep(/bayes_toks/,@files))
{
die "bayes: unable to find bayes_toks and bayes_seen, stopping\n";
@@ -1645,6 +1647,7 @@
my $oldest_token_age = time() + 100000;
my $line = <DUMPFILE>;
+ defined $line or die "Error reading dump file: $!";
$line_count++;
# We require the database version line to be the first in the file so we can
@@ -1673,7 +1676,7 @@
return 0;
}
- while (my $line = <DUMPFILE>) {
+ for ($!=0; defined($line=<DUMPFILE>); $!=0) {
chomp($line);
$line_count++;
@@ -1770,7 +1773,8 @@
next;
}
}
- close(DUMPFILE);
+ defined $line || $!==0 or die "Error reading dump file: $!";
+ close(DUMPFILE) or die "Can't close dump file: $!";
print STDERR "\n" if ($showdots);
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/BayesStore/SQL.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/BayesStore/SQL.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/BayesStore/SQL.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/BayesStore/SQL.pm Fri Sep 19 04:26:46 2008
@@ -654,7 +654,8 @@
my $encoded_token = unpack("H*", $token);
- printf $template,$prob,$spam_count,$ham_count,$atime,$encoded_token;
+ printf $template,$prob,$spam_count,$ham_count,$atime,$encoded_token
+ or die "Error writing tokens: $!";
}
$sth->finish();
@@ -1332,9 +1333,10 @@
my $num_spam = $vars[1] || 0;
my $num_ham = $vars[2] || 0;
- print "v\t$vars[6]\tdb_version # this must be the first line!!!\n";
- print "v\t$num_spam\tnum_spam\n";
- print "v\t$num_ham\tnum_nonspam\n";
+ print "v\t$vars[6]\tdb_version # this must be the first line!!!\n"
+ or die "Error writing: $!";
+ print "v\t$num_spam\tnum_spam\n" or die "Error writing: $!";
+ print "v\t$num_ham\tnum_nonspam\n" or die "Error writing: $!";
my $token_select = $self->_token_select_string();
@@ -1363,7 +1365,8 @@
while (my @values = $sth->fetchrow_array()) {
$values[3] = unpack("H*", $values[3]);
- print "t\t" . join("\t", @values) . "\n";
+ print "t\t" . join("\t", @values) . "\n"
+ or die "Error writing: $!";
}
$sth->finish();
@@ -1383,7 +1386,7 @@
}
while (my @values = $sth->fetchrow_array()) {
- print "s\t" . join("\t",@values) . "\n";
+ print "s\t" . join("\t",@values) . "\n" or die "Error writing: $!";
}
$sth->finish();
@@ -1439,6 +1442,7 @@
my $line_count = 0;
my $line = <DUMPFILE>;
+ defined $line or die "Error reading dump file: $!";
$line_count++;
# We require the database version line to be the first in the file so we can
# figure out how to properly deal with the file. If it is not the first
@@ -1459,7 +1463,7 @@
my $token_error_count = 0;
my $seen_error_count = 0;
- while (my $line = <DUMPFILE>) {
+ for ($!=0; defined($line=<DUMPFILE>); $!=0) {
chomp($line);
$line_count++;
@@ -1568,7 +1572,8 @@
return 0;
}
}
- close(DUMPFILE);
+ defined $line || $!==0 or die "Error reading dump file: $!";
+ close(DUMPFILE) or die "Can't close dump file: $!";
print STDERR "\n" if ($showdots);
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Client.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Client.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Client.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Client.pm Fri Sep 19 04:26:46 2008
@@ -222,7 +222,8 @@
print $remote $msg;
print $remote "$EOL";
- my $line = <$remote>;
+ $! = 0; my $line = <$remote>;
+ defined $line || $!==0 or die "error reading from spamd: $!";
return undef unless (defined $line);
my ($version, $resp_code, $resp_msg) = $self->_parse_response_line($line);
@@ -235,7 +236,7 @@
my $did_set = '';
my $did_remove = '';
- while ($line = <$remote>) {
+ for ($!=0; defined($line=<$remote>); $!=0) {
if ($line =~ /DidSet: (.*)/i) {
$did_set = $1;
}
@@ -246,8 +247,9 @@
last;
}
}
+ defined $line || $!==0 or die "error reading from spamd: $!";
- close $remote;
+ close $remote or die "error closing socket: $!";
if ($learntype == 0 || $learntype == 1) {
return $did_set =~ /local/;
@@ -286,7 +288,8 @@
print $remote $msg;
print $remote "$EOL";
- my $line = <$remote>;
+ $! = 0; my $line = <$remote>;
+ defined $line || $!==0 or die "error reading from spamd: $!";
return undef unless (defined $line);
my ($version, $resp_code, $resp_msg) = $self->_parse_response_line($line);
@@ -298,7 +301,7 @@
my $reported_p = 0;
- while (($line = <$remote>)) {
+ for ($!=0; defined($line=<$remote>); $!=0) {
if ($line =~ /DidSet:\s+.*remote/i) {
$reported_p = 1;
last;
@@ -307,8 +310,9 @@
last;
}
}
+ defined $line || $!==0 or die "error reading from spamd: $!";
- close $remote;
+ close $remote or die "error closing socket: $!";
return $reported_p;
}
@@ -343,7 +347,8 @@
print $remote $msg;
print $remote "$EOL";
- my $line = <$remote>;
+ $! = 0; my $line = <$remote>;
+ defined $line || $!==0 or die "error reading from spamd: $!";
return undef unless (defined $line);
my ($version, $resp_code, $resp_msg) = $self->_parse_response_line($line);
@@ -355,7 +360,7 @@
my $revoked_p = 0;
- while (!$revoked_p && ($line = <$remote>)) {
+ for ($!=0; defined($line=<$remote>); $!=0) {
if ($line =~ /DidRemove:\s+remote/i) {
$revoked_p = 1;
last;
@@ -364,8 +369,9 @@
last;
}
}
+ defined $line || $!==0 or die "error reading from spamd: $!";
- close $remote;
+ close $remote or die "error closing socket: $!";
return $revoked_p;
}
@@ -391,8 +397,9 @@
print $remote "PING $PROTOVERSION$EOL";
print $remote "$EOL";
- my $line = <$remote>;
- close $remote;
+ $! = 0; my $line = <$remote>;
+ defined $line || $!==0 or die "error reading from spamd: $!";
+ close $remote or die "error closing socket: $!";
return undef unless (defined $line);
my ($version, $resp_code, $resp_msg) = $self->_parse_response_line($line);
@@ -522,7 +529,8 @@
print $remote $msg;
print $remote "$EOL";
- my $line = <$remote>;
+ $! = 0; my $line = <$remote>;
+ defined $line || $!==0 or die "error reading from spamd: $!";
return undef unless (defined $line);
my ($version, $resp_code, $resp_msg) = $self->_parse_response_line($line);
@@ -532,7 +540,7 @@
return undef unless ($resp_code == 0);
- while ($line = <$remote>) {
+ for ($!=0; defined($line=<$remote>); $!=0) {
if ($line =~ /Content-length: (\d+)/) {
$data{content_length} = $1;
}
@@ -545,15 +553,17 @@
last;
}
}
+ defined $line || $!==0 or die "error reading from spamd: $!";
my $return_msg;
- while(<$remote>) {
+ for ($!=0; <$remote>; $!=0) {
$return_msg .= $_;
}
+ defined $_ || $!==0 or die "error reading from spamd: $!";
$data{message} = $return_msg if ($return_msg);
- close $remote;
+ close $remote or die "error closing socket: $!";
return \%data;
}
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Conf/Parser.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Conf/Parser.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Conf/Parser.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Conf/Parser.pm Fri Sep 19 04:26:46 2008
@@ -1121,7 +1121,9 @@
my $lexer = ARITH_EXPRESSION_LEXER;
my @tokens = ($rule =~ m/$lexer/g);
if (length($name) == 1) {
- print "$name $_\n " for @tokens;
+ for (@tokens) {
+ print "$name $_\n " or die "Error writing token: $!";
+ }
}
# Go through each token in the meta rule
foreach my $token (@tokens) {
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/DnsResolver.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/DnsResolver.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/DnsResolver.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/DnsResolver.pm Fri Sep 19 04:26:46 2008
@@ -98,7 +98,7 @@
Proto => 'udp',
);
if ($sock6) {
- $sock6->close();
+ $sock6->close() or die "error closing inet6 socket: $!";
1;
}
} ||
@@ -110,7 +110,7 @@
Proto => 'udp',
);
if ($sock6) {
- $sock6->close();
+ $sock6->close() or die "error closing inet4 socket: $!";
1;
}
};
@@ -186,7 +186,9 @@
return if $self->{no_resolver};
- $self->{sock}->close() if $self->{sock};
+ if ($self->{sock}) {
+ $self->{sock}->close() or die "error closing socket: $!";
+ }
my $sock;
my $errno;
@@ -235,26 +237,26 @@
} elsif ($! == EADDRINUSE || $! == EACCES) { # in use, let's try another source port
dbg("dns: UDP port %s already in use, trying another port", $lport);
} else {
- warn "Error creating a DNS resolver socket: $errno";
+ warn "error creating a DNS resolver socket: $errno";
goto no_sock;
}
}
if (!defined $sock) {
- warn "Can't create a DNS resolver socket: $errno";
+ warn "cannot create a DNS resolver socket: $errno";
goto no_sock;
}
eval {
my($bufsiz,$newbufsiz);
$bufsiz = $sock->sockopt(Socket::SO_RCVBUF)
- or die "Can't get a resolver socket rx buffer size: $!";
+ or die "cannot get a resolver socket rx buffer size: $!";
if ($bufsiz >= 32*1024) {
dbg("dns: resolver socket rx buffer size is %d bytes", $bufsiz);
} else {
$sock->sockopt(Socket::SO_RCVBUF, 32*1024)
- or die "Can't set a resolver socket rx buffer size: $!";
+ or die "cannot set a resolver socket rx buffer size: $!";
$newbufsiz = $sock->sockopt(Socket::SO_RCVBUF)
- or die "Can't get a resolver socket rx buffer size: $!";
+ or die "cannot get a resolver socket rx buffer size: $!";
dbg("dns: resolver socket rx buffer size changed from %d to %d bytes",
$bufsiz, $newbufsiz);
}
@@ -553,7 +555,7 @@
sub finish_socket {
my ($self) = @_;
if ($self->{sock}) {
- $self->{sock}->close();
+ $self->{sock}->close() or die "error closing socket: $!";
delete $self->{sock};
}
}
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Locker/Flock.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Locker/Flock.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Locker/Flock.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Locker/Flock.pm Fri Sep 19 04:26:46 2008
@@ -82,7 +82,9 @@
$oldalarm = alarm $max_retries;
# HELLO!?! IO::File doesn't have a flock() method?!
- if (flock ($fh, LOCK_EX)) {
+ if (!flock($fh, LOCK_EX)) {
+ warn "locker: safe_lock: cannot obtain a lock on log file: $!";
+ } else {
alarm $oldalarm;
$unalarmed = 1; # avoid calling alarm(0) twice
@@ -90,8 +92,8 @@
$is_locked = 1;
# just to be nice: let people know when it was locked
- $fh->print ("$$\n");
- $fh->flush ();
+ $fh->print("$$\n") or die "error writing to lock file: $!";
+ $fh->flush or die "cannot flush lock file: $!";
# keep the FD around - we need to keep the lockfile open or the lock
# is unlocked!
@@ -129,8 +131,8 @@
my $fh = $self->{lock_fhs}->{$path};
delete $self->{lock_fhs}->{$path};
- flock ($fh, LOCK_UN);
- $fh->close();
+ flock($fh, LOCK_UN) or die "cannot unlock a log file: $!";
+ $fh->close or die "error closing a lock file: $!";
dbg("locker: safe_unlock: unlocked $path.mutex");
@@ -163,8 +165,8 @@
}
my $fh = $self->{lock_fhs}->{$path};
- $fh->print ("$$\n");
- $fh->flush ();
+ $fh->print("$$\n") or die "error writing to lock file: $!";
+ $fh->flush or die "cannot flush lock file: $!";
dbg("locker: refresh_lock: refresh $path.mutex");
}
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Locker/UnixNFSSafe.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Locker/UnixNFSSafe.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Locker/UnixNFSSafe.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Locker/UnixNFSSafe.pm Fri Sep 19 04:26:46 2008
@@ -84,7 +84,7 @@
for (my $retries = 0; $retries < $max_retries; $retries++) {
if ($retries > 0) { $self->jittery_one_second_sleep(); }
- print LTMP "$hname.$$\n";
+ print LTMP "$hname.$$\n" or warn "Error writing to $lock_tmp: $!";
dbg("locker: safe_lock: trying to get lock on $path with $retries retries");
if (link($lock_tmp, $lock_file)) {
dbg("locker: safe_lock: link to $lock_file: link ok");
@@ -93,6 +93,7 @@
}
# link _may_ return false even if the link _is_ created
@stat = lstat($lock_tmp);
+ @stat or warn "locker: error accessing $lock_tmp: $!";
if (defined $stat[3] && $stat[3] > 1) {
dbg("locker: safe_lock: link to $lock_file: stat ok");
$is_locked = 1;
@@ -101,22 +102,26 @@
# check age of lockfile ctime
my $now = ($#stat < 11 ? undef : $stat[10]);
@stat = lstat($lock_file);
+ @stat or warn "locker: error accessing $lock_file: $!";
my $lock_age = ($#stat < 11 ? undef : $stat[10]);
if (defined($lock_age) && defined($now) && ($now - $lock_age) > LOCK_MAX_AGE)
{
# we got a stale lock, break it
dbg("locker: safe_lock: breaking stale $lock_file: age=" .
(defined $lock_age ? $lock_age : "undef") . " now=$now");
- unlink ($lock_file) || warn "locker: safe_lock: unlink of lock file $lock_file failed: $!\n";
+ unlink($lock_file)
+ or warn "locker: safe_lock: unlink of lock file $lock_file failed: $!\n";
}
}
- close(LTMP);
- unlink ($lock_tmp) || warn "locker: safe_lock: unlink of temp lock $lock_tmp failed: $!\n";
+ close LTMP or die "error closing $lock_tmp: $!";
+ unlink($lock_tmp)
+ or warn "locker: safe_lock: unlink of temp lock $lock_tmp failed: $!\n";
# record this for safe unlocking
if ($is_locked) {
@stat = lstat($lock_file);
+ @stat or warn "locker: error accessing $lock_file: $!";
my $lock_ctime = ($#stat < 11 ? undef : $stat[10]);
$self->{lock_ctimes} ||= { };
@@ -143,14 +148,21 @@
# directly because the server's clock may be out of sync with the client's.
my @stat_ourtmp;
- sysopen(LTMP, $lock_tmp, O_CREAT|O_WRONLY|O_EXCL, 0700);
- autoflush LTMP 1;
- print LTMP "\n";
-
- if (!(@stat_ourtmp = stat(LTMP)) || (scalar(@stat_ourtmp) < 11)) {
- warn "locker: safe_unlock: failed to create lock tmpfile $lock_tmp";
- close LTMP; unlink $lock_tmp;
+ if (!defined sysopen(LTMP, $lock_tmp, O_CREAT|O_WRONLY|O_EXCL, 0700)) {
+ warn "locker: safe_unlock: failed to create lock tmpfile $lock_tmp: $!";
return;
+ } else {
+ autoflush LTMP 1;
+ print LTMP "\n" or warn "Error writing to $lock_tmp: $!";
+
+ if (!(@stat_ourtmp = stat(LTMP)) || (scalar(@stat_ourtmp) < 11)) {
+ @stat_ourtmp or warn "locker: error accessing $lock_tmp: $!";
+ warn "locker: safe_unlock: failed to create lock tmpfile $lock_tmp";
+ close LTMP or die "error closing $lock_tmp: $!";
+ unlink($lock_tmp)
+ or warn "locker: safe_lock: unlink of lock file failed: $!\n";
+ return;
+ }
}
my $ourtmp_ctime = $stat_ourtmp[10]; # paranoia
@@ -158,7 +170,9 @@
die "locker: safe_unlock: stat failed on $lock_tmp";
}
- close LTMP; unlink $lock_tmp;
+ close LTMP or die "error closing $lock_tmp: $!";
+ unlink($lock_tmp)
+ or warn "locker: safe_lock: unlink of lock file failed: $!\n";
# 2. If the ctime hasn't been modified, unlink the file and return. If the
# lock has expired, sleep the usual random interval before returning. If we
@@ -171,13 +185,16 @@
return;
}
- my @stat_lock = lstat ($lock_file);
+ my @stat_lock = lstat($lock_file);
+ @stat_lock or warn "locker: error accessing $lock_file: $!";
+
my $now_ctime = $stat_lock[10];
if (defined $now_ctime && $now_ctime == $lock_ctime)
{
# things are good: the ctimes match so it was our lock
- unlink ($lock_file) || warn "locker: safe_unlock: unlink failed: $lock_file\n";
+ unlink($lock_file)
+ or warn "locker: safe_unlock: unlink failed: $lock_file\n";
dbg("locker: safe_unlock: unlink $lock_file");
if ($ourtmp_ctime >= $lock_ctime + LOCK_MAX_AGE) {
@@ -218,6 +235,8 @@
# update the lock_ctimes entry
my @stat = lstat($lock_file);
+ @stat or warn "locker: error accessing $lock_file: $!";
+
my $lock_ctime = ($#stat < 11 ? undef : $stat[10]);
$self->{lock_ctimes}->{$path} = $lock_ctime;
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Locker/Win32.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Locker/Win32.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Locker/Win32.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Locker/Win32.pm Fri Sep 19 04:26:46 2008
@@ -59,7 +59,8 @@
if (-e $lock_file && -M $lock_file > (LOCK_MAX_AGE / 86400)) {
dbg("locker: safe_lock: breaking stale lock: $lock_file");
- unlink($lock_file) || warn "locker: safe_lock: unlink of lock file $lock_file failed: $!\n";
+ unlink($lock_file)
+ or warn "locker: safe_lock: unlink of lock file $lock_file failed: $!\n";
}
for (my $retries = 0; $retries < $max_retries; $retries++) {
if ($retries > 0) {
@@ -67,19 +68,24 @@
# TODO: $self->jittery_one_second_sleep();?
}
dbg("locker: safe_lock: trying to get lock on $path with $retries retries");
- if (sysopen(LOCKFILE, $lock_file, O_RDWR|O_CREAT|O_EXCL)) {
+ if (!defined sysopen(LOCKFILE, $lock_file, O_RDWR|O_CREAT|O_EXCL)) {
+ dbg("locker: safe_lock: failed to create lock tmpfile $lock_file: $!");
+ } else {
dbg("locker: safe_lock: link to $lock_file: sysopen ok");
- close(LOCKFILE);
+ close(LOCKFILE) or warn "error closing a lock file: $!";
return 1;
}
my @stat = stat($lock_file);
+ @stat or warn "locker: error accessing $lock_file: $!";
+
# check age of lockfile ctime
my $age = ($#stat < 11 ? undef : $stat[10]);
if ((!defined($age) && $retries > $max_retries / 2) ||
(defined($age) && (time - $age > LOCK_MAX_AGE)))
{
dbg("locker: safe_lock: breaking stale lock: $lock_file");
- unlink ($lock_file) || warn "locker: safe_lock: unlink of lock file $lock_file failed: $!\n";
+ unlink($lock_file)
+ or warn "locker: safe_lock: unlink of lock file $lock_file failed: $!\n";
}
}
return 0;
@@ -90,7 +96,8 @@
sub safe_unlock {
my ($self, $path) = @_;
- unlink ("$path.lock") || warn "locker: safe_unlock: unlink failed: $path.lock\n";
+ unlink("$path.lock")
+ or warn "locker: safe_unlock: unlink failed: $path.lock\n";
dbg("locker: safe_unlock: unlink $path.lock");
}
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Logger/File.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Logger/File.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Logger/File.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Logger/File.pm Fri Sep 19 04:26:46 2008
@@ -79,14 +79,17 @@
sub log_message {
my ($self, $level, $msg) = @_;
- syswrite(STDLOG, sprintf("%s [%s] %s: %s\n",
+ my($nwrite) = syswrite(STDLOG, sprintf("%s [%s] %s: %s\n",
scalar localtime, $$, $level, $msg));
+ defined $nwrite or warn "error writing to log file: $!";
}
sub close_log {
my ($self) = @_;
- close(STDLOG) if defined $self->{filename};
+ if (defined $self->{filename}) {
+ close(STDLOG) or die "error closing log file: $!";
+ }
}
1;
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Logger/Stderr.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Logger/Stderr.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Logger/Stderr.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Logger/Stderr.pm Fri Sep 19 04:26:46 2008
@@ -50,7 +50,8 @@
sub log_message {
my ($self, $level, $msg) = @_;
- print STDERR "[$$] $level: $msg\n";
+ print STDERR "[$$] $level: $msg\n"
+ or warn "Error writing to log file: $!";
}
sub close_log {
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Message.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Message.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Message.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Message.pm Fri Sep 19 04:26:46 2008
@@ -132,7 +132,9 @@
}
elsif (ref $message eq 'GLOB' || ref $message eq 'IO::File') {
if (defined fileno $message) {
- @message = <$message>;
+ $! = 0; @message = <$message>;
+ $!==0 or die "error reading: $!";
+ dbg("message: empty message read from a file") if !@message;
}
}
elsif (ref $message) {
@@ -534,7 +536,7 @@
while (my $part = shift @toclean) {
# bug 5557: windows requires tmp file be closed before it can be rm'd
if (ref $part->{'raw'} eq 'GLOB') {
- close ($part->{'raw'});
+ close($part->{'raw'}) or die "error closing input file: $!";
}
# bug 5858: avoid memory leak with deep MIME structure
@@ -563,7 +565,9 @@
# delete temporary files
if ($self->{'tmpfiles'}) {
- unlink @{$self->{'tmpfiles'}};
+ for my $fn (@{$self->{'tmpfiles'}}) {
+ unlink($fn) or warn "cannot unlink $fn: $!";
+ }
delete $self->{'tmpfiles'};
}
}
@@ -576,7 +580,9 @@
# in code of a DESTROY method from clobbering global variables $@ and $!
local($@,$!); # keep outer error handling unaffected by DESTROY
if ($self->{'tmpfiles'}) {
- unlink @{$self->{'tmpfiles'}};
+ for my $fn (@{$self->{'tmpfiles'}}) {
+ unlink($fn) or dbg("message: cannot unlink $fn: $!");
+ }
}
}
@@ -680,7 +686,8 @@
# will have that data)
if (ref $toparse->[0]->{'raw'} eq 'GLOB') {
# Make sure we close it if it's a temp file -- Bug 5166
- close ($toparse->[0]->{'raw'});
+ close($toparse->[0]->{'raw'})
+ or die "error closing input file: $!";
}
delete $toparse->[0]->{'raw'};
@@ -922,7 +929,7 @@
# we cannot just delete immediately in the POSIX idiom, as this is
# unportable (to win32 at least)
push @{$self->{tmpfiles}}, $filepath;
- $msg->{'raw'}->print(@{$body});
+ $msg->{'raw'}->print(@{$body}) or die "error writing to $filepath: $!";
}
}
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Message/Node.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Message/Node.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Message/Node.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Message/Node.pm Fri Sep 19 04:26:46 2008
@@ -271,8 +271,10 @@
if (ref $self->{'raw'} eq 'GLOB') {
my @array;
my $fd = $self->{'raw'};
- seek $fd, 0, 0;
- @array = <$fd>;
+ seek($fd, 0, 0) or die "message: cannot rewind file: $!";
+ $! = 0; @array = <$fd>;
+ $!==0 or die "message: error reading: $!";
+ dbg("message: empty message read") if !@array;
return \@array;
}
@@ -303,10 +305,15 @@
# if the part is held in a temp file, read it into the scalar
if (ref $self->{'raw'} eq 'GLOB') {
my $fd = $self->{'raw'};
- seek $fd, 0, 0;
+ seek($fd, 0, 0) or die "message: cannot rewind file: $!";
local $/ = undef;
- $raw = <$fd>;
- $raw = '' if !defined $raw;
+ $! = 0; $raw = <$fd>;
+ defined $raw || $!==0
+ or die "message: error reading from a temp file: $!";
+ if (!defined $raw) {
+ dbg("message: empty message read from a temp file");
+ $raw = '';
+ }
}
else {
# create a new scalar from the raw array in memory
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/PerMsgStatus.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/PerMsgStatus.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/PerMsgStatus.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/PerMsgStatus.pm Fri Sep 19 04:26:46 2008
@@ -2420,8 +2420,8 @@
}
my ($tmpf, $tmpfh) = Mail::SpamAssassin::Util::secure_tmpfile();
- print $tmpfh $$fulltext;
- close $tmpfh;
+ print $tmpfh $$fulltext or die "error writing to $tmpf: $!";
+ close $tmpfh or die "error closing $tmpf: $!";
$self->{fulltext_tmpfile} = $tmpf;
@@ -2438,7 +2438,8 @@
sub delete_fulltext_tmpfile {
my ($self) = @_;
if (defined $self->{fulltext_tmpfile}) {
- unlink $self->{fulltext_tmpfile};
+ unlink $self->{fulltext_tmpfile}
+ or die "cannot unlink ".$self->{fulltext_tmpfile}.": $!";
$self->{fulltext_tmpfile} = undef;
}
}
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Bayes.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Bayes.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Bayes.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Bayes.pm Fri Sep 19 04:26:46 2008
@@ -868,18 +868,36 @@
my $template = '%3.3f %10u %10u %10u %s'."\n";
if ( $magic ) {
- printf ($template, 0.0, 0, $bv, 0, 'non-token data: bayes db version');
- printf ($template, 0.0, 0, $ns, 0, 'non-token data: nspam');
- printf ($template, 0.0, 0, $nh, 0, 'non-token data: nham');
- printf ($template, 0.0, 0, $nt, 0, 'non-token data: ntokens');
- printf ($template, 0.0, 0, $oa, 0, 'non-token data: oldest atime');
- printf ($template, 0.0, 0, $na, 0, 'non-token data: newest atime') if ( $bv >= 2 );
- printf ($template, 0.0, 0, $sb, 0, 'non-token data: current scan-count') if ( $bv < 2 );
- printf ($template, 0.0, 0, $js, 0, 'non-token data: last journal sync atime') if ( $bv >= 2 );
- printf ($template, 0.0, 0, $le, 0, 'non-token data: last expiry atime');
+ printf($template, 0.0, 0, $bv, 0, 'non-token data: bayes db version')
+ or die "Error writing: $!";
+ printf($template, 0.0, 0, $ns, 0, 'non-token data: nspam')
+ or die "Error writing: $!";
+ printf($template, 0.0, 0, $nh, 0, 'non-token data: nham')
+ or die "Error writing: $!";
+ printf($template, 0.0, 0, $nt, 0, 'non-token data: ntokens')
+ or die "Error writing: $!";
+ printf($template, 0.0, 0, $oa, 0, 'non-token data: oldest atime')
+ or die "Error writing: $!";
if ( $bv >= 2 ) {
- printf ($template, 0.0, 0, $ad, 0, 'non-token data: last expire atime delta');
- printf ($template, 0.0, 0, $er, 0, 'non-token data: last expire reduction count');
+ printf($template, 0.0, 0, $na, 0, 'non-token data: newest atime')
+ or die "Error writing: $!";
+ }
+ if ( $bv < 2 ) {
+ printf($template, 0.0, 0, $sb, 0, 'non-token data: current scan-count')
+ or die "Error writing: $!";
+ }
+ if ( $bv >= 2 ) {
+ printf($template, 0.0, 0, $js, 0, 'non-token data: last journal sync atime')
+ or die "Error writing: $!";
+ }
+ printf($template, 0.0, 0, $le, 0, 'non-token data: last expiry atime')
+ or die "Error writing: $!";
+ if ( $bv >= 2 ) {
+ printf($template, 0.0, 0, $ad, 0, 'non-token data: last expire atime delta')
+ or die "Error writing: $!";
+
+ printf($template, 0.0, 0, $er, 0, 'non-token data: last expire reduction count')
+ or die "Error writing: $!";
}
}
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/BodyRuleBaseExtractor.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/BodyRuleBaseExtractor.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/BodyRuleBaseExtractor.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/BodyRuleBaseExtractor.pm Fri Sep 19 04:26:46 2008
@@ -32,6 +32,7 @@
use Mail::SpamAssassin::Util qw(untaint_var);
use Mail::SpamAssassin::Util::Progress;
+use Errno qw(ENOENT EACCES EEXIST);
use Data::Dumper;
use strict;
@@ -508,14 +509,19 @@
}
}
}
- print $tmpfh "use bytes; m".$quos.$rule.$quos.$mods;
- close $tmpfh or die "cannot write to $tmpf";
+ print $tmpfh "use bytes; m".$quos.$rule.$quos.$mods
+ or die "error writing to $tmpf: $!";
+ close $tmpfh or die "error closing $tmpf: $!";
my $perl = $self->get_perl();
- open (IN, "$perl -c -Mre=debug $tmpf 2>&1 |") or die "cannot run $perl";
- my $fullstr = join('', <IN>);
- close IN;
- unlink $tmpf;
+ open (IN, "$perl -c -Mre=debug $tmpf 2>&1 |") or die "cannot run $perl";
+
+ my $fullstr;
+ { local $/ = undef; $! = 0; $fullstr = <IN> }
+ defined $fullstr || $!==0 or die "error reading from pipe: $!";
+ close IN or die "error closing pipe: $!";
+ unlink $tmpf or die "cannot unlink $tmpf: $!";
+ defined $fullstr or warn "empty result from a pipe";
# now parse the -Mre=debug output.
# perl 5.10 format
@@ -947,11 +953,11 @@
}
if ($failed) {
- print "want: /".join('/ /', @want)."/\n";
- print "got: /".join('/ /', @got)."/\n";
+ print "want: /".join('/ /', @want)."/\n" or die "error writing: $!";
+ print "got: /".join('/ /', @got)."/\n" or die "error writing: $!";
return 0;
} else {
- print "ok\n";
+ print "ok\n" or die "error writing: $!";
return 1;
}
}
@@ -985,8 +991,12 @@
sub read_cachefile {
my ($self, $cachefile) = @_;
if (open(IN, "<".$cachefile)) {
- my $str = join("", <IN>);
- close IN;
+ my $str;
+ { local $/ = undef; $! = 0; $str = <IN> }
+ defined $str || $!==0 or die "error reading from $cachefile: $!";
+ close IN or die "error closing $cachefile: $!";
+ defined $str or warn "empty $cachefile";
+
my $untainted = untaint_var($str);
my $VAR1; # Data::Dumper
@@ -1004,10 +1014,16 @@
$dump->Deepcopy(1);
$dump->Purity(1);
$dump->Indent(1);
- mkdir ($self->{main}->{bases_cache_dir});
- open (CACHE, ">$cachefile") or warn "cannot write to $cachefile";
- print CACHE $dump->Dump, ";1;";
- close CACHE or warn "cannot close $cachefile";
+ if (mkdir($self->{main}->{bases_cache_dir})) {
+ # successfully created
+ } elsif ($! == EEXIST) {
+ dbg("zoom: ok, cache directory already existed");
+ } else {
+ warn "cannot create a directory: $!";
+ }
+ open(CACHE, ">$cachefile") or warn "cannot write to $cachefile";
+ print CACHE ($dump->Dump, ";1;") or die "error writing: $!";
+ close CACHE or die "error closing $cachefile: $!";
}
1;
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/DCC.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/DCC.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/DCC.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/DCC.pm Fri Sep 19 04:26:46 2008
@@ -29,7 +29,7 @@
=head1 DESCRIPTION
The DCC or Distributed Checksum Clearinghouse is a system of servers
-collecting and counting checksums of millions of mail messages. The
+collecting and counting checksums of millions of mail messages. TheSpamAssassin.pm
counts can be used by SpamAssassin to detect and reject or filter spam.
Because simplistic checksums of spam can be easily defeated, the main
@@ -66,7 +66,9 @@
use Mail::SpamAssassin::Plugin;
use Mail::SpamAssassin::Logger;
use Mail::SpamAssassin::Timeout;
-use Mail::SpamAssassin::Util qw(untaint_var);
+use Mail::SpamAssassin::Util qw(untaint_var untaint_file_path
+ proc_status_ok exit_status_str);
+use Errno qw(ENOENT EACCES);
use IO::Socket;
use vars qw(@ISA);
@@ -200,9 +202,12 @@
if (!defined $value || !length $value) {
return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
}
- $value = Mail::SpamAssassin::Util::untaint_file_path($value);
- if (!-d $value) {
- info("config: dcc_home \"$value\" isn't a directory");
+ $value = untaint_file_path($value);
+ my $stat_errn = stat($value) ? 0 : 0+$!;
+ if ($stat_errn != 0 || !-d _) {
+ my $msg = $stat_errn == ENOENT ? "does not exist"
+ : !-d _ ? "is not a directory" : "not accessible: $!";
+ info("config: dcc_home \"$value\" $msg");
return $Mail::SpamAssassin::Conf::INVALID_VALUE;
}
@@ -227,7 +232,7 @@
if (!defined $value || !length $value) {
return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
}
- $value = Mail::SpamAssassin::Util::untaint_file_path($value);
+ $value = untaint_file_path($value);
if (!-S $value) {
info("config: dcc_dccifd_path \"$value\" isn't a socket");
return $Mail::SpamAssassin::Conf::INVALID_VALUE;
@@ -255,7 +260,7 @@
if (!defined $value || !length $value) {
return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
}
- $value = Mail::SpamAssassin::Util::untaint_file_path($value);
+ $value = untaint_file_path($value);
if (!-x $value) {
info("config: dcc_path \"$value\" isn't an executable");
return $Mail::SpamAssassin::Conf::INVALID_VALUE;
@@ -323,11 +328,11 @@
my $dcchome = $self->{main}->{conf}->{dcc_home} || '';
my $dccifd = $self->{main}->{conf}->{dcc_dccifd_path} || '';
- if (!$dccifd && ($dcchome && -S "$dcchome/dccifd")) {
+ if ($dccifd eq '' && ($dcchome ne '' && -S "$dcchome/dccifd")) {
$dccifd = "$dcchome/dccifd";
}
- unless ($dccifd && -S $dccifd && -w _ && -r _) {
+ unless ($dccifd ne '' && -S $dccifd && -w _ && -r _) {
dbg("dcc: dccifd is not available: no r/w dccifd socket found");
return 0;
}
@@ -351,14 +356,14 @@
my $dcchome = $self->{main}->{conf}->{dcc_home} || '';
my $dccproc = $self->{main}->{conf}->{dcc_path} || '';
- if (!$dccproc && ($dcchome && -x "$dcchome/bin/dccproc")) {
- $dccproc = "$dcchome/bin/dccproc";
+ if ($dccproc eq '' && ($dcchome ne '' && -x "$dcchome/bin/dccproc")) {
+ $dccproc = "$dcchome/bin/dccproc";
}
- unless ($dccproc) {
+ if ($dccproc eq '') {
$dccproc = Mail::SpamAssassin::Util::find_executable_in_env_path('dccproc');
}
- unless ($dccproc && -x $dccproc) {
+ unless ($dccproc ne '' && -x $dccproc) {
dbg("dcc: dccproc is not available: no dccproc executable found");
return 0;
}
@@ -529,7 +534,7 @@
$sock->print("unknown\r\n") || dbg("dcc: failed write") && die; # recipients
$sock->print("\n") || dbg("dcc: failed write") && die; # recipients
- $sock->print($$fulltext);
+ $sock->print($$fulltext) || dbg("dcc: failed write") && die;
$sock->shutdown(1) || dbg("dcc: failed socket shutdown: $!") && die;
@@ -595,7 +600,7 @@
local $SIG{PIPE} = sub { die "__brokenpipe__ignore__\n" };
# note: not really tainted, this came from system configuration file
- my $path = Mail::SpamAssassin::Util::untaint_file_path($self->{main}->{conf}->{dcc_path});
+ my $path = untaint_file_path($self->{main}->{conf}->{dcc_path});
my $opts = $self->{main}->{conf}->{dcc_options};
my @opts = !defined $opts ? () : split(' ',$opts);
@@ -611,9 +616,12 @@
$tmpf, 1, $path, "-H", "-x", "0", @opts);
$pid or die "$!\n";
- my @null = <DCC>;
- close DCC
- or dbg(sprintf("dcc: [%s] finished: %s exit=0x%04x",$pid,$!,$?));
+ $! = 0; my @null = <DCC>;
+ $!==0 or die "error reading from pipe: $!";
+
+ my $errno = 0; close DCC or $errno = $!;
+ proc_status_ok($?,$errno)
+ or info("dcc: [%s] finished: %s", $pid, exit_status_str($?,$errno));
if (!@null) {
# no facility prefix on this
@@ -643,8 +651,9 @@
if (kill('TERM',$pid)) { dbg("dcc: killed stale helper [$pid]") }
else { dbg("dcc: killing helper application [$pid] failed: $!") }
}
- close DCC
- or dbg(sprintf("dcc: [%s] terminated: %s exit=0x%04x",$pid,$!,$?));
+ my $errno = 0; close(DCC) or $errno = $!;
+ proc_status_ok($?,$errno)
+ or info("dcc: [%s] terminated: %s", $pid, exit_status_str($?,$errno));
}
$permsgstatus->leave_helper_run_mode();
@@ -745,7 +754,7 @@
$sock->print("unknown\r\n") || dbg("report: dccifd failed write") && die; # recipients
$sock->print("\n") || dbg("report: dccifd failed write") && die; # recipients
- $sock->print($$fulltext);
+ $sock->print($$fulltext) || dbg("report: dccifd failed write") && die;
$sock->shutdown(1) || dbg("report: dccifd failed socket shutdown: $!") && die;
@@ -780,7 +789,7 @@
my $timeout = $options->{report}->{conf}->{dcc_timeout};
# note: not really tainted, this came from system configuration file
- my $path = Mail::SpamAssassin::Util::untaint_file_path($options->{report}->{conf}->{dcc_path});
+ my $path = untaint_file_path($options->{report}->{conf}->{dcc_path});
my $opts = $self->{main}->{conf}->{dcc_options};
my @opts = !defined $opts ? () : split(' ',$opts);
untaint_var(\@opts);
@@ -803,11 +812,16 @@
my $pid = Mail::SpamAssassin::Util::helper_app_pipe_open(*DCC,
$tmpf, 1, $path, "-H", "-t", "many", "-x", "0", @opts);
$pid or die "$!\n";
-
- my @ignored = <DCC>;
- $options->{report}->close_pipe_fh(\*DCC);
- waitpid ($pid, 0);
-
+ $! = 0; my @ignored = <DCC>;
+ $!==0 or die "error reading from pipe: $!";
+ dbg("dcc: empty response") if !@ignored;
+
+ my $errno = 0; close DCC or $errno = $!;
+ # closing a pipe also waits for the process executing on the pipe to
+ # complete, no need to explicitly call waitpid
+ # my $child_stat = waitpid($pid,0) > 0 ? $? : undef;
+ proc_status_ok($?,$errno)
+ or die "dcc: reporter error: ".exit_status_str($?,$errno)."\n";
});
$options->{report}->leave_helper_run_mode();
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Hashcash.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Hashcash.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Hashcash.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Hashcash.pm Fri Sep 19 04:26:46 2008
@@ -93,6 +93,7 @@
use Mail::SpamAssassin::Util qw(untaint_var);
use Digest::SHA1 qw(sha1);
+use Errno qw(ENOENT EACCES);
use Fcntl;
use File::Path;
use File::Basename;
@@ -281,7 +282,10 @@
my $path = $main->sed_path ($main->{conf}->{hashcash_doublespend_path});
my $parentdir = dirname ($path);
- if (!-d $parentdir) {
+ my $stat_errn = stat($parentdir) ? 0 : 0+$!;
+ if ($stat_errn == 0 && !-d _) {
+ dbg("hashcash: parent dir $parentdir exists but is not a directory");
+ } elsif ($stat_errn == ENOENT) {
# run in an eval(); if mkpath has no perms, it calls die()
eval {
mkpath ($parentdir, 0, (oct ($main->{conf}->{hashcash_doublespend_file_mode}) & 0777));
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/HeaderEval.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/HeaderEval.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/HeaderEval.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/HeaderEval.pm Fri Sep 19 04:26:46 2008
@@ -230,15 +230,16 @@
}
if (!open (TRIPLETS, "<$filename")) {
- dbg("eval: failed to open '$filename', cannot check dictionary");
+ dbg("eval: failed to open '$filename', cannot check dictionary: $!");
return 1;
}
- while(<TRIPLETS>) {
+ for($!=0; <TRIPLETS>; $!=0) {
chomp;
$triplets{$_} = 1;
}
- close(TRIPLETS);
+ defined $_ || $!==0 or die "error reading from $filename: $!";
+ close(TRIPLETS) or die "error closing $filename: $!";
$triplets_loaded = 1;
} # if (!$triplets_loaded)
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/PhishTag.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/PhishTag.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/PhishTag.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/PhishTag.pm Fri Sep 19 04:26:46 2008
@@ -105,7 +105,7 @@
my $target;
open(F, '<', $pms->{conf}->{trigger_config});
- while(<F>){
+ for($!=0; <F>; $!=0){
#each entry is separated by blank lines
undef($target) if(!/\S/);
@@ -125,7 +125,8 @@
push @$target, $_;
}
}
- close(F);
+ defined $_ || $!==0 or die "error reading config file: $!";
+ close(F) or die "error closing config file: $!";
}
sub hit_rule {
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Pyzor.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Pyzor.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Pyzor.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Pyzor.pm Fri Sep 19 04:26:46 2008
@@ -37,6 +37,8 @@
use Mail::SpamAssassin::Plugin;
use Mail::SpamAssassin::Logger;
use Mail::SpamAssassin::Timeout;
+use Mail::SpamAssassin::Util qw(untaint_file_path
+ proc_status_ok exit_status_str);
use strict;
use warnings;
use bytes;
@@ -181,7 +183,7 @@
if (!defined $value || !length $value) {
return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;
}
- $value = Mail::SpamAssassin::Util::untaint_file_path($value);
+ $value = untaint_file_path($value);
if (!-x $value) {
info("config: pyzor_path \"$value\" isn't an executable");
return $Mail::SpamAssassin::Conf::INVALID_VALUE;
@@ -260,7 +262,7 @@
my $tmpf = $permsgstatus->create_fulltext_tmpfile($fulltext);
# note: not really tainted, this came from system configuration file
- my $path = Mail::SpamAssassin::Util::untaint_file_path($self->{main}->{conf}->{pyzor_path});
+ my $path = untaint_file_path($self->{main}->{conf}->{pyzor_path});
my $opts = $self->{main}->{conf}->{pyzor_options} || '';
@@ -277,9 +279,12 @@
$tmpf, 1, $path, split(' ', $opts), "check");
$pid or die "$!\n";
- @response = <PYZOR>;
- close PYZOR
- or dbg(sprintf("pyzor: [%s] finished: %s exit=0x%04x",$pid,$!,$?));
+ $! = 0; @response = <PYZOR>;
+ $!==0 or die "error reading from pipe: $!";
+
+ my $errno = 0; close PYZOR or $errno = $!;
+ proc_status_ok($?,$errno)
+ or info("pyzor: [%s] finished: %s", $pid, exit_status_str($?,$errno));
if (!@response) {
# this exact string is needed below
@@ -300,8 +305,9 @@
if (kill('TERM',$pid)) { dbg("pyzor: killed stale helper [$pid]") }
else { dbg("pyzor: killing helper application [$pid] failed: $!") }
}
- close PYZOR
- or dbg(sprintf("pyzor: [%s] terminated: %s exit=0x%04x",$pid,$!,$?));
+ my $errno = 0; close PYZOR or $errno = $!;
+ proc_status_ok($?,$errno)
+ or info("pyzor: [%s] terminated: %s", $pid, exit_status_str($?,$errno));
}
$permsgstatus->leave_helper_run_mode();
@@ -377,7 +383,7 @@
my ($self, $options, $tmpf) = @_;
# note: not really tainted, this came from system configuration file
- my $path = Mail::SpamAssassin::Util::untaint_file_path($options->{report}->{conf}->{pyzor_path});
+ my $path = untaint_file_path($options->{report}->{conf}->{pyzor_path});
my $opts = $options->{report}->{conf}->{pyzor_options} || '';
my $timeout = $self->{main}->{conf}->{pyzor_timeout};
@@ -395,10 +401,16 @@
$tmpf, 1, $path, split(' ', $opts), "report");
$pid or die "$!\n";
- my @ignored = <PYZOR>;
- $options->{report}->close_pipe_fh(\*PYZOR);
-
- waitpid ($pid, 0);
+ $! = 0; my @ignored = <PYZOR>;
+ $!==0 or die "error reading from pipe: $!";
+ dbg("pyzor: empty response") if !@ignored;
+
+ my $errno = 0; close PYZOR or $errno = $!;
+ # closing a pipe also waits for the process executing on the pipe to
+ # complete, no need to explicitly call waitpid
+ # my $child_stat = waitpid($pid,0) > 0 ? $? : undef;
+ proc_status_ok($?,$errno)
+ or die "pyzor: reporter error: ".exit_status_str($?,$errno)."\n";
});
$options->{report}->leave_helper_run_mode();
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Razor2.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Razor2.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Razor2.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Razor2.pm Fri Sep 19 04:26:46 2008
@@ -245,7 +245,9 @@
last;
}
}
- close $rc->{logref}->{fd} if ($untie);
+ if ($untie) {
+ close($rc->{logref}->{fd}) or die "error closing log: $!";
+ }
}
if ($type eq 'check') {
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Test.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Test.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Test.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/Test.pm Fri Sep 19 04:26:46 2008
@@ -55,14 +55,16 @@
# the important bit!
$self->register_eval_rule ("check_test_plugin");
- print "registered Mail::SpamAssassin::Plugin::Test: $self\n";
+ print "registered Mail::SpamAssassin::Plugin::Test: $self\n"
+ or die "Error writing: $!";
return $self;
}
# and the eval rule itself
sub check_test_plugin {
my ($self, $permsgstatus) = @_;
- print "Mail::SpamAssassin::Plugin::Test eval test called: $self\n";
+ print "Mail::SpamAssassin::Plugin::Test eval test called: $self\n"
+ or die "Error writing: $!";
# ... hard work goes here...
return 1;
}
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/TextCat.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/TextCat.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/TextCat.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Plugin/TextCat.pm Fri Sep 19 04:26:46 2008
@@ -359,9 +359,12 @@
return;
}
- local $/ = undef;
- @lm = split(/\n/, <LM>);
- close(LM);
+ { local $/ = undef; local $_;
+ $! = 0; $_ = <LM>;
+ defined $_ || $!==0 or die "error reading from $languages_filename: $!";
+ @lm = split(/\n/, $_) if defined $_;
+ }
+ close(LM) or die "error closing $languages_filename: $!";
# create language ngram maps once
for (@lm) {
# look for end delimiter
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Reporter.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Reporter.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Reporter.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Reporter.pm Fri Sep 19 04:26:46 2008
@@ -23,7 +23,6 @@
use warnings;
use bytes;
use re 'taint';
-use POSIX ":sys_wait_h";
use Mail::SpamAssassin::Logger;
use vars qw{
@@ -94,28 +93,6 @@
}
###########################################################################
-# non-public methods.
-
-# Close an fh piped to a process, possibly exiting if the process
-# returned nonzero. thanks to nix /at/ esperi.demon.co.uk for this.
-sub close_pipe_fh {
- my ($self, $fh) = @_;
-
- return if close ($fh);
-
- my $exitstatus = $?;
- dbg("reporter: raw exit code: $exitstatus");
-
- if (WIFEXITED ($exitstatus) && (WEXITSTATUS ($exitstatus))) {
- die "reporter: exited with non-zero exit code " . WEXITSTATUS($exitstatus) . "\n";
- }
-
- if (WIFSIGNALED ($exitstatus)) {
- die "reporter: exited due to signal " . WTERMSIG($exitstatus) . "\n";
- }
-}
-
-###########################################################################
sub create_fulltext_tmpfile {
Mail::SpamAssassin::PerMsgStatus::create_fulltext_tmpfile(@_);
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/SpamdForkScaling.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/SpamdForkScaling.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/SpamdForkScaling.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/SpamdForkScaling.pm Fri Sep 19 04:26:46 2008
@@ -185,7 +185,7 @@
}
if ($sock) {
- $sock->close;
+ $sock->close or info("prefork: error closing socket: $!");
}
delete $self->{kids}->{$pid}; # remove from list
@@ -435,7 +435,7 @@
my $fno = $sock->fileno;
if (defined $fno) {
$self->{backchannel}->remove_from_selector($sock);
- $sock->close();
+ $sock->close or info("prefork: error closing socket: $!");
}
return PFSTATE_ERROR;
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/SubProcBackChannel.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/SubProcBackChannel.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/SubProcBackChannel.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/SubProcBackChannel.pm Fri Sep 19 04:26:46 2008
@@ -87,11 +87,12 @@
my $fh = $self->{latest_kid_fh};
- close $self->{parent}; # because it's us!
+ close $self->{parent} # because it's us!
+ or die "backchannel: error closing parent side of the pipe: $!";
# disable caching for parent<->child relations
my ($old) = select($fh);
- $|++;
+ $| = 1; # turn off buffering
select($old);
$self->{kids}->{$pid} = $fh;
@@ -151,7 +152,8 @@
sub setup_backchannel_child_post_fork {
my ($self) = @_;
- close $self->{latest_kid_fh}; # because it's us!
+ close $self->{latest_kid_fh} # because it's us!
+ or die "backchannel: error closing child side of the pipe: $!";
my $old = select($self->{parent});
$| = 1; # print to parent by default, turn off buffering
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Util.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Util.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Util.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Util.pm Fri Sep 19 04:26:46 2008
@@ -57,7 +57,8 @@
@ISA = qw(Exporter);
@EXPORT = ();
- @EXPORT_OK = qw(&local_tz &base64_decode &untaint_var);
+ @EXPORT_OK = qw(&local_tz &base64_decode &untaint_var &untaint_file_path
+ &exit_status_str &proc_status_ok);
}
use Mail::SpamAssassin;
@@ -69,8 +70,9 @@
use Time::Local;
use Sys::Hostname (); # don't import hostname() into this namespace!
use Fcntl;
-use POSIX (); # don't import anything unless we ask explicitly!
-use Errno qw(EEXIST);
+use Errno qw(ENOENT EACCES EEXIST);
+use POSIX qw(:sys_wait_h WIFEXITED WIFSIGNALED WIFSTOPPED WEXITSTATUS
+ WTERMSIG WSTOPSIG);
###########################################################################
@@ -144,7 +146,7 @@
next;
}
elsif (!(@stat=stat($dir))) {
- dbg("util: PATH included '$dir', which doesn't exist, dropping");
+ dbg("util: PATH included '$dir', which is unusable, dropping: $!");
next;
}
elsif (!-d _) {
@@ -182,7 +184,7 @@
for my $d ((File::Spec->curdir, File::Spec->rootdir, File::Spec->tmpdir)) {
opendir(TAINT, $d) || next;
$blank = readdir(TAINT);
- closedir(TAINT);
+ closedir(TAINT) or die "error closing directory $d: $!";
last;
}
if (!(defined $blank && $blank)) {
@@ -310,6 +312,46 @@
###########################################################################
+# map process termination status number to an informative string, and
+# append optional mesage (dual-valued errno or a string or a number),
+# returning the resulting string
+#
+sub exit_status_str($;$) {
+ my($stat,$errno) = @_;
+ my $str;
+ if (WIFEXITED($stat)) {
+ $str = sprintf("exit %d", WEXITSTATUS($stat));
+ } elsif (WIFSTOPPED($stat)) {
+ $str = sprintf("stopped, signal %d", WSTOPSIG($stat));
+ } else {
+ my $sig = WTERMSIG($stat);
+ $str = $sig == 2 ? 'INTERRUPTED' : $sig == 6 ? 'ABORTED'
+ : sprintf("DIED on signal %d (%04x)", $sig,$stat);
+ }
+ if (defined $errno) { # deal with dual-valued and plain variables
+ $str .= ', '.$errno if (0+$errno) != 0 || ($errno ne '' && $errno ne '0');
+ }
+ return $str;
+}
+
+###########################################################################
+
+# check errno to be 0 and a process exit status to be in the list of success
+# status codes, returning true if both are ok, and false otherwise
+#
+sub proc_status_ok($;$@) {
+ my($exit_status,$errno,@success) = @_;
+ my $ok = 0;
+ if ((!defined $errno || $errno == 0) && WIFEXITED($exit_status)) {
+ my $j = WEXITSTATUS($exit_status);
+ if (!@success) { $ok = $j==0 } # empty list implies only status 0 is good
+ elsif (grep {$_ == $j} @success) { $ok = 1 }
+ }
+ return $ok;
+}
+
+###########################################################################
+
# timezone mappings: in case of conflicts, use RFC 2822, then most
# common and least conflicting mapping
my %TZ = (
@@ -986,7 +1028,7 @@
# instead, we require O_EXCL|O_CREAT to guarantee us proper
# ownership of our file, read the open(2) man page
if (sysopen($tmpfile, $reportfile, O_RDWR|O_CREAT|O_EXCL, 0600)) {
- binmode $tmpfile;
+ binmode $tmpfile or die "cannot set $reportfile to binmode: $!";
last;
}
@@ -1000,7 +1042,7 @@
# ensure the file handle is not semi-open in some way
if ($tmpfile) {
- close $tmpfile;
+ close $tmpfile or info("error closing $reportfile: $!");
}
}
@@ -1433,7 +1475,7 @@
}
my $f = fileno(STDIN);
- close STDIN;
+ close STDIN or die "error closing STDIN: $!";
# sanity: was that the *real* STDIN? if not, close that one too ;)
if ($f != 0) {
@@ -1462,7 +1504,7 @@
if ($duperr2out) { # 2>&1
my $f = fileno(STDERR);
- close STDERR;
+ close STDERR or die "error closing STDERR: $!";
# sanity: was that the *real* STDERR? if not, close that one too ;)
if ($f != 2) {
@@ -1589,12 +1631,11 @@
# delete "__db.[DBNAME]" and "__db.[DBNAME].*"
foreach my $tfile ($db_tmpfile, <$db_tmpfile.*>) {
my $file = untaint_file_path($tfile);
- next unless (-e $file);
+ my $stat_errn = stat($file) ? 0 : 0+$!;
+ next if $stat_errn == ENOENT;
dbg("Berkeley DB bug work-around: cleaning tmp file $file");
- if (!unlink($file)) {
- die "cannot remove Berkeley DB tmp file $file: $!\n";
- }
+ unlink($file) or warn "cannot remove Berkeley DB tmp file $file: $!\n";
}
}
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Util/DependencyInfo.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Util/DependencyInfo.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Util/DependencyInfo.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Util/DependencyInfo.pm Fri Sep 19 04:26:46 2008
@@ -164,7 +164,7 @@
desc => 'If this module is installed, and you enable the DKIM plugin,
SpamAssassin will perform DKIM lookups when a DKIM-Signature
header is present in the message headers. (New versions of this module
- support both Domain Keys and DKIM, rendering Mail::DomainKeys obsolete.
+ support both DomainKeys and DKIM, rendering Mail::DomainKeys obsolete.
versions prior to 0.28 are buggy and non-compliant with IETF
DKIM signing policies.)'
},
Modified: spamassassin/trunk/lib/Mail/SpamAssassin/Util/MemoryDump.pm
URL: http://svn.apache.org/viewvc/spamassassin/trunk/lib/Mail/SpamAssassin/Util/MemoryDump.pm?rev=697056&r1=697055&r2=697056&view=diff
==============================================================================
--- spamassassin/trunk/lib/Mail/SpamAssassin/Util/MemoryDump.pm (original)
+++ spamassassin/trunk/lib/Mail/SpamAssassin/Util/MemoryDump.pm Fri Sep 19 04:26:46 2008
@@ -47,6 +47,7 @@
use Devel::Peek qw();
use Devel::Size qw(size total_size);
+use Mail::SpamAssassin::Util qw(proc_status_ok exit_status_str);
eval q{ use Devel::Gladiator; };
###########################################################################
@@ -73,8 +74,9 @@
# do this in a subprocess, since it leaks refs to all objects!
my $pid = fork();
if ($pid) {
- waitpid ($pid, 0);
- if ($?>>8 != 0) { warn "census subproc died: $?"; }
+ my $child_stat = waitpid($pid,0) > 0 ? $? : undef;
+ proc_status_ok($child_stat)
+ or warn "census subproc: ".exit_status_str($child_stat);
return;
}
@@ -193,7 +195,9 @@
sub new_dump_filename {
my $type = shift;
- if (!-d "dumps") { mkdir("dumps", 0777); }
+ if (!-d "dumps") {
+ mkdir("dumps", 0777) or warn "dump: cannot create a directory: $!";
+ }
my ($e, $filename, $line, $f) = caller(2);
$filename =~ s/^.*[\/\\]//gs;