File: //usr/share/perl5/vendor_perl/Amavis/TempDir.pm
# SPDX-License-Identifier: GPL-2.0-or-later
package Amavis::TempDir;
# Handles creation and cleanup of a persistent temporary directory,
# a file 'email.txt' therein, and a subdirectory 'parts'
use strict;
use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.412';
@ISA = qw(Exporter);
}
use Errno qw(ENOENT EACCES EEXIST);
use IO::File qw(O_RDONLY O_WRONLY O_RDWR O_APPEND O_CREAT O_EXCL);
use File::Temp ();
use Amavis::Conf qw(:platform :confvars c cr ca);
use Amavis::rfc2821_2822_Tools qw(iso8601_timestamp);
use Amavis::Timing qw(section_time);
use Amavis::Util qw(ll do_log do_log_safe add_entropy rmdir_recursively);
sub new {
my $class = $_[0];
my $self = bless {}, $class;
$self->{tempdir_path} = undef;
undef $self->{tempdir_dev}; undef $self->{tempdir_ino};
undef $self->{fh_pers}; undef $self->{fh_dev}; undef $self->{fh_ino};
$self->{empty} = 1; $self->{preserve} = 0;
$self;
}
sub path { # path to a temporary directory
@_<2 ? shift->{tempdir_path} : ($_[0]->{tempdir_path} = $_[1])
}
sub fh { # email.txt file handle
@_<2 ? shift->{fh_pers} : ($_[0]->{fh_pers} = $_[1]);
}
sub empty { # whether the directory is empty
@_<2 ? shift->{empty} : ($_[0]->{empty} = $_[1])
}
sub preserve { # whether to preserve directory when current task is done
@_<2 ? shift->{preserve} : ($_[0]->{preserve} = $_[1]);
}
# Clean up the tempdir on shutdown
#
sub DESTROY {
my $self = $_[0];
local($@,$!,$_); my $myactualpid = $$;
if (defined($my_pid) && $myactualpid != $my_pid) {
do_log_safe(5,"TempDir::DESTROY skip, clone [%s] (born as [%s])",
$myactualpid, $my_pid);
} else {
do_log_safe(5,"TempDir::DESTROY called");
eval {
# must step out of the directory which is about to be deleted,
# otherwise rmdir can fail (e.g. on Solaris)
chdir($TEMPBASE)
or do_log(-1,"TempDir::DESTROY can't chdir to %s: %s", $TEMPBASE, $!);
if ($self->{fh_pers}) {
$self->{fh_pers}->close
or do_log(-1,"Error closing temp file: %s", $!);
}
undef $self->{fh_pers};
my $dname = $self->{tempdir_path};
my $errn = !defined($dname) || $dname eq '' ? ENOENT
: lstat($dname) ? 0 : 0+$!;
if (defined($dname) && $errn != ENOENT) {
# this will not be included in the TIMING report,
# but it only occurs infrequently and doesn't take that long
if ($self->{preserve} && !$self->{empty}) {
do_log(-1,"TempDir removal: tempdir is to be PRESERVED: %s", $dname);
} else {
do_log(3, "TempDir removal: %s is being removed: %s%s",
$self->{empty} ? 'empty tempdir' : 'tempdir', $dname,
$self->{preserve} ? ', nothing to preserve' : '');
rmdir_recursively($dname);
}
};
1;
} or do {
my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
do_log_safe(1,"TempDir removal: %s",$eval_stat);
};
}
}
# Creates a temporary directory, or checks that inode did not change on reuse
#
sub prepare_dir {
my $self = $_[0];
my(@stat_list); my $errn; my $reuse = 0;
my $dname = $self->{tempdir_path};
if (defined $dname) { # hope to reuse existing directory
@stat_list = lstat($dname); $errn = @stat_list ? 0 : 0+$!;
if ($errn != ENOENT) {
$reuse = 1; # good, it exists, try reusing it
} else {
do_log(2,"TempDir::prepare_dir: directory %s no longer exists", $dname);
$self->{tempdir_path} = $dname = undef; $self->{empty} = 1;
}
}
if (!defined $dname) {
# invent a name of a temporary directory for this child
my $dirtemplate = sprintf("amavis-%s-%05d-XXXXXXXX",
iso8601_timestamp(time,1), $my_pid);
$dname = File::Temp::tempdir($dirtemplate, DIR => $TEMPBASE);
defined $dname && $dname ne ''
or die "Can't create a temporary directory $TEMPBASE/$dirtemplate: $!";
do_log(4,"TempDir::prepare_dir: created directory %s", $dname);
chmod(0750,$dname)
or die "Can't change protection on directory $dname: $!";
@stat_list = lstat($dname);
@stat_list or die "Failed to access directory $dname: $!";
$self->{tempdir_path} = $dname;
($self->{tempdir_dev}, $self->{tempdir_ino}) = @stat_list;
$self->{empty} = 1; add_entropy($dname, @stat_list);
section_time('mkdir tempdir');
}
$errn = @stat_list ? 0 : 0+$!;
if ($errn != 0) {
die "TempDir::prepare_dir: Can't access temporary directory $dname: $!";
} elsif (! -d _) { # exists, but is not a directory !?
die "TempDir::prepare_dir: $dname is not a directory!!!";
} elsif ($reuse) { # existing directory
my($dev,$ino,$mode,$nlink) = @stat_list;
# perl 5.28: On platforms where inode numbers are of a type larger than
# perl's native integer numerical types, stat will preserve the full
# content of large inode numbers by returning them in the form of strings
# of decimal digits. Use eq rather than == for exact comparison of inode.
if ($dev != $self->{tempdir_dev} || $ino ne $self->{tempdir_ino}) {
do_log(-1,"TempDir::prepare_dir: %s is no longer the same directory!",
$dname);
($self->{tempdir_dev}, $self->{tempdir_ino}) = ($dev, $ino);
}
if ($nlink > 3) {
# when a directory's link count is > 2, it has "n-2" sub-directories;
# this does not apply to file systems like AFS, FAT, ISO-9660,
# but it also seems it does not apply to Mac OS 10 (Leopard)
do_log(5, "TempDir::prepare_dir: directory %s has %d subdirectories",
$dname, $nlink-2);
}
}
}
# Prepares the email.txt temporary file for writing (and reading later)
#
sub prepare_file {
my $self = $_[0];
my $fname = $self->path . '/email.txt';
my(@stat_list) = lstat($fname); my $errn = @stat_list ? 0 : 0+$!;
if ($errn == ENOENT) { # no file
do_log(0,"TempDir::prepare_file: %s no longer exists, can't re-use it",
$fname) if $self->{fh_pers};
undef $self->{fh_pers};
} elsif ($errn != 0) { # some other error
undef $self->{fh_pers};
die "TempDir::prepare_file: can't access temporary file $fname: $!";
} elsif (! -f _) { # not a regular file !?
undef $self->{fh_pers};
die "TempDir::prepare_file: $fname is not a regular file!!!";
} elsif ($self->{fh_pers}) {
my($dev,$ino) = @stat_list;
# perl 5.28: On platforms where inode numbers are of a type larger than
# perl's native integer numerical types, stat will preserve the full
# content of large inode numbers by returning them in the form of strings
# of decimal digits. Use eq rather than == for exact comparison of inode.
if ($dev != $self->{file_dev} || $ino ne $self->{file_ino}) {
# may happen if some user code has replaced the file, e.g. by altermime
undef $self->{fh_pers};
do_log(1,"TempDir::prepare_file: %s is no longer the same file, ".
"won't re-use it, deleting", $fname);
unlink($fname) or die "Can't remove file $fname: $!";
}
}
if ($self->{fh_pers} && !$can_truncate) { # just in case clean() retained it
undef $self->{fh_pers};
do_log(1,"TempDir::prepare_file: unable to truncate temporary file %s, ".
"deleting it", $fname);
unlink($fname) or die "Can't remove file $fname: $!";
}
if ($self->{fh_pers}) { # rewind and truncate existing file
$self->{fh_pers}->flush or die "Can't flush mail file: $!";
$self->{fh_pers}->seek(0,0) or die "Can't rewind mail file: $!";
$self->{fh_pers}->truncate(0) or die "Can't truncate mail file: $!";
} else {
do_log(4,"TempDir::prepare_file: creating file %s", $fname);
# $^F == 2
# or do_log(-1,"TempDir::prepare_file: SYSTEM_FD_MAX not 2: %d", $^F);
my $newfh = IO::File->new;
# this can fail if a previous task of this process just recently stumbled
# on some error and preserved its evidence, not deleting a file email.txt
$newfh->open($fname, O_CREAT|O_EXCL|O_RDWR, 0640)
or die "Can't create file $fname: $!";
binmode($newfh,':bytes') or die "Can't cancel :utf8 mode on $fname: $!";
if (ll(5) && $] >= 5.008001) { # get_layers was added with Perl 5.8.1
my(@layers) = PerlIO::get_layers($newfh);
do_log(5,"TempDir::prepare_file: layers: %s", join(',',@layers));
}
$self->{fh_pers} = $newfh;
@stat_list = lstat($fname);
@stat_list or die "Failed to access temporary file $fname: $!";
add_entropy(@stat_list);
($self->{file_dev}, $self->{file_ino}) = @stat_list;
section_time('create email.txt');
}
}
# Cleans the temporary directory for reuse, unless it is set to be preserved
#
sub clean {
my $self = $_[0];
if ($self->{preserve} && !$self->{empty}) {
# keep evidence in case of trouble
do_log(-1,"PRESERVING EVIDENCE in %s", $self->{tempdir_path});
if ($self->{fh_pers}) {
$self->{fh_pers}->close or die "Error closing mail file: $!"
}
undef $self->{fh_pers}; $self->{tempdir_path} = undef; $self->{empty} = 1;
}
# cleanup, but leave directory (and file handle if possible) for reuse
if ($self->{fh_pers} && !$can_truncate) {
# truncate is not standard across all Unix variants,
# it is not Posix, but is XPG4-UNIX.
# So if we can't truncate a file and leave it open,
# we have to create it anew later, at some cost.
#
$self->{fh_pers}->close or die "Error closing mail file: $!";
undef $self->{fh_pers};
unlink($self->{tempdir_path}.'/email.txt')
or die "Can't delete file ".$self->{tempdir_path}."/email.txt: $!";
section_time('delete email.txt');
}
if (defined $self->{tempdir_path}) { # prepare for the next one
$self->strip; $self->{empty} = 1;
}
$self->{preserve} = 0; # reset
}
# Remove files and subdirectories from the temporary directory, leaving only
# the directory itself, file email.txt, and empty subdirectory ./parts .
# Leaving directories for reuse can represent an important saving in time,
# as directory creation + deletion can be an expensive operation,
# requiring atomic file system operation, including flushing buffers
# to disk (depending on the file system in use).
#
sub strip {
my $self = $_[0];
my $dname = $self->{tempdir_path};
do_log(4, "TempDir::strip: %s", $dname);
# must step out of the directory which is about to be deleted,
# otherwise rmdir can fail (e.g. on Solaris)
chdir($TEMPBASE) or die "TempDir::strip: can't chdir to $TEMPBASE: $!";
my(@stat_list) = lstat($dname);
my $errn = @stat_list ? 0 : 0+$!;
if ($errn == ENOENT) {
do_log(-1,"TempDir::strip: directory %s no longer exists", $dname);
$self->{tempdir_path} = $dname = undef; $self->{empty} = 1;
} elsif ($errn != 0) {
die "TempDir::strip: error accessing directory $dname: $!";
} else {
my($dev,$ino) = @stat_list;
# perl 5.28: On platforms where inode numbers are of a type larger than
# perl's native integer numerical types, stat will preserve the full
# content of large inode numbers by returning them in the form of strings
# of decimal digits. Use eq rather than == for exact comparison of inode.
if ($dev != $self->{tempdir_dev} || $ino ne $self->{tempdir_ino}) {
do_log(-1,"TempDir::strip: %s is no longer the same directory!",
$dname);
($self->{tempdir_dev}, $self->{tempdir_ino}) = ($dev, $ino);
}
# now deal with the 'parts' subdirectory
my $errn = lstat("$dname/parts") ? 0 : 0+$!;
if ($errn == ENOENT) {} # fine, no such directory
elsif ($errn!=0) { die "TempDir::strip: error accessing $dname/parts: $!" }
elsif ( -l _) { die "TempDir::strip: $dname/parts is a symbolic link" }
elsif (!-d _) { die "TempDir::strip: $dname/parts is not a directory" }
else { rmdir_recursively("$dname/parts", 1) }
$self->check; # check for any remains in the top directory just in case
}
1;
}
# Checks tempdir after being cleaned.
# It may only contain subdirectory 'parts' and file email.txt, nothing else.
#
sub check {
my $self = $_[0];
my $eval_stat; my $dname = $self->{tempdir_path};
local(*DIR); opendir(DIR,$dname) or die "Can't open directory $dname: $!";
eval {
# avoid slurping the whole directory contents into memory
$! = 0; my $f;
while (defined($f = readdir(DIR))) {
next if $f eq '.' || $f eq '..';
my $fname = $dname . '/' . $f;
my(@stat_list) = lstat($fname);
my $errn = @stat_list ? 0 : 0+$!;
if ($errn) {
die "Inaccessible $fname: $!";
} elsif (-f _) {
warn "Unexpected file $fname" if $f ne 'email.txt';
} elsif (-l _) {
die "Unexpected link $fname";
} elsif (-d _) {
my $nlink = $stat_list[3];
if ($f ne 'parts') {
die "Unexpected directory $fname";
} elsif ($nlink > 2) { # number of hard links
# when a directory's link count is > 2, it has "n-2" sub-directories;
# this does not apply to file systems like AFS, FAT, ISO-9660,
# but it also seems it does not apply to Mac OS 10 (Leopard)
do_log(5, "TempDir::check: directory %s has %d subdirectories",
$dname, $nlink-2);
}
} else {
die "Unexpected non-regular file $fname";
}
}
# checking status on directory read ops doesn't work as expected, Perl bug
# $! == 0 or die "Error reading directory $dname: $!";
1;
} or do { $eval_stat = $@ ne '' ? $@ : "errno=$!" };
closedir(DIR) or die "Error closing directory $dname: $!";
if (defined $eval_stat) {
chomp $eval_stat;
die $eval_stat if $eval_stat =~ /^timed out\b/; # resignal timeout
die "TempDir::check: $eval_stat\n";
}
1;
}
1;