On 9/7/2011 2:13 PM, Mark Martinec wrote:
svn diff -c1165372
Thanks! That's the "new" command I was looking for. My old version of
svn doesn't support diff -c and I couldn't remember the -r<rev>:<rev>
syntax so I kept getting too much info.
I'll likely attach the patch to the bug for others to review.
regards,
KAM
Index: lib/Mail/SpamAssassin/Message.pm
===================================================================
--- lib/Mail/SpamAssassin/Message.pm (revision 1165371)
+++ lib/Mail/SpamAssassin/Message.pm (revision 1165372)
@@ -963,20 +963,26 @@
# up RAM with something we're not going to use?
#
if ($msg->{'type'} !~ m@^(?:text/(?:plain|html)$|message\b)@) {
- my $filepath;
- ($filepath, $msg->{'raw'}) = Mail::SpamAssassin::Util::secure_tmpfile();
-
- if ($filepath) {
+ my($filepath, $fh);
+ eval {
+ ($filepath, $fh) = Mail::SpamAssassin::Util::secure_tmpfile(); 1;
+ } or do {
+ my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
+ info("message: failed to create a temp file: %s", $eval_stat);
+ };
+ if ($fh) {
# The temp file was created, add it to the list of pending deletions
# 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}) or die "error writing to $filepath: $!";
+ $fh->print(@{$body}) or die "error writing to $filepath: $!";
+ $msg->{'raw'} = $fh;
}
}
# if the part didn't get a temp file, go ahead and store the data in memory
- if (!exists $msg->{'raw'}) {
+ if (!defined $msg->{'raw'}) {
+ dbg("message: storing a body to memory");
$msg->{'raw'} = $body;
}
}
Index: lib/Mail/SpamAssassin/PerMsgStatus.pm
===================================================================
--- lib/Mail/SpamAssassin/PerMsgStatus.pm (revision 1165371)
+++ lib/Mail/SpamAssassin/PerMsgStatus.pm (revision 1165372)
@@ -2662,6 +2662,7 @@
}
my ($tmpf, $tmpfh) = Mail::SpamAssassin::Util::secure_tmpfile();
+ $tmpfh or die "failed to create a temporary file";
print $tmpfh $$fulltext or die "error writing to $tmpf: $!";
close $tmpfh or die "error closing $tmpf: $!";
Index: lib/Mail/SpamAssassin/Util.pm
===================================================================
--- lib/Mail/SpamAssassin/Util.pm (revision 1165371)
+++ lib/Mail/SpamAssassin/Util.pm (revision 1165372)
@@ -59,7 +59,7 @@
@EXPORT = ();
@EXPORT_OK = qw(&local_tz &base64_decode &untaint_var &untaint_file_path
&exit_status_str &proc_status_ok &am_running_on_windows
- &reverse_ip_address);
+ &reverse_ip_address &secure_tmpfile &secure_tmpdir);
}
use Mail::SpamAssassin;
@@ -1049,19 +1049,13 @@
sub secure_tmpfile {
my $tmpdir = untaint_file_path($ENV{'TMPDIR'} || File::Spec->tmpdir());
- if (!$tmpdir) {
- # Note: we would prefer to keep this fatal, as not being able to
- # find a writable tmpdir is a big deal for the calling code too.
- # That would be quite a psychotic case, also.
- warn "util: cannot find a temporary directory, set TMP or TMPDIR in
environment";
- return;
- }
+ defined $tmpdir && $tmpdir ne ''
+ or die "util: cannot find a temporary directory, set TMP or TMPDIR in
environment";
- opendir(my $dh, $tmpdir) || die "Could not open $tmpdir: $!";
- closedir $dh;
- my ($reportfile, $tmpfile);
- my $umask = umask 077;
+ opendir(my $dh, $tmpdir) or die "Could not open directory $tmpdir: $!";
+ closedir $dh or die "Error closing directory $tmpdir: $!";
+ my ($reportfile, $tmpfh);
for (my $retries = 20; $retries > 0; $retries--) {
# we do not rely on the obscurity of this name for security,
# we use a average-quality PRG since this is all we need
@@ -1071,36 +1065,34 @@
# 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 or die "cannot set $reportfile to binmode: $!";
+ if (sysopen($tmpfh, $reportfile, O_RDWR|O_CREAT|O_EXCL, 0600)) {
+ binmode $tmpfh or die "cannot set $reportfile to binmode: $!";
last;
}
+ my $errno = $!;
- if ($!{EEXIST}) {
- # it is acceptable if $tmpfile already exists, try another
- next;
- }
-
- # error, maybe "out of quota" or "too many open files" (bug 4017)
- warn "util: secure_tmpfile failed to create file '$reportfile': $!\n";
-
# ensure the file handle is not semi-open in some way
- if ($tmpfile) {
- if (! close $tmpfile) {
+ if ($tmpfh) {
+ if (! close $tmpfh) {
info("error closing $reportfile: $!");
- $tmpfile=undef;
+ undef $tmpfh;
}
}
- }
- umask $umask;
+ # it is acceptable if $tmpfh already exists, try another
+ next if $errno == EEXIST;
- if (!$tmpfile) {
- warn "util: secure_tmpfile failed to create file, giving up";
- return; # undef
+ # error, maybe "out of quota", "too many open files", "Permission denied"
+ # (bug 4017); makes no sense retrying
+ die "util: failed to create a temporary file '$reportfile': $errno";
}
- return ($reportfile, $tmpfile);
+ if (!$tmpfh) {
+ warn "util: secure_tmpfile failed to create a temporary file, giving up";
+ return;
+ }
+
+ return ($reportfile, $tmpfh);
}
=item my ($dirpath) = secure_tmpdir();
Index: lib/Mail/SpamAssassin/Plugin/BodyRuleBaseExtractor.pm
===================================================================
--- lib/Mail/SpamAssassin/Plugin/BodyRuleBaseExtractor.pm (revision
1165371)
+++ lib/Mail/SpamAssassin/Plugin/BodyRuleBaseExtractor.pm (revision
1165372)
@@ -510,6 +510,7 @@
$rule =~ s/(?<!\\)(\w)\?/\($1\|\)/gs;
my ($tmpf, $tmpfh) = Mail::SpamAssassin::Util::secure_tmpfile();
+ $tmpfh or die "failed to create a temporary file";
untaint_var(\$tmpf);
# attempt to find a safe regexp delimiter...
Index: sa-update.raw
===================================================================
--- sa-update.raw (revision 1165371)
+++ sa-update.raw (revision 1165372)
@@ -94,6 +94,9 @@
# These should already be available
use Mail::SpamAssassin;
+use Mail::SpamAssassin::Util qw(untaint_var untaint_file_path
+ proc_status_ok exit_status_str am_running_on_windows
+ secure_tmpfile secure_tmpdir);
# Make the main dbg() accessible in our package w/o an extra function
*dbg=\&Mail::SpamAssassin::dbg;
@@ -142,7 +145,7 @@
'debug|D:s' => \$opt{'debug'},
'version|V' => \$opt{'version'},
'help|h|?' => \$opt{'help'},
- 'verbose|v' => \$opt{'verbose'},
+ 'verbose|v+' => \$opt{'verbose'},
'checkonly' => \$opt{'checkonly'},
'allowplugins' => \$opt{'allowplugins'},
'refreshmirrors' => \$opt{'refreshmirrors'},
@@ -210,7 +213,7 @@
});
if (defined $opt{'updatedir'}) {
- $opt{'updatedir'} =
Mail::SpamAssassin::Util::untaint_file_path($opt{'updatedir'});
+ $opt{'updatedir'} = untaint_file_path($opt{'updatedir'});
}
else {
$opt{'updatedir'} = $SA->sed_path('__local_state_dir__/__version__');
@@ -239,7 +242,7 @@
# we're not a setuid script, we trust them
foreach my $optkey (keys %opt) {
next if ref $opt{$optkey};
- Mail::SpamAssassin::Util::untaint_var(\$opt{$optkey});
+ untaint_var(\$opt{$optkey});
}
##############################################################################
@@ -261,9 +264,8 @@
if (defined $opt{'gpgkeyfile'}) {
$GPG_ENABLED = 1;
- unless (open(GPG, $opt{'gpgkeyfile'})) {
- die "Can't open ".$opt{'gpgkeyfile'}." for reading: $!\n";
- }
+ open(GPG, $opt{'gpgkeyfile'})
+ or die "cannot open $opt{'gpgkeyfile'} for reading: $!\n";
dbg("gpg: reading in gpgfile ".$opt{'gpgkeyfile'});
while(my $key = <GPG>) {
@@ -282,7 +284,7 @@
dbg("gpg: adding key id $key");
$valid_GPG{$key} = 1;
}
- close(GPG);
+ close(GPG) or die "cannot close $opt{'gpgkeyfile'}: $!";
}
# At this point, we need to know where GPG is ...
@@ -336,9 +338,8 @@
@channels = @{$opt{'channel'}};
}
if (defined $opt{'channelfile'}) {
- unless (open(CHAN, $opt{'channelfile'})) {
- die "Can't open ".$opt{'channelfile'}." for reading: $!\n";
- }
+ open(CHAN, $opt{'channelfile'})
+ or die "cannot open $opt{'channelfile'} for reading: $!\n";
dbg("channel: reading in channelfile ".$opt{'channelfile'});
@channels = ();
@@ -354,14 +355,14 @@
dbg("channel: adding $chan");
push(@channels, $chan);
}
- close(CHAN);
+ close(CHAN) or die "cannot close $opt{'channelfile'}: $!";
}
# untaint the channel listing
for(my $ind = 0; $ind < @channels; $ind++) {
local($1); # bug 5061: prevent random taint flagging of $1
if ($channels[$ind] =~ /^([a-zA-Z0-9._-]+)$/) {
- Mail::SpamAssassin::Util::untaint_var(\$channels[$ind]);
+ untaint_var(\$channels[$ind]);
}
else {
dbg("channel: skipping invalid channel: $channels[$ind]");
@@ -387,11 +388,12 @@
}
# Generate a temporary file to put channel content in for later use ...
-my ($content_file, $tfh) = Mail::SpamAssassin::Util::secure_tmpfile();
-if ( !defined $content_file ) {
- die "fatal: could not create temporary channel content file: $!\n";
-}
-close($tfh);
+my ($content_file, $tfh) = secure_tmpfile();
+$tfh
+ or die "fatal: could not create temporary channel content file: $!\n";
+close $tfh
+ or die "cannot close temporary channel content file $content_file: $!";
+undef $tfh;
my $lint_failures = 0;
my $channel_failures = 0;
@@ -443,7 +445,7 @@
$currentV = $1;
}
}
- close(CF);
+ close(CF) or die "cannot close $CFFile: $!";
}
my $newV;
@@ -507,7 +509,7 @@
# when we lint the site pre files, we might as well use the channel temp dir
dbg("channel: preparing temp directory for new channel");
if (!$UPDTmp) {
- $UPDTmp = Mail::SpamAssassin::Util::secure_tmpdir();
+ $UPDTmp = secure_tmpdir();
dbg("generic: update tmp directory $UPDTmp");
}
elsif (!clean_update_dir($UPDTmp)) {
@@ -547,7 +549,7 @@
local $/ = undef;
$mirby = <MIRBY>;
}
- close(MIRBY);
+ close(MIRBY) or die "cannot close $mirby_path: $!";
}
if (!defined $mirby) {
@@ -682,11 +684,15 @@
}
# Write the content out to a temp file for GPG/Archive::Tar interaction
- dbg("channel: populating temp content file");
- open(TMP, ">$content_file") || die "fatal: couldn't create content temp file
$content_file: $!\n";
- binmode TMP;
- print TMP $content || die "fatal: can't write to content temp file
$content_file: $!\n";
- close(TMP);
+ dbg("channel: populating temp content file %s", $content_file);
+ open(TMP, ">$content_file")
+ or die "fatal: cannot create content temp file $content_file: $!\n";
+ binmode TMP
+ or die "fatal: cannot set binmode on content temp file $content_file:
$!\n";
+ print TMP $content
+ or die "fatal: cannot write to content temp file $content_file: $!\n";
+ close TMP
+ or die "fatal: cannot close content temp file $content_file: $!\n";
# to sign : gpg -bas file
# to verify: gpg --verify --batch --no-tty --status-fd=1 -q --logger-fd=1
file.asc file
@@ -696,13 +702,16 @@
if ($GPG) {
dbg("gpg: populating temp signature file");
my $sig_file;
- ($sig_file, $tfh) = Mail::SpamAssassin::Util::secure_tmpfile();
- if ( !defined $sig_file ) {
- die "fatal: couldn't create temp file for GPG signature: $!\n";
- }
- binmode $tfh;
- print $tfh $GPG || die "fatal: can't write temp file for GPG signature:
$!\n";
- close($tfh);
+ ($sig_file, $tfh) = secure_tmpfile();
+ $tfh
+ or die "fatal: couldn't create temp file for GPG signature: $!\n";
+ binmode $tfh
+ or die "fatal: cannot set binmode on temp file for GPG signature: $!\n";
+ print $tfh $GPG
+ or die "fatal: cannot write temp file for GPG signature: $!\n";
+ close $tfh
+ or die "fatal: cannot close temp file for GPG signature: $!\n";
+ undef $tfh;
dbg("gpg: calling gpg");
@@ -714,7 +723,7 @@
"--no-tty --status-fd=1 -q --logger-fd=1";
unless (open(CMD, "$CMD $sig_file $content_file|")) {
- unlink $sig_file || warn "error: can't unlink $sig_file: $!\n";
+ unlink $sig_file or warn "error: cannot unlink $sig_file: $!\n";
die "fatal: couldn't execute $GPGPath: $!\n";
}
@@ -746,8 +755,8 @@
$signer = $key if (length $key > length $signer);
}
- close(CMD);
- unlink $sig_file || warn "Can't unlink $sig_file: $!\n";
+ close(CMD) or die "cannot close pipe to $GPGPath: $!";
+ unlink $sig_file or warn "cannot unlink $sig_file: $!\n";
if ($signer) {
my $keyid = substr $signer, -8;
@@ -837,10 +846,8 @@
else {
# create the dir, if it doesn't exist
dbg("channel: creating $UPDDir");
- if (!mkpath([$UPDDir], 0, 0777)) {
- warn "channel: can't create channel directory $UPDDir: $!\n";
- return 0;
- }
+ mkpath([$UPDDir], 0, 0777)
+ or die "channel: cannot create channel directory $UPDDir: $!\n";
# ok, that test worked. it's now likely that the .cf's will
# similarly be ok to rename, too. Too late to stop from here on
@@ -855,8 +862,10 @@
# bug 4941: try to get rid of the empty directories to avoid leaving SA
# with no rules.
- rmdir $UPDDir;
- rmdir $opt{'updatedir'};
+ rmdir $UPDDir
+ or dbg("channel: error removing dir %s: %s", $UPDDir, $!);
+ rmdir $opt{'updatedir'}
+ or dbg("channel: error removing dir %s: %s", $opt{'updatedir'}, $!);
},
},
@@ -891,13 +900,10 @@
# Write out the mirby file, not fatal if it doesn't work
dbg("channel: creating MIRRORED.BY file");
- if (open(MBY, ">$mirby_path")) {
- print MBY $mirby;
- close(MBY);
- }
- else {
- warn "error: can't write new MIRRORED.BY file: $!\n";
- }
+ open(MBY, ">$mirby_path")
+ or die "cannot create a new MIRRORED.BY file: $!\n";
+ print MBY $mirby or die "error writing to $mirby_path: $!";
+ close(MBY) or die "cannot close $mirby_path: $!";
return 1;
},
@@ -920,14 +926,13 @@
# Find all of the cf and pre files
- unless (opendir(DIR, $UPDDir)) {
- die "fatal: can't access $UPDDir: $!\n";
- }
+ opendir(DIR, $UPDDir)
+ or die "fatal: cannot access $UPDDir: $!\n";
my @files;
while(my $file = readdir(DIR)) {
next if $file eq '.' || $file eq '..';
- Mail::SpamAssassin::Util::untaint_var(\$file);
+ untaint_var(\$file);
my $path = File::Spec->catfile($UPDDir, $file);
next unless (-f $path); # shouldn't ever happen
push(@files, $file);
@@ -947,7 +952,7 @@
dbg("channel: adding $file");
}
- closedir(DIR);
+ closedir(DIR) or die "cannot close directory $UPDDir: $!";
# Finally, write out the files to include the update files
if (!write_channel_file($PREFile, \@PRE)) {
@@ -972,14 +977,22 @@
);
my $error;
+ my $eval_stat;
for(my $elem = 0; $elem <= $#totry; $elem++) {
- if (!&{$totry[$elem]->{'try'}}()) {
+ my $success;
+ eval {
+ $success = &{$totry[$elem]->{'try'}}(); 1;
+ } or do {
+ $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
+ };
+ if (!$success) {
$error = $elem;
+ $eval_stat = "step $elem unsuccessful" if !defined $eval_stat;
last;
}
}
if (defined $error) {
- dbg("channel: channel failed, attempting rollback");
+ dbg("channel: channel failed, attempting rollback: %s", $eval_stat);
for(my $elem = $error; $elem >= 0; $elem--) {
&{$totry[$elem]->{'rollback'}}();
}
@@ -1003,13 +1016,13 @@
next if $stat_errn == ENOENT;
if ($stat_errn != 0) {
- warn "error: can't access $_: $!\n";
+ warn "error: cannot access $_: $!\n";
}
elsif (-d _) {
- rmdir $_ || warn "error: can't remove directory $_: $!\n";
+ rmdir $_ or warn "error: cannot remove directory $_: $!\n";
}
elsif (-f _) {
- unlink $_ || warn "error: can't remove file $_: $!\n";
+ unlink $_ or warn "error: cannot remove file $_: $!\n";
}
else {
warn "error: '$_' isn't a file nor a directory, skipping\n";
@@ -1058,7 +1071,7 @@
my ($file) = @_;
open (IN, "<$file") or die "cannot open $file\n";
my $all = join('', <IN>);
- close IN;
+ close IN or die "cannot close $file: $!";
return $all;
}
@@ -1070,7 +1083,7 @@
return 1 unless @{$contents};
if (open(FILE, ">$filename")) {
- print FILE @{$contents};
+ print FILE @{$contents} or die "cannot write to $filename: $!";
close FILE or return 0;
return 1;
}
@@ -1093,10 +1106,10 @@
my $input = shift;
my $tfh = IO::Zlib->new($input, "rb");
- die "fatal: couldn't read content tmpfile $content_file: $!\n" unless $tfh;
+ $tfh or die "fatal: couldn't read content tmpfile $content_file: $!\n";
my $tar = Archive::Tar->new($tfh);
- die "fatal: couldn't create Archive::Tar object!\n" unless $tar;
+ $tar or die "fatal: couldn't open tar archive!\n";
# stupid Archive::Tar is not natively taint-safe! duh.
# return $tar->extract();
@@ -1113,7 +1126,10 @@
$outfname = File::Spec->catfile($todir, $outfname);
dbg "extracting: $outfname";
- if (open OUT, ">".$outfname) {
+ if (!open OUT, ">".$outfname) {
+ warn "error: failed to create $outfname: $!";
+ goto failed;
+ } else {
my $content = $tar->get_content($file);
if ($outfname =~ /\.(?:pre|cf)$/) {
@@ -1129,14 +1145,10 @@
}
}
- print OUT $content;
- if (!close OUT) {
- warn "error: write failed to $outfname: $!";
- goto failed;
- }
- } else {
- warn "error: failed to open $outfname for write: $!";
- goto failed;
+ print OUT $content
+ or do { warn "error writing to $outfname: $!"; goto failed };
+ close OUT
+ or do { warn "error: write failed to $outfname: $!"; goto failed }
}
}
@@ -1157,14 +1169,20 @@
if ($RR) {
foreach my $rr ($RR->answer) {
+ next if !$rr; # no answer records, only rcode
+ next if $rr->type ne 'TXT'; # only interested in TXT fields
my $text = $rr->rdatastr;
local($1);
$text =~ /^"(.*)"$/;
push @result, $1;
}
+ printf("DNS TXT query: %s -> %s\n", $query, join(", ",@result))
+ if $opt{'verbose'} && $opt{'verbose'} > 1;
}
else {
dbg("dns: query failed: $query => " . $res->errorstring);
+ printf("DNS TXT query %s failed: %s\n", $query, $res->errorstring)
+ if $opt{'verbose'} && $opt{'verbose'} > 1;
}
return @result;
@@ -1196,6 +1214,11 @@
$response = $ua->request($request);
+ printf("http: %sGET %s, %s\n",
+ defined $ims ? 'IMS ' : '', $url,
+ !$response ? '(no response)' : $response->status_line)
+ if $opt{'verbose'} && $opt{'verbose'} > 1;
+
if ($response->is_success) {
return $response->content;
}
@@ -1301,7 +1324,7 @@
my $gpghome = '';
if ($opt{'gpghomedir'}) {
$gpghome = $opt{'gpghomedir'};
- if (Mail::SpamAssassin::Util::am_running_on_windows()) {
+ if (am_running_on_windows()) {
# windows is single-quote-phobic; bug 4958 cmt 7
$gpghome =~ s/\"/\\\"/gs;
$gpghome = "--homedir=\"$gpghome\"";
@@ -1341,7 +1364,10 @@
}
}
- close(CMD);
+ my $errno = 0; close CMD or $errno = $!;
+ proc_status_ok($?,$errno)
+ or warn("gpg: process '$CMD' finished: ".exit_status_str($?,$errno)."\n");
+
return ($? >> 8);
}
@@ -1357,7 +1383,8 @@
dbg("gpg: importing default keyring to ".$opt{gpghomedir});
unless (-d $opt{gpghomedir}) {
# use 0700 to avoid "unsafe permissions" warning
- mkpath([$opt{'gpghomedir'}], 0, 0700) or die "cannot mkpath
$opt{gpghomedir}: $!";
+ mkpath([$opt{'gpghomedir'}], 0, 0700)
+ or die "cannot mkpath $opt{gpghomedir}: $!";
}
import_gpg_key($defkey);
}
@@ -1375,25 +1402,25 @@
my $dir = shift;
unless (opendir(DIR, $dir)) {
- warn "error: can't opendir $dir: $!\n";
+ warn "error: cannot opendir $dir: $!\n";
dbg("generic: attempt to opendir ($dir) failed");
return;
}
while(my $file = readdir(DIR)) {
next if $file eq '.' || $file eq '..';
- Mail::SpamAssassin::Util::untaint_var(\$file);
+ untaint_var(\$file);
my $path = File::Spec->catfile($dir, $file);
next unless (-f $path);
dbg("generic: unlinking $file");
if (!unlink $path) {
- warn "error: can't remove file $path: $!\n";
- closedir(DIR);
+ warn "error: cannot remove file $path: $!\n";
+ closedir(DIR) or die "cannot close directory $dir: $!";
return;
}
}
- closedir(DIR);
+ closedir(DIR) or die "cannot close directory $dir: $!";
return 1;
}
@@ -1463,7 +1490,8 @@
(default: @@LOCAL_STATE_DIR@@/@@VERSION@@)
--refreshmirrors Force the MIRRORED.BY file to be updated
-D, --debug [area=n,...] Print debugging messages
- -v, --verbose Be more verbose, like print updated channel names
+ -v, --verbose Be verbose, like print updated channel names;
+ For more verbosity specify multiple times
-V, --version Print version
-h, --help Print usage message
