Server IP : 85.214.239.14 / Your IP : 3.145.88.111 Web Server : Apache/2.4.62 (Debian) System : Linux h2886529.stratoserver.net 4.9.0 #1 SMP Tue Jan 9 19:45:01 MSK 2024 x86_64 User : www-data ( 33) PHP Version : 7.4.18 Disable Function : pcntl_alarm,pcntl_fork,pcntl_waitpid,pcntl_wait,pcntl_wifexited,pcntl_wifstopped,pcntl_wifsignaled,pcntl_wifcontinued,pcntl_wexitstatus,pcntl_wtermsig,pcntl_wstopsig,pcntl_signal,pcntl_signal_get_handler,pcntl_signal_dispatch,pcntl_get_last_error,pcntl_strerror,pcntl_sigprocmask,pcntl_sigwaitinfo,pcntl_sigtimedwait,pcntl_exec,pcntl_getpriority,pcntl_setpriority,pcntl_async_signals,pcntl_unshare, MySQL : OFF | cURL : OFF | WGET : ON | Perl : ON | Python : ON | Sudo : ON | Pkexec : OFF Directory : /proc/2/cwd/usr/share/perl5/Amavis/ |
Upload File : |
# 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;