Index: lib/Mail/SpamAssassin/Util.pm =================================================================== --- lib/Mail/SpamAssassin/Util.pm (revision 423306) +++ lib/Mail/SpamAssassin/Util.pm (working copy) @@ -925,6 +925,61 @@ return ($reportfile, $tmpfile); } +=item my ($dirpath) = secure_tmpdir(); + +Generates a directory for temporary files. Creates it securely and +returns the path to the directory. + +If it cannot create a directory after 20 tries, it returns C. + +=cut + +# stolen from secure_tmpfile() +sub secure_tmpdir { + my $tmpdir = Mail::SpamAssassin::Util::untaint_file_path(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; + } + + my ($reportpath, $tmppath); + my $umask = umask 077; + + 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 + my $suffix = join('', (0..9,'A'..'Z','a'..'z')[rand 62, rand 62, rand 62, + rand 62, rand 62, rand 62]); + $reportpath = File::Spec->catfile($tmpdir,".spamassassin${$}${suffix}tmp"); + + # instead, we require O_EXCL|O_CREAT to guarantee us proper + # ownership of our file, read the open(2) man page + if (mkdir $reportpath, 0700) { + $tmppath = $reportpath; + last; + } + + if ($!{EEXIST}) { + # it is acceptable if $reportpath already exists, try another + next; + } + + # error, maybe "out of quota" or "too many open files" (bug 4017) + warn "util: secure_tmpdir failed to create file '$reportpath': $!\n"; + } + + umask $umask; + + warn "util: secure_tmpdir failed to create a directory, giving up" if (!$tmppath); + + return $tmppath; +} + + ########################################################################### sub uri_to_domain { Index: sa-update.raw =================================================================== --- sa-update.raw (revision 424340) +++ sa-update.raw (working copy) @@ -40,7 +40,6 @@ # Standard perl modules use File::Spec; use File::Path; -use File::Copy; use Getopt::Long; use Pod::Usage; use Config; @@ -102,6 +101,8 @@ # Clean up PATH appropriately Mail::SpamAssassin::Util::clean_path_in_taint_mode(); +############################################################################## + # Default list of GPG keys allowed to sign update releases # # pub 1024D/265FA05B 2003-06-09 @@ -127,7 +128,10 @@ # my @channels = ( 'updates.spamassassin.org' ); +############################################################################## +use constant MIRBY_DOWNLOADED => -1; + my %opt = (); @{$opt{'gpgkey'}} = (); @{$opt{'channel'}} = (); @@ -229,9 +233,10 @@ $opt{$optkey} = $1; } -my $GPGPath; +############################################################################## -# deal with gpg-related options +# Deal with gpg-related options + if (@{$opt{'gpgkey'}}) { $GPG_ENABLED = 1; foreach my $key (@{$opt{'gpgkey'}}) { @@ -244,6 +249,7 @@ $valid_GPG{$key} = 1; } } + if (defined $opt{'gpgkeyfile'}) { $GPG_ENABLED = 1; unless (open(GPG, $opt{'gpgkeyfile'})) { @@ -262,25 +268,46 @@ } close(GPG); } -if ( $opt{'import'} ) { - my $ex = import_gpg_key($opt{'import'}); - exit $ex; -} -# does the sa-update keyring exist? if not, import it -if ($GPG_ENABLED) { +# At this point, we need to know where GPG is ... +my $GPGPath; +if ($GPG_ENABLED || $opt{'import'}) { + # find GPG in the PATH + # bug 4958: for *NIX it's "gpg", in Windows it's "gpg.exe" + $GPGPath = 'gpg' . $Config{_exe}; + dbg("gpg: Searching for '$GPGPath'"); + + if ($GPGPath = Mail::SpamAssassin::Util::find_executable_in_env_path($GPGPath)) { + dbg("gpg: found $GPGPath"); + } + else { + die "error: gpg required but not found!\n"; + } + + # GPG was found, and we've been asked to import a key only + if ( $opt{'import'} ) { + my $ex = import_gpg_key($opt{'import'}); + exit $ex; + } + + # does the sa-update keyring exist? if not, import it if(!-f File::Spec->catfile($opt{'gpghomedir'}, "secring.gpg")) { import_default_keyring(); # attempt to continue even if this fails, anyway } -} -# convert fingerprint gpg ids to keyids -foreach (keys %valid_GPG) { - my $id = substr $_, -8; - $valid_GPG{$id} = 1; + # specify which keys are trusted + dbg("gpg: release trusted key id list: ".join(" ", keys %valid_GPG)); + + # convert fingerprint gpg ids to keyids + foreach (keys %valid_GPG) { + my $id = substr $_, -8; + $valid_GPG{$id} = 1; + } } +############################################################################## + # Deal with channel-related options if (defined $opt{'channel'} && scalar @{$opt{'channel'}} > 0) { @channels = @{$opt{'channel'}}; @@ -311,13 +338,6 @@ } } -# find GPG in the PATH -if ($GPG_ENABLED) { - $GPGPath = find_gpg_path(); - dbg("gpg: release trusted key id list: ".join(" ", keys %valid_GPG)); -} - - my $res = Net::DNS::Resolver->new(); my $ua = LWP::UserAgent->new(); @@ -327,15 +347,17 @@ # 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); -# and another, for the new config file -my ($newcf_file, $tfh2) = Mail::SpamAssassin::Util::secure_tmpfile(); -close($tfh2); - # by default, exit code is 1, to indicate no updates occurred my $exit = 1; +# Use a temporary directory for all update channels +my $UPDTmp; + # Go ahead and loop through all of the channels foreach my $channel (@channels) { dbg("channel: attempting channel $channel"); @@ -344,16 +366,17 @@ my $nicechannel = $channel; $nicechannel =~ tr/A-Za-z0-9-/_/cs; - my $UPDDir = "$opt{'updatedir'}/$nicechannel"; - my $UPDTmp = "$opt{'updatedir'}/$nicechannel.tmp"; + my $UPDDir = File::Spec->catfile($opt{'updatedir'}, $nicechannel); my $CFFile = "$UPDDir.cf"; - my $CFFTmp = $newcf_file; + my $PREFile = "$UPDDir.pre"; dbg("channel: update directory $UPDDir"); - dbg("channel: update tmp directory $UPDTmp"); dbg("channel: channel cf file $CFFile"); - dbg("channel: channel tmp cf file $CFFTmp"); + dbg("channel: channel pre file $PREFile"); + my($mirby, $mirby_time); + my $mirby_path = File::Spec->catfile($UPDDir, "MIRRORED.BY"); + # try to read metadata from channel.cf file my $currentV = -1; if (open(CF, $CFFile)) { @@ -395,28 +418,13 @@ next; } - # ensure dirs exist, upfront - unless (-d $UPDDir) { - dbg("channel: creating $UPDDir"); - mkpath([$UPDDir], 0, 0777) or die "fatal: can't create $UPDDir: $!\n"; - } - unless (-d $UPDTmp) { - dbg("channel: creating $UPDTmp"); - mkpath([$UPDTmp], 0, 0777) or die "fatal: can't create $UPDTmp: $!\n"; - } + # Read in the MIRRORED.BY file if it exists + if (open(MIRBY, $mirby_path)) { + local $/ = undef; + $mirby = ; + close(MIRBY); - # copy the MIRRORED.BY file to the tmpdir, if it exists - if (-f "$UPDDir/MIRRORED.BY") { - unlink("$UPDTmp/MIRRORED.BY"); - - my ($x, $atime, $mtime); - ($x,$x,$x,$x,$x,$x,$x,$x,$atime,$mtime,$x) = stat "$UPDDir/MIRRORED.BY"; - - copy("$UPDDir/MIRRORED.BY", "$UPDTmp/MIRRORED.BY") - or die "fatal: cannot copy $UPDDir/MIRRORED.BY to $UPDTmp/MIRRORED.BY"; - - # ensure modtimes match - utime($atime, $mtime, "$UPDTmp/MIRRORED.BY"); + $mirby_time = (stat $mirby_path)[9]; } else { # We don't currently have the list of mirrors, so go grab it. @@ -426,33 +434,22 @@ warn "error: no mirror data available for channel $channel\n"; channel_failed("channel: MIRRORED.BY file location was not in DNS"); } - $mirror = http_get($mirror); - unless ($mirror) { + $mirby = http_get($mirror); + unless ($mirby) { warn "error: no mirror data available for channel $channel\n"; channel_failed("channel: MIRRORED.BY contents were missing"); next; } + $mirby_time = MIRBY_DOWNLOADED; - unless (open(MIR, ">$UPDTmp/MIRRORED.BY")) { - warn "error: can't create mirrors file: $!\n"; - channel_failed("channel: MIRRORED.BY creation failure"); - next; - } - print MIR $mirror; - close(MIR); dbg("channel: MIRRORED.BY file retrieved"); } # Read in the list of mirrors - unless (open(MIR, "$UPDTmp/MIRRORED.BY")) { - warn "error: can't read mirrors file: $!\n"; - channel_failed("channel: MIRRORED.BY file is unreadable"); - next; - } - dbg("channel: reading MIRRORED.BY file"); my %mirrors = (); - while(my $mirror = ) { + my @mirrors = split(/^/, $mirby); + while(my $mirror = shift @mirrors) { next if ($mirror =~ /^#/); # explicitly skip comments # We only support HTTP right now @@ -474,7 +471,6 @@ $mirrors{$mirror}->{$k} = $v; } } - close(MIR); unless (keys %mirrors) { warn "error: no mirrors available for channel $channel\n"; @@ -482,16 +478,11 @@ next; } - # remember the mtime of the file so we can IMS GET later on - my $mirby_time = (stat("$UPDTmp/MIRRORED.BY"))[9]; - - # Now that we've laid the foundation, go grab the appropriate files # my $content; my $SHA1; my $GPG; - my $mirby; # Loop through all available mirrors, choose from them randomly # if the archive get fails, choose another mirror, @@ -519,13 +510,18 @@ # try to update our list of mirrors. # a failure here doesn't cause channel failure. - $mirby = http_get("$mirror/MIRRORED.BY", $mirby_time); + if ($mirby_time != MIRBY_DOWNLOADED) { + my $mirby_tmp = http_get("$mirror/MIRRORED.BY", $mirby_time); + if ($mirby_tmp) { + $mirby = $mirby_tmp; + $mirby_time = MIRBY_DOWNLOADED; + } + } last; } unless ($content && $SHA1 && (!$GPG_ENABLED || $GPG)) { - warn "error: channel $channel has no working mirrors\n"; channel_failed("channel: could not find working mirror"); next; } @@ -536,10 +532,9 @@ $SHA1 =~ /^([a-fA-F0-9]{40})/; $SHA1 = $1 || 'INVALID'; my $digest = sha1_hex($content); - dbg("sha1: verification expected: $SHA1"); - dbg("sha1: verification got : $digest"); + dbg("sha1: verification wanted: $SHA1"); + dbg("sha1: verification result: $digest"); unless ($digest eq $SHA1) { - warn "error: can't verify SHA1 signature\n"; channel_failed("channel: SHA1 verification failed"); next; } @@ -560,6 +555,9 @@ 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; close($tfh); @@ -656,137 +654,187 @@ } # OK, we're all validated at this point, install the new version - dbg("channel: file verification passed, installing update"); + dbg("channel: file verification passed, testing update"); - if ($mirby) { - dbg("channel: updating MIRRORED.BY contents"); - if (open(MBY, ">$UPDTmp/MIRRORED.BY")) { - print MBY $mirby; - close(MBY); - } - else { - warn "error: can't write new MIRRORED.BY file: $!\n"; - } + dbg("channel: preparing temp directory for new channel"); + if (!$UPDTmp) { + $UPDTmp = Mail::SpamAssassin::Util::secure_tmpdir(); + dbg("generic: update tmp directory $UPDTmp"); } - - dbg("channel: cleaning out update directory"); - if (!clean_update_dir($UPDTmp)) { - channel_failed("channel: attempt to clean update dir failed"); - next; + elsif (!clean_update_dir($UPDTmp)) { + die "channel: attempt to clean update dir failed, aborting"; } - unlink $CFFTmp || warn "error: can't remove file $CFFTmp: $!\n"; - - $tfh = IO::Zlib->new($content_file, "rb"); - die "fatal: couldn't read content tmpfile $content_file: $!\n" unless $tfh; - - my $tar = Archive::Tar->new($tfh); - die "fatal: couldn't create Archive::Tar object!\n" unless $tar; - dbg("channel: extracting archive"); - my $ret = taint_safe_archive_extract($UPDTmp, $tar); - - unless ($ret) { - close($tfh); - warn "error: couldn't extract the tar archive!\n"; + if (!taint_safe_archive_extract($UPDTmp, $content_file)) { channel_failed("channel: archive extraction failed"); next; } - close($tfh); # check --lint if (!lint_check_dir($UPDTmp)) { - warn "error: lint check of update failed! channel failed\n"; channel_failed("channel: lint check of update failed"); next; } + dbg("channel: lint check succeeded, extracting archive to $UPDDir..."); - # OK, lint passed. now create the update config file + if (-d $UPDDir) { + # ok that worked, too late to stop now! At this stage, if there are + # errors, we have to attempt to carry on regardless, since we've already + # blown away the old ruleset. + dbg("channel: point of no return for existing $UPDDir"); - dbg("channel: creating update config file"); - unless (open(CF, ">$CFFTmp")) { - die "fatal: can't create new channel cf $CFFTmp: $!\n"; + # clean out the previous channel files + if (! unlink $PREFile ) { + warn("channel: attempt to rm channel pre file failed, attempting to continue anyway"); + } + if (! unlink $CFFile ) { + warn("channel: attempt to rm channel cf file failed, attempting to continue anyway"); + } + if (!clean_update_dir($UPDDir)) { + warn("channel: attempt to rm channel directory failed, attempting to continue anyway"); + } } + else { + # create the dir, if it doesn't exist + dbg("channel: creating $UPDDir"); + if (!mkpath([$UPDDir], 0, 0777)) { + # bug 4941: try to get rid of the empty directories to avoid leaving SA + # with no rules. + rmdir $UPDDir; + rmdir $opt{'updatedir'}; + die "fatal: can't create $UPDDir: $!\n"; + } - # Put in whatever metadata we need - print CF "# UPDATE version $newV\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 + dbg("channel: point of no return for new $UPDDir"); + } - # try to figure out the relative path dir name - my $relativeDir = $UPDDir; - $UPDDir =~ m,/([^/]+)/*$,; - if ($1) { - $relativeDir = $1; + # extract the files again for the last time + if (!taint_safe_archive_extract($UPDDir, $content_file)) { + channel_failed("channel: archive extraction failed"); + + # bug 4941: try to get rid of the empty directories to avoid leaving SA + # with no rules. + if (!clean_update_dir($UPDDir)) { + warn "channel: attempt to clean up failed extraction also failed!\n"; + } + else { + rmdir $UPDDir; + rmdir $opt{'updatedir'}; + } + + next; } - dbg("channel: updatedir=$UPDDir relativepath=$relativeDir"); - my @files = (); - # now include *.cf - unless (opendir(DIR, $UPDTmp)) { - die "fatal: can't access $UPDTmp: $!\n"; + # 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"; + } + + # the last step is to create the .cf and .pre files to include the + # channel files + my @CF = (); + my @PRE = (); + + dbg("channel: creating update cf/pre files"); + + # Put in whatever metadata we need + push(@CF, "# UPDATE version $newV\n"); + + # Find all of the cf and pre files + unless (opendir(DIR, $UPDDir)) { + die "fatal: can't access $UPDDir: $!\n"; + } while(my $file = readdir(DIR)) { - $file =~ /^([^\/]+)$/; # untaint + $file =~ /^(.+)$/; # untaint $file = $1; - next unless (-f "$UPDTmp/$file"); - next if ($file eq "MIRRORED.BY"); # handled separately + my $path = File::Spec->catfile($UPDDir, $file); + next unless (-f $path); # shouldn't ever happen - dbg("channel: adding $file"); - if ($file =~ /\.cf$/) { - print CF "include $relativeDir/$file\n"; + push(@CF, "include $nicechannel/$file\n"); } + elsif ($file =~ /\.pre$/) { + push(@PRE, "include $nicechannel/$file\n"); + } + else { + next; + } - push (@files, $file); + dbg("channel: adding $file"); } closedir(DIR); - if (!close(CF)) { - warn "write to $CFFTmp failed! attempting to continue"; - channel_failed("write to $CFFTmp failed"); + + # Finally, write out the files to include the update files + if (!write_channel_file($PREFile, \@PRE)) { + channel_failed("channel: writing of $PREFile failed"); next; } - - dbg("channel: applying changes to $UPDDir..."); - - # too late to stop now! At this stage, if there are errors, - # we have to attempt to carry on regardless, since we've already - # blown away the old ruleset. - - # clean out the "real" update dir, and copy from tmp areas - if (!clean_update_dir($UPDDir)) { - warn("channel: attempt to rm contents failed, attempting to continue anyway"); + if (!write_channel_file($CFFile, \@CF)) { + channel_failed("channel: writing of $CFFile failed"); + next; } - foreach my $file (@files) { - rename("$UPDTmp/$file", "$UPDDir/$file") - or warn "rename $UPDTmp/$file $UPDDir/$file failed: $!"; - } - - unlink $CFFile || warn "error: can't remove file $CFFile: $!\n"; - cross_fs_rename($CFFTmp, $CFFile) - or warn "rename $CFFTmp $CFFile failed: $!"; - - unlink("$UPDDir/MIRRORED.BY"); - rename("$UPDTmp/MIRRORED.BY", "$UPDDir/MIRRORED.BY") - or warn "error: couldn't mv $UPDTmp/MIRRORED.BY $UPDDir/MIRRORED.BY: $!\n"; - - rmdir $UPDTmp; $exit = 0; # "exit 0" means an update occurred dbg("channel: update complete"); } +############################################################################## + +# clean out the temp dir +if ($UPDTmp) { + dbg("generic: cleaning up temporary directory/files"); + if (!clean_update_dir($UPDTmp)) { + warn "error: unable to clean out the files in $UPDTmp\n"; + } +} + # clear out the temp files if they still exist -foreach ( $newcf_file, $content_file ) { - if (-e $_) { +foreach ( $content_file, $UPDTmp ) { + next unless (defined $_ && -e $_); + + if (-d _) { + rmdir $_ || warn "error: can't remove directory $_: $!\n"; + } + elsif (-f _) { unlink $_ || warn "error: can't remove file $_: $!\n"; } + else { + warn "error: '$_' isn't a file nor a directory, skipping\n"; + } } dbg("diag: updates complete, exiting with code $exit"); exit $exit; +############################################################################## + +sub write_channel_file { + my ($filename, $contents) = @_; + + return 1 unless @{$contents}; + + if (open(FILE, ">$filename")) { + print FILE @{$contents}; + close FILE or return 0; + return 1; + } + + return 0; +} + +############################################################################## + sub channel_failed { my $reason = shift; warn("$reason, channel failed\n"); @@ -797,10 +845,18 @@ } } +############################################################################## + sub taint_safe_archive_extract { my $todir = shift; - my $tar = shift; + my $input = shift; + my $tfh = IO::Zlib->new($input, "rb"); + die "fatal: couldn't read content tmpfile $content_file: $!\n" unless $tfh; + + my $tar = Archive::Tar->new($tfh); + die "fatal: couldn't create Archive::Tar object!\n" unless $tar; + # stupid Archive::Tar is not natively taint-safe! duh. # return $tar->extract(); # instead, get the file list, untaint, and extract one-by-one. @@ -812,7 +868,7 @@ $file =~ /^([-\.\,\/a-zA-Z0-9_]+)$/; my $outfname = $1; $outfname =~ s/\.\.\//__\//gs; # avoid "../" dir traversal attacks - $outfname = "$todir/$outfname"; + $outfname = File::Spec->catfile($todir, $outfname); dbg "extracting: $outfname"; if (open OUT, ">".$outfname) { @@ -840,6 +896,8 @@ return; # undef = failure } +############################################################################## + # Do a generic TXT query sub do_txt_query { my($query) = shift; @@ -866,6 +924,8 @@ return $result; } +############################################################################## + # Do a GET request via HTTP for a certain URL # Use the optional time_t value to do an IMS GET sub http_get { @@ -916,6 +976,8 @@ return; } +############################################################################## + # choose a random integer between 0 and the total weight of all mirrors # loop through the mirrors from largest to smallest weight # if random number is < largest weight, use it @@ -953,11 +1015,15 @@ return $mirrors[0]; } +############################################################################## + sub print_version { print "sa-update version $VERSION\n" . " running on Perl version " . join(".", map { $_||=0; $_*1 } ($] =~ /(\d)\.(\d{3})(\d{3})?/ )) . "\n"; } +############################################################################## + sub print_usage_and_exit { my ( $message, $exitval ) = @_; $exitval ||= 64; @@ -973,25 +1039,16 @@ ); } +############################################################################## + sub usage { my ( $verbose, $message ) = @_; print "sa-update version $VERSION\n"; pod2usage( -verbose => $verbose, -message => $message, -exitval => 64 ); } -sub find_gpg_path { - # bug 4958: for *NIX it's "gpg", in Windows it's "gpg.exe" - my $gpg = 'gpg' . $Config{_exe}; +############################################################################## - dbg("gpg: Searching for '$gpg'"); - - my $path = Mail::SpamAssassin::Util::find_executable_in_env_path($gpg) || - die "fatal: couldn't find GPG\n"; - - dbg("gpg: found $path"); - return $path; -} - sub interpolate_gpghomedir { my $gpghome = ''; if ($opt{'gpghomedir'}) { @@ -1008,10 +1065,11 @@ return $gpghome; } +############################################################################## + sub import_gpg_key { my $keyfile = shift; - $GPGPath = find_gpg_path(); my $gpghome = interpolate_gpghomedir(); my $CMD = "$GPGPath $gpghome --batch ". @@ -1031,7 +1089,7 @@ } if ($GNUPG =~ /^IMPORTED /) { - print "sa-update --import: success. $GNUPG\n"; + dbg("gpg: gpg key imported successfully"); } } @@ -1039,45 +1097,60 @@ return ($? >> 8); } +############################################################################## + sub import_default_keyring { my $defkey = File::Spec->catfile ($DEF_RULES_DIR, "sa-update-pubkey.txt"); - return unless (-f $defkey); + unless (-f $defkey) { + dbg("gpg: import of default keyring failed, couldn't find sa-update-pubkey.txt"); + return; + } - print "sa-update: importing default keyring to '".$opt{gpghomedir}."'...\n"; + dbg("gpg: importing default keyring to '".$opt{gpghomedir}); unless (-d $opt{gpghomedir}) { # use 0700 to avoid "unsafe permissions" warning - mkdir ($opt{gpghomedir}, 0700) or die "cannot mkdir $opt{gpghomedir}: $!"; + mkpath([$opt{'gpghomedir'}], 0, 0700) or die "cannot mkpath $opt{gpghomedir}: $!"; } import_gpg_key($defkey); } +############################################################################## + sub is_valid_gpg_key_id { # either a keyid (8 bytes) or a fingerprint (40 bytes) return ($_[0] =~ /^[a-fA-F0-9]+$/ && (length $_[0] == 8 || length $_[0] == 40)); } +############################################################################## + sub clean_update_dir { my $dir = shift; + unless (opendir(DIR, $dir)) { warn "error: can't readdir $dir: $!\n"; - dbg("channel: attempt to readdir failed, channel failed"); - return 0; + dbg("generic: attempt to readdir ($dir) failed"); + return; } while(my $file = readdir(DIR)) { - next unless (-f "$dir/$file"); - next if ($file eq 'MIRRORED.BY'); - dbg("channel: unlinking $file"); - $file =~ /^([^\/]+)$/; # untaint + $file =~ /^(.+)$/; # untaint $file = $1; - if (!unlink "$dir/$file") { - warn "error: can't remove file $dir/$file: $!\n"; - return 0; + + 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); + return; } } closedir(DIR); return 1; } +############################################################################## + sub lint_check_dir { my $dir = shift; @@ -1086,8 +1159,8 @@ # "config" or otherwise be more terse. :( my $spamtest = new Mail::SpamAssassin( { rules_filename => $dir, - site_rules_filename => "$dir/doesnotexist", - userprefs_filename => "$dir/doesnotexist", + site_rules_filename => File::Spec->catfile($dir, "doesnotexist"), + userprefs_filename => File::Spec->catfile($dir, "doesnotexist"), local_tests_only => 1, dont_copy_prefs => 1, @@ -1108,30 +1181,10 @@ return $res == 0; } -# a version of rename() that can cope with renaming files across filesystems, -# as mv(1) can. -sub cross_fs_rename { - my ($from, $to) = @_; - my $ret = rename ($from, $to); +############################################################################## - if ($ret) { - return $ret; # success first time! great - } +=cut - # try a copy - if (!copy($from, $to)) { - # copy failed, too. we have no further fallbacks; return the rename() - # failure code - return $ret; - } - - # copy succeeded, we're good; remove the source, and return success - unlink($from); - return 1; -} - -# --------------------------------------------------------------------------- - =head1 NAME sa-update - automate SpamAssassin rule updates @@ -1285,6 +1338,7 @@ Mail::SpamAssassin::Conf(3) spamassassin(1) spamd(1) + =head1 PREREQUESITES