# 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;