# SPDX-License-Identifier: GPL-2.0-or-later

package Amavis::Unpackers;
use strict;
use re 'taint';
use warnings;
use warnings FATAL => qw(utf8 void);
no warnings 'uninitialized';
# use warnings 'extra'; no warnings 'experimental::re_strict'; use re 'strict';

BEGIN {
  require Exporter;
  use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
  $VERSION = '2.412';
  @ISA = qw(Exporter);
  @EXPORT_OK = qw(&init &decompose_part &determine_file_types);
}

use Amavis::Conf qw(:platform :confvars $file c cr ca);
use Amavis::ProcControl qw(exit_status_str proc_status_ok run_command
                           kill_proc collect_results collect_results_structured);
use Amavis::Timing qw(section_time);
use Amavis::Unpackers::MIME qw(mime_decode);
use Amavis::Unpackers::NewFilename qw(consumed_bytes);
use Amavis::Unpackers::Part;
use Amavis::Util qw(untaint min max minmax ll do_log snmp_count
                    prolong_timer rmdir_recursively add_entropy);

BEGIN {
  use vars qw($filemagic);
  eval {
    require File::LibMagic;
    File::LibMagic->VERSION(1.00);
    import File::LibMagic;
    $filemagic = File::LibMagic->new;
  } or do {
    undef $filemagic;
  };
}

use subs @EXPORT_OK;

use Errno qw(ENOENT EACCES EINTR EAGAIN);
use POSIX qw(SIGALRM);
use IO::File qw(O_CREAT O_EXCL O_WRONLY);
use Time::HiRes ();
use File::Basename qw(basename);
use Compress::Zlib 1.35;  # avoid security vulnerability in <= 1.34
use Archive::Zip 1.14 qw(:CONSTANTS :ERROR_CODES);

use Amavis::Lookup qw(lookup lookup2);

# recursively descend into a directory $dir containing potentially unsafe
# files with unpredictable names, soft links, etc., rename each regular
# nonempty file to a directory $outdir giving it a generated name,
# and discard all the rest, including the directory $dir.
# Return a pair: number of bytes that 'sanitized' files now occupy,
# and a number of parts-objects created.
#
sub flatten_and_tidy_dir($$$;$$);  # prototype
sub flatten_and_tidy_dir($$$;$$) {
  my($dir, $outdir, $parent_obj, $item_num_offset, $orig_names) = @_;
  do_log(4, 'flatten_and_tidy_dir: processing directory "%s"', $dir);
  my $consumed_bytes = 0;
  my $item_num = 0; my $parent_placement = $parent_obj->mime_placement;
  chmod(0750, $dir) or die "Can't change protection of \"$dir\": $!";
  local(*DIR); opendir(DIR,$dir) or die "Can't open directory \"$dir\": $!";
  # modifying a directory while traversing it can cause surprises, avoid;
  # avoid slurping the whole directory contents into memory
  my($f, @rmfiles, @renames, @recurse);
  while (defined($f = readdir(DIR))) {
    next  if $f eq '.' || $f eq '..';
    my $msg;  my $fname = $dir . '/' . $f;
    my(@stat_list) = lstat($fname); my $errn = @stat_list ? 0 : 0+$!;
    if    ($errn == ENOENT) { $msg = "does not exist" }
    elsif ($errn)           { $msg = "inaccessible: $!" }
    if (defined $msg) { die "flatten_and_tidy_dir: \"$fname\" $msg," }
    add_entropy(@stat_list);
    my $newpart_obj = Amavis::Unpackers::Part->new($outdir,$parent_obj);
    $item_num++;
    $newpart_obj->mime_placement(sprintf("%s/%d", $parent_placement,
                                                 $item_num+$item_num_offset) );
    # save tainted original member name if available, or a tainted file name
    my $original_name = !ref($orig_names) ? undef : $orig_names->{$f};
    $newpart_obj->name_declared(defined $original_name ? $original_name : $f);
    # untaint, but if $dir happens to still be tainted, we want to know and die
    $fname = $dir . '/' . untaint($f);
    if (-d _) {
      $newpart_obj->attributes_add('D');
      push(@recurse, $fname);
    } elsif (-l _) {
      $newpart_obj->attributes_add('L');
      push(@rmfiles, [$fname, 'soft link']);
    } elsif (!-f _) {
      $newpart_obj->attributes_add('S');
      push(@rmfiles, [$fname, 'nonregular file']);
    } elsif (-z _) {
      push(@rmfiles, [$fname, 'empty file']);
    } else {
      chmod(0750, $fname)
        or die "Can't change protection of file \"$fname\": $!";
      my $size = 0 + (-s _);
      $newpart_obj->size($size);
      $consumed_bytes += $size;
      my $newpart = $newpart_obj->full_name;
      push(@renames, [$fname, $newpart, $original_name]);
    }
  }
  closedir(DIR) or die "Error closing directory \"$dir\": $!";
  my $cnt_u = scalar(@rmfiles);
  for my $pair (@rmfiles) {
    my($fname,$what) = @$pair;
    do_log(5,'flatten_and_tidy_dir: deleting %s "%s"', $what,$fname);
    unlink($fname) or die "Can't remove $what \"$fname\": $!";
  }
  undef @rmfiles;
  my $cnt_r = scalar(@renames);
  for my $tuple (@renames) {
    my($fname,$newpart,$original_name) = @$tuple;
    ll(5) && do_log(5,'flatten_and_tidy_dir: renaming "%s"%s to %s', $fname,
              !defined $original_name ? '' : " ($original_name)", $newpart);
    rename($fname,$newpart) or die "Can't rename \"$fname\" to $newpart: $!";
  }
  undef @renames;
  for my $fname (@recurse) {
    do_log(5,'flatten_and_tidy_dir: descending into subdir "%s"', $fname);
    my($bytes,$cnt) = flatten_and_tidy_dir($fname, $outdir, $parent_obj,
                                    $item_num+$item_num_offset, $orig_names);
    $consumed_bytes += $bytes; $item_num += $cnt;
  }
  rmdir($dir) or die "Can't remove directory \"$dir\": $!";
  section_time("ren$cnt_r-unl$cnt_u-files$item_num");
  ($consumed_bytes, $item_num);
}

sub determine_file_types($$) {
  my($tempdir, $partslist_ref) = @_;
  if ($filemagic) {
    determine_file_types_libmagic($tempdir, $partslist_ref);
  } elsif (defined $file && $file ne '') {
    determine_file_types_fileutility($tempdir, $partslist_ref);
  } else {
    die "Neither File::LibMagic nor Unix utility file(1) are available";
  }
}

# associate full and short file content types with each part
# based on libmagic (uses File::LibMagic module)
#
sub determine_file_types_libmagic($$) {
  my($tempdir, $partslist_ref) = @_;
  my(@all_part_list) = grep($_->exists, @$partslist_ref);
  my $initial_num_parts = scalar(@all_part_list);
  do_log(5, 'using File::LibMagic on %d files', $initial_num_parts);
  for my $part (@all_part_list) {
    my($type_long, $type_short);
    eval {
      $type_long = $filemagic->describe_filename($part->full_name);
      1;
    } or do {
      my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
      do_log(0, 'File::LibMagic::describe_filename failed on %s: %s',
             $part->base_name, $eval_stat);
    };
    if (defined $type_long) {
      $type_short = lookup2(0,$type_long,\@map_full_type_to_short_type_maps);
      ll(4) && do_log(4, "File-type of %s: %s%s",
                         $part->base_name, $type_long,
                         (!defined $type_short ? ''
                            : !ref $type_short ? "; ($type_short)"
                            : '; (' . join(', ',@$type_short) . ')'
                         ) );
      $part->type_long($type_long); $part->type_short($type_short);
      $part->attributes_add('C')
        if !ref($type_short) ? $type_short eq 'pgp.enc'  # encrypted?
                             : grep($_ eq 'pgp.enc', @$type_short);
    }
  }
  section_time(sprintf('get-file-type%d', $initial_num_parts));
  1;
}

# call 'file(1)' utility for each part,
# and associate full and short file content types with each part
#
sub determine_file_types_fileutility($$) {
  my($tempdir, $partslist_ref) = @_;
  defined $file && $file ne ''
    or die "Unix utility file(1) not available, but is needed";
  my(@all_part_list) = grep($_->exists, @$partslist_ref);
  my $initial_num_parts = scalar(@all_part_list);
  my $cwd = "$tempdir/parts";
  if (@all_part_list) { chdir($cwd) or die "Can't chdir to $cwd: $!" }
  my($proc_fh,$pid); my $eval_stat;
  eval {
    while (@all_part_list) {
      my(@part_list,@file_list); # collect reasonably small subset of filenames
      my $arglist_size = length($file);  # size of a command name itself
      while (@all_part_list) {   # collect as many args as safe, at least one
        my $nm = $all_part_list[0]->full_name;
        local($1); $nm =~ s{^\Q$cwd\E/(.*)\z}{$1}s;  # remove cwd from filename
        # POSIX requires 4 kB as a minimum buffer size for program arguments
        last  if @file_list && $arglist_size + length($nm) + 1 > 4000;
        push(@part_list, shift(@all_part_list));     # swallow the next one
        push(@file_list, $nm);  $arglist_size += length($nm) + 1;
      }
      if (scalar(@file_list) < $initial_num_parts) {
        do_log(2, "running file(1) on %d (out of %d) files, arglist size %d",
                   scalar(@file_list), $initial_num_parts, $arglist_size);
      } else {
        do_log(5, "running file(1) on %d files, arglist size %d",
                   scalar(@file_list), $arglist_size);
      }
      ($proc_fh,$pid) = run_command(undef, '&1', $file, @file_list);
      my $index = 0; my $ln;
      for ($! = 0; defined($ln=$proc_fh->getline); $! = 0) {
        do_log(5, "result line from file(1): %s", $ln);
        chomp($ln); local($1,$2);
        if ($index > $#file_list) {
          do_log(-1,"NOTICE: Skipping unexpected output from file(1): %s",$ln);
        } else {
          my $part   = $part_list[$index];  # walk through @part_list in sync
          my $expect = $file_list[$index];  # walk through @file_list in sync
          if ($ln !~ /^(\Q$expect\E):[ \t]*(.*)\z/s) {
            # split file name from type
            do_log(-1,"NOTICE: Skipping bad output from file(1) ".
                      "at [%d, %s], got: %s", $index,$expect,$ln);
          } else {
            my $type_short; my $actual_name = $1; my $type_long = $2;
            $type_short =
              lookup2(0,$type_long,\@map_full_type_to_short_type_maps);
            ll(4) && do_log(4, "File-type of %s: %s%s",
                               $part->base_name, $type_long,
                               (!defined $type_short ? ''
                                  : !ref $type_short ? "; ($type_short)"
                                  : '; (' . join(', ',@$type_short) . ')'
                               ) );
            $part->type_long($type_long); $part->type_short($type_short);
            $part->attributes_add('C')
              if !ref($type_short) ? $type_short eq 'pgp.enc'  # encrypted?
                                   : grep($_ eq 'pgp.enc', @$type_short);
            $index++;
          }
        }
      }
      defined $ln || $! == 0 || $! == EAGAIN
        or die "Error reading from file(1) utility: $!";
      do_log(-1,"unexpected(file): %s",$!)  if !defined($ln) && $! == EAGAIN;
      my $err = 0; $proc_fh->close or $err = $!;
      my $child_stat = defined $pid && waitpid($pid,0) > 0 ? $? : undef;
      undef $proc_fh; undef $pid; my(@errmsg);
      # exit status is 1 when result is 'ERROR: ...', accept it mercifully
      proc_status_ok($child_stat,$err, 0,1)
        or push(@errmsg, "failed, ".exit_status_str($child_stat,$err));
      if ($index < @part_list) {
        push(@errmsg, sprintf("parsing failure - missing last %d results",
                              @part_list - $index));
      }
      !@errmsg  or die join(", ",@errmsg);
      # even though exit status 1 is accepted, log a warning nevertheless
      proc_status_ok($child_stat,$err)
        or do_log(-1, "file utility failed: %s",
                       exit_status_str($child_stat,$err));
    }
    1;
  } or do {
    $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
    kill_proc($pid,$file,1,$proc_fh,$eval_stat)  if defined $pid;
  };
  chdir($tempdir) or die "Can't chdir to $tempdir: $!";
  section_time(sprintf('get-file-type%d', $initial_num_parts));
  if (defined $eval_stat) {
    do_log(-2, "file(1) utility (%s) FAILED: %s", $file,$eval_stat);
  # die "file(1) utility ($file) error: $eval_stat";
  }
  1;
}

sub decompose_mail($$) {
  my($tempdir,$file_generator_object) = @_;

  my $hold; my(@parts); my $depth = 1;
  my($any_undecipherable, $any_encrypted, $over_levels, $ambiguous) = (0,0,0,0);
  my $which_section = "parts_decode";
  # fetch all not-yet-visited part names, and start a new cycle
TIER:
  while (@parts = @{$file_generator_object->parts_list}) {
    if ($MAXLEVELS > 0 && $depth > $MAXLEVELS) {
      $over_levels = 1;
      $hold = "Maximum decoding depth ($MAXLEVELS) exceeded";
      last;
    }
    $file_generator_object->parts_list_reset;  # new cycle of names
    # clip to avoid very long log entries
    my(@chopped_parts) = @parts > 5 ? @parts[0..4] : @parts;
    ll(4) && do_log(4,"decode_parts: level=%d, #parts=%d : %s",
                     $depth, scalar(@parts),
                     join(', ', (map($_->base_name, @chopped_parts)),
                     (@chopped_parts >= @parts ? () : "...")) );
    for my $part (@parts) {  # test for existence of all expected files
      my $fname = $part->full_name;  my $errn = 0;
      if ($fname eq '') { $errn = ENOENT }
      else {
        my(@stat_list) = lstat($fname);
        if (@stat_list) { add_entropy(@stat_list) } else { $errn = 0+$! }
      }
      if ($errn == ENOENT) {
        $part->exists(0);
      # $part->type_short('no-file')  if !defined $part->type_short;
      } elsif ($errn) {
        die "decompose_mail: inaccessible file $fname: $!";
      } elsif (!-f _) {  # not a regular file
        my $what = -l _ ? 'symlink' : -d _ ? 'directory' : 'non-regular file';
        do_log(-1, "WARN: decompose_mail: removing unexpected %s %s",
                   $what,$fname);
        if (-d _) { rmdir_recursively($fname) }
        else { unlink($fname) or die "Can't delete $what $fname: $!" }
        $part->exists(0);
        $part->type_short(-l _ ? 'symlink' : -d _ ? 'dir' : 'special')
          if !defined $part->type_short;
      } elsif (-z _) {   # empty file
        unlink($fname) or die "Can't remove \"$fname\": $!";
        $part->exists(0);
        $part->type_short('empty')  if !defined $part->type_short;
        $part->type_long('empty')   if !defined $part->type_long;
      } else {
        $part->exists(1);
      }
    }
    if (!defined $file || $file eq '') {
      do_log(5,'utility file(1) not available, skipping determine_file_types');
    } else {
      determine_file_types($tempdir, \@parts);
    }
    for my $part (@parts) {
      if ($part->exists && !defined($hold)) {
        my($hold_tmp, $over_levels_tmp) = decompose_part($part, $tempdir);
        $hold = $hold_tmp if $hold_tmp;
        $over_levels ||= $over_levels_tmp;
      }
      my $attr = $part->attributes;
      if (defined $attr) {
        $any_undecipherable++  if index($attr, 'U') >= 0;
        $any_encrypted++       if index($attr, 'C') >= 0;
        $ambiguous++           if index($attr, 'B') >= 0;
      }
    }
    last TIER  if defined $hold;
    $depth++;
  }
  section_time($which_section); prolong_timer($which_section);
  ($hold, $any_undecipherable, $any_encrypted, $over_levels, $ambiguous);
}

# Decompose one part
#
sub decompose_part($$) {
  my($part, $tempdir) = @_;
  # possible return values from eval:
  # 0 - truly atomic or unknown or archiver failure; consider atomic
  # 1 - some archive, successfully unpacked, result replaces original
  # 2 - probably unpacked, but keep the original (eg self-extracting archive)
  my $hold; my $eval_stat; my($sts, $any_called, $over_levels) = (0,0,0);
  eval {
    my $type_short = $part->type_short;
    my(@ts) = !defined $type_short ? ()
                : !ref $type_short ? ($type_short) : @$type_short;
    if (@ts) {  # when one or more short types are known
      snmp_count("OpsDecType-".join('.',@ts));
      for my $dec_tuple (@{ca('decoders')}) {  # first matching decoder wins
        next  if !defined $dec_tuple;
        my($short_types, $code, @args) = @$dec_tuple;
        if ($code && grep(ref $short_types ? $short_types->{$_}
                                           : $_ eq $short_types, @ts)) {
          $any_called = 1; $sts = &$code($part,$tempdir,@args);
          last;
        }
      }
    }
    1;
  } or do {
    $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
    my $ll = -1;
    if ($eval_stat =~ /\bExceeded storage quota\b.*\bbytes by/ ||
        $eval_stat =~ /\bMaximum number of files\b.*\bexceeded/) {
      $hold = $eval_stat; $ll = 1; $over_levels = 1;
    }
    do_log($ll,"Decoding of %s (%s) failed, leaving it unpacked: %s",
               $part->base_name, $part->type_long, $eval_stat);
    $sts = 2;  # keep the original, along with possible decoded files
  };
  if ($any_called) {
    chdir($tempdir) or die "Can't chdir to $tempdir: $!";  # just in case
  }
  if ($sts == 1 && lookup2(0,$part->type_long,\@keep_decoded_original_maps)) {
    # don't trust this file type or unpacker,
    # keep both the original and the unpacked file
    ll(4) && do_log(4,"file type is %s, retain original %s",
                      $part->type_long, $part->base_name);
    $sts = 2;  # keep the original, along with possible decoded files
  }
  if ($sts == 1) {
    ll(5) && do_log(5,"decompose_part: deleting %s", $part->full_name);
    unlink($part->full_name)
      or die sprintf("Can't unlink %s: %s", $part->full_name, $!);
  }
  ll(4) && do_log(4,"decompose_part: %s - %s", $part->base_name,
                    ['atomic','archive, unpacked','source retained']->[$sts]);
  section_time('decompose_part')  if $any_called;
  die $eval_stat  if $eval_stat =~ /^timed out\b/;  # resignal timeout
  ($hold, $over_levels);
}

# a trivial wrapper around mime_decode() to adjust arguments and result
#
sub do_mime_decode($$) {
  my($part, $tempdir) = @_;
  mime_decode($part,$tempdir,$part);
  2;  # probably unpacked, but keep the original mail
};

#
# Uncompression/unarchiving routines
# Possible return codes:
# 0 - truly atomic or unknown or archiver failure; consider atomic
# 1 - some archiver format, successfully unpacked, result replaces original
# 2 - probably unpacked, but keep the original (eg self-extracting archive)

# if ASCII text, try multiple decoding methods as provided by UUlib
# (uuencoded, xxencoded, BinHex, yEnc, Base64, Quoted-Printable)
#
use vars qw($have_uulib_module);
sub do_ascii($$) {
  my($part, $tempdir) = @_;
  ll(4) && do_log(4,"do_ascii: Decoding part %s", $part->base_name);
  if (!defined $have_uulib_module) {
    eval {
      require Convert::UUlib && ($have_uulib_module = 1);
      # avoid an exploitable security hole in Convert::UUlib 1.04 and older
      Convert::UUlib->VERSION(1.05);  # 1.08 or newer is preferred!
      $have_uulib_module;
    } or do {
      $have_uulib_module = 0;
      chomp $@;  $@ =~ s/ \(you may need to install the .*\z//i;
      do_log(5,"do_ascii: module Convert::UULIB unavailable: %s", $@);
    };
  }
  return 0 if !$have_uulib_module;
  snmp_count('OpsDecByUUlibAttempt');

  # prevent uunconc.c/UUDecode() from trying to create a temp file in '/'
  my $old_env_tmpdir = $ENV{TMPDIR}; $ENV{TMPDIR} = "$tempdir/parts";
  my $any_errors = 0; my $any_decoded = 0;

  alarm(0);  # stop the timer
  local($SIG{ALRM}); my($sigset,$action,$oldaction);
  if ($] < 5.008) {  # in old Perl signals could be delivered at any time
    $SIG{ALRM} = sub { die "timed out\n" };
  } elsif ($] < 5.008001) {  # Perl 5.8.0
    # 5.8.0 does not have POSIX::SigAction::safe but uses safe signals, which
    # means a runaway uulib can't be aborted; tough luck, upgrade your Perl!
    $SIG{ALRM} = sub { die "timed out\n" };  # old way, but won't abort
  } else {  # Perl >= 5.8.0 has 'safe signals', and SigAction::safe available
    # POSIX::sigaction can bypass safe Perl signals on request;
    # alternatively, use Perl module Sys::SigAction
    $sigset = POSIX::SigSet->new(SIGALRM); $oldaction = POSIX::SigAction->new;
    $action = POSIX::SigAction->new(sub { die "timed out\n" },
                                    $sigset, &POSIX::SA_RESETHAND);
    $action->safe(1);
    POSIX::sigaction(SIGALRM,$action,$oldaction)
      or die "Can't set ALRM handler: $!";
    do_log(4,"do_ascii: Setting sigaction handler, was %d", $oldaction->safe);
  }
  my $eval_stat;
  eval {  # must not go away without calling Convert::UUlib::CleanUp !
    my($sts,$count);
    prolong_timer('do_ascii_pre');  # restart timer
    $sts = Convert::UUlib::Initialize();
    $sts = 0  if !defined $sts; # avoid Use of uninit. value in numeric eq (==)
    $sts == Convert::UUlib::RET_OK()
      or die "Convert::UUlib::Initialize failed: ".
             Convert::UUlib::strerror($sts);
    my $uulib_version =
      Convert::UUlib::GetOption(Convert::UUlib::OPT_VERSION());
    !Convert::UUlib::SetOption(Convert::UUlib::OPT_IGNMODE(), 1)
      or die "bad uulib OPT_IGNMODE";
  # !Convert::UUlib::SetOption(Convert::UUlib::OPT_DESPERATE(), 1)
  #   or die "bad uulib OPT_DESPERATE";
    if (defined $action) {
      $action->safe(0);  # bypass safe Perl signals
      POSIX::sigaction(SIGALRM,$action) or die "Can't set ALRM handler: $!";
    }
    # may take looong time on malformed messages, allow it to be interrupted
    ($sts, $count) = Convert::UUlib::LoadFile($part->full_name);
    if (defined $action) {
      $action->safe(1);  # re-establish safe signal handling
      POSIX::sigaction(SIGALRM,$action) or die "Can't set ALRM handler: $!";
    }
    if ($sts != Convert::UUlib::RET_OK()) {
      my $errmsg = Convert::UUlib::strerror($sts) . ": $!";
      $errmsg .= ", (???"
        . Convert::UUlib::strerror(
            Convert::UUlib::GetOption(Convert::UUlib::OPT_ERRNO()))."???)"
        if $sts == Convert::UUlib::RET_IOERR();
      die "Convert::UUlib::LoadFile (uulib V$uulib_version) failed: $errmsg";
    }
    ll(4) && do_log(4,"do_ascii: Decoding part %s (%d items), uulib V%s",
                      $part->base_name, $count, $uulib_version);
    my $uu;
    my $item_num = 0; my $parent_placement = $part->mime_placement;
    for (my $j = 0; $uu = Convert::UUlib::GetFileListItem($j); $j++) {
      $item_num++;
      ll(4) && do_log(4,
                 "do_ascii(%d): state=0x%02x, enc=%s%s, est.size=%s, name=%s",
                  $j, $uu->state, Convert::UUlib::strencoding($uu->uudet),
                  ($uu->mimetype ne '' ? ", mimetype=" . $uu->mimetype : ''),
                  $uu->size, $uu->filename);
      if (!($uu->state & Convert::UUlib::FILE_OK())) {
        $any_errors = 1;
        do_log(1,"do_ascii: Convert::UUlib info: %s not decodable, %s",
                 $j,$uu->state);
      } else {
        my $newpart_obj = Amavis::Unpackers::Part->new("$tempdir/parts",$part);
        $newpart_obj->mime_placement("$parent_placement/$item_num");
        $newpart_obj->name_declared($uu->filename);
        my $newpart = $newpart_obj->full_name;
        if (defined $action) {
          $action->safe(0);  # bypass safe Perl signals
          POSIX::sigaction(SIGALRM,$action) or die "Can't set ALRM handlr: $!";
        }
        $! = 0;
        $sts = $uu->decode($newpart);  # decode to file $newpart
        my $err_decode = "$!";
        if (defined $action) {
          $action->safe(1);  # re-establish safe signal handling
          POSIX::sigaction(SIGALRM,$action) or die "Can't set ALRM handlr: $!";
        }
        chmod(0750, $newpart) or $! == ENOENT  # chmod, don't panic if no file
          or die "Can't change protection of \"$newpart\": $!";
        my $statmsg;
        my $errn = lstat($newpart) ? 0 : 0+$!;
        if    ($errn == ENOENT) { $statmsg = "does not exist"   }
        elsif ($errn) { $statmsg = "inaccessible: $!" }
        elsif ( -l _) { $statmsg = "is a symlink"     }
        elsif ( -d _) { $statmsg = "is a directory"   }
        elsif (!-f _) { $statmsg = "not a regular file" }
        if (defined $statmsg) { $statmsg = "; file status: $newpart $statmsg" }
        my $size = 0 + (-s _);
        $newpart_obj->size($size);
        consumed_bytes($size, 'do_ascii');
        if ($sts == Convert::UUlib::RET_OK() && $errn==0) {
          $any_decoded = 1;
          do_log(4,"do_ascii: RET_OK%s", $statmsg)  if defined $statmsg;
        } elsif ($sts == Convert::UUlib::RET_NODATA() ||
                 $sts == Convert::UUlib::RET_NOEND()) {
          $any_errors = 1;
          do_log(-1,"do_ascii: Convert::UUlib error: %s%s",
                    Convert::UUlib::strerror($sts), $statmsg);
        } else {
          $any_errors = 1;
          my $errmsg = Convert::UUlib::strerror($sts) . ":: $err_decode";
          $errmsg .= ", " . Convert::UUlib::strerror(
                  Convert::UUlib::GetOption(Convert::UUlib::OPT_ERRNO()) )
            if $sts == Convert::UUlib::RET_IOERR();
          die("Convert::UUlib failed: " . $errmsg . $statmsg);
        }
      }
    }
    1;
  } or do { $eval_stat = $@ ne '' ? $@ : "errno=$!" };
  prolong_timer('do_ascii');  # restart timer
  if (defined $oldaction) {
    POSIX::sigaction(SIGALRM,$oldaction)
      or die "Can't restore ALRM handler: $!";
  }
  Convert::UUlib::CleanUp();
  snmp_count('OpsDecByUUlib')  if $any_decoded;
  if (defined $old_env_tmpdir) { $ENV{TMPDIR} = $old_env_tmpdir }
  else { delete $ENV{TMPDIR} }
  if (defined $eval_stat) { chomp $eval_stat; die "do_ascii: $eval_stat\n" }
  $any_errors ? 2 : $any_decoded ? 1 : 0;
}

# use Archive-Zip
#
sub do_unzip($$;$$) {
  my($part, $tempdir, $archiver_dummy, $testing_for_sfx) = @_;
  ll(4) && do_log(4, "Unzipping %s", $part->base_name);
  # avoid DoS vulnerability in < 2.017, CVE-2009-1391
  # Compress::Raw::Zlib->VERSION(2.017);  # module not loaded
  snmp_count('OpsDecByArZipAttempt');
  my $zip = Archive::Zip->new;
  my(@err_nm) = qw(AZ_OK AZ_STREAM_END AZ_ERROR AZ_FORMAT_ERROR AZ_IO_ERROR);
  my $retval = 1;
  # need to set up a temporary minimal error handler
  Archive::Zip::setErrorHandler(sub { return 5 });
  my $sts = $zip->read($part->full_name);
  Archive::Zip::setErrorHandler(sub { die @_ });
  my($any_unsupp_compmeth,$any_zero_length);
  my($encryptedcount,$extractedcount) = (0,0);
  if ($sts != AZ_OK) {  # not a zip? corrupted zip file? other errors?
    if ($testing_for_sfx && $sts == AZ_FORMAT_ERROR) {
      # a normal status for executable that is not a self extracting archive
      do_log(4, "do_unzip: ok, exe is not a zip sfx: %s (%s)",
                $err_nm[$sts], $sts);
    } else {
      do_log(-1, "do_unzip: not a zip: %s (%s)", $err_nm[$sts], $sts);
#     $part->attributes_add('U');  # perhaps not, it flags as **UNCHECKED** too
#                                  # many bounces containing chopped-off zip
    }
    $retval = 0;
  } else {
    my $item_num = 0; my $parent_placement = $part->mime_placement;
    for my $mem ($zip->members) {
      my $newpart_obj = Amavis::Unpackers::Part->new("$tempdir/parts",$part);
      $item_num++; $newpart_obj->mime_placement("$parent_placement/$item_num");
      $newpart_obj->name_declared($mem->fileName);
      my $compmeth = $mem->compressionMethod;
      if ($compmeth!=COMPRESSION_DEFLATED && $compmeth!=COMPRESSION_STORED) {
        $any_unsupp_compmeth = $compmeth;
        $newpart_obj->attributes_add('U');
      } elsif ($mem->isEncrypted) {
        $encryptedcount++;
        $newpart_obj->attributes_add('U','C');
      } elsif ($mem->isDirectory) {
        $newpart_obj->attributes_add('D');
      } else {
        # want to read uncompressed - set to COMPRESSION_STORED
        my $oldc = $mem->desiredCompressionMethod(COMPRESSION_STORED);
        $sts = $mem->rewindData;
        $sts == AZ_OK or die sprintf("%s: error rew. member data: %s (%s)",
                                     $part->base_name, $err_nm[$sts], $sts);
        my $newpart = $newpart_obj->full_name;
        my $outpart = IO::File->new;
        # O_WRONLY etc. can become tainted in Perl5.8.9 [perlbug #62502]
        $outpart->open($newpart, untaint(O_CREAT|O_EXCL|O_WRONLY), 0640)
          or die "Can't create file $newpart: $!";
        binmode($outpart) or die "Can't set file $newpart to binmode: $!";
        my $size = 0;
        while ($sts == AZ_OK) {
          my $buf_ref;
          ($buf_ref, $sts) = $mem->readChunk;
          $sts == AZ_OK || $sts == AZ_STREAM_END
            or die sprintf("%s: error reading member: %s (%s)",
                           $part->base_name, $err_nm[$sts], $sts);
          my $buf_len = length($$buf_ref);
          if ($buf_len > 0) {
            $size += $buf_len;
            $outpart->print($$buf_ref) or die "Can't write to $newpart: $!";
            consumed_bytes($buf_len, 'do_unzip');
          }
        }
        $any_zero_length = 1  if $size == 0;
        $newpart_obj->size($size);
        $outpart->close or die "Error closing $newpart: $!";
        $mem->desiredCompressionMethod($oldc);
        $mem->endRead;
        $extractedcount++;
      }
    }
    snmp_count('OpsDecByArZip');
  }
  if ($any_unsupp_compmeth) {
    $retval = 2;
    do_log(-1, "do_unzip: %s, unsupported compression method: %s",
               $part->base_name, $any_unsupp_compmeth);
  } elsif ($any_zero_length) {  # possible zip vulnerability exploit
    $retval = 2;
    do_log(1, "do_unzip: %s, members of zero length, archive retained",
              $part->base_name);
  } elsif ($encryptedcount) {
    $retval = 2;
    do_log(1,
      "do_unzip: %s, %d members are encrypted, %s extracted, archive retained",
      $part->base_name, $encryptedcount,
      !$extractedcount ? 'none' : $extractedcount);
  }
  $retval;
}

# use external decompressor program from the compress/gzip/bzip2/xz/lz4 family
#
sub do_uncompress($$$) {
  my($part, $tempdir, $decompressor) = @_;
  ll(4) && do_log(4,"do_uncompress %s by %s", $part->base_name,$decompressor);
  my $decompressor_name = basename((split(' ',$decompressor))[0]);
  snmp_count("OpsDecBy\u${decompressor_name}");
  my $newpart_obj = Amavis::Unpackers::Part->new("$tempdir/parts",$part);
  $newpart_obj->mime_placement($part->mime_placement."/1");
  my $newpart = $newpart_obj->full_name;
  my($type_short, $name_declared) = ($part->type_short, $part->name_declared);
  local($1);  my(@rn);  # collect recommended file names
  push(@rn,$1)
    if $part->type_long =~ /^\S+\s+compressed data, was "(.+)"(\z|, from\b)/;
  for my $name_d (!ref $name_declared ? ($name_declared) : @$name_declared) {
    next  if $name_d eq '';
    my $name = $name_d;
    for (!ref $type_short ? ($type_short) : @$type_short) {
      $_ eq 'F'    and $name=~s/\.F\z//;
      $_ eq 'Z'    and $name=~s/\.Z\z//    || $name=~s/\.tg?z\z/.tar/;
      $_ eq 'gz'   and $name=~s/\.gz\z//   || $name=~s/\.tgz\z/.tar/;
      $_ eq 'bz'   and $name=~s/\.bz\z//   || $name=~s/\.tbz\z/.tar/;
      $_ eq 'bz2'  and $name=~s/\.bz2?\z// || $name=~s/\.tbz2?\z/.tar/;
      $_ eq 'xz'   and $name=~s/\.xz\z//   || $name=~s/\.txz\z/.tar/;
      $_ eq 'lzma' and $name=~s/\.lzma\z// || $name=~s/\.tlz\z/.tar/;
      $_ eq 'lrz'  and $name=~s/\.lrz\z//;
      $_ eq 'lzip' and $name=~s/\.lz\z//;
      $_ eq 'lzo'  and $name=~s/\.lzo\z//;
      $_ eq 'lz4'  and $name=~s/\.lz4\z//;
      $_ eq 'rpm'  and $name=~s/\.rpm\z/.cpio/;
      $_ eq 'zst'  and $name=~s/\.zst\z//;
    }
    push(@rn,$name)  if !grep($_ eq $name, @rn);
  }
  $newpart_obj->name_declared(@rn==1 ? $rn[0] : \@rn)  if @rn;
  my($proc_fh,$pid); my $retval = 1;

  prolong_timer('do_uncompress_pre');  # restart timer
  my $eval_stat;
  eval {
    ($proc_fh,$pid) =
      run_command($part->full_name, '/dev/null', split(' ',$decompressor));
    my($rv,$err) = run_command_copy($newpart,$proc_fh,$pid);  # may die
    undef $proc_fh; undef $pid;
    if (!proc_status_ok($rv,$err)) {
#     unlink($newpart) or die "Can't unlink $newpart: $!";
      my $msg = sprintf('Error running decompressor %s on %s, %s',
                   $decompressor, $part->base_name, exit_status_str($rv,$err));
      # bzip2 and gzip use status 2 as a warning about corrupted file
      if (proc_status_ok($rv,$err, 2)) {do_log(0,"%s",$msg)} else {die $msg}
    }
    1;
  } or do { $eval_stat = $@ ne '' ? $@ : "errno=$!" };
  prolong_timer('do_uncompress');  # restart timer
  if (defined $eval_stat) {
    $retval = 0; chomp $eval_stat;
    kill_proc($pid,$decompressor,1,$proc_fh,$eval_stat)  if defined $pid;
    undef $proc_fh; undef $pid;
    die "do_uncompress: $eval_stat\n";  # propagate failure
  }
  $retval;
}

# use Compress::Zlib to inflate
#
sub do_gunzip($$) {
  my($part, $tempdir) = @_;  my $retval = 0;
  do_log(4, "Inflating gzip archive %s", $part->base_name);
  snmp_count('OpsDecByZlib');
  my $gz = Amavis::IO::Zlib->new;
  $gz->open($part->full_name,'rb')
    or die("do_gunzip: Can't open gzip file ".$part->full_name.": $!");
  my $newpart_obj = Amavis::Unpackers::Part->new("$tempdir/parts",$part);
  $newpart_obj->mime_placement($part->mime_placement."/1");
  my $newpart = $newpart_obj->full_name;
  my $outpart = IO::File->new;
  # O_WRONLY etc. can become tainted in Perl5.8.9 [perlbug #62502]
  $outpart->open($newpart, untaint(O_CREAT|O_EXCL|O_WRONLY), 0640)
    or die "Can't create file $newpart: $!";
  binmode($outpart) or die "Can't set file $newpart to binmode: $!";
  my($nbytes,$buff); my $size = 0;
  while (($nbytes=$gz->read($buff,16384)) > 0) {
    $outpart->print($buff) or die "Can't write to $newpart: $!";
    $size += $nbytes; consumed_bytes($nbytes, 'do_gunzip');
  }
  my $err = defined $nbytes ? 0 : $!;
  $newpart_obj->size($size);
  $outpart->close or die "Error closing $newpart: $!";
  undef $buff;  # release storage
  my(@rn);  # collect recommended file name
  my $name_declared = $part->name_declared;
  for my $name_d (!ref $name_declared ? ($name_declared) : @$name_declared) {
    next  if $name_d eq '';
    my $name = $name_d;
    $name=~s/\.(gz|Z)\z// || $name=~s/\.tgz\z/.tar/;
    push(@rn,$name)  if !grep($_ eq $name, @rn);
  }
  $newpart_obj->name_declared(@rn==1 ? $rn[0] : \@rn)  if @rn;
  if (defined $nbytes && $nbytes==0) { $retval = 1 }  # success
  else {
    do_log(-1, "do_gunzip: Error reading file %s: %s", $part->full_name,$err);
    unlink($newpart) or die "Can't unlink $newpart: $!";
    $newpart_obj->size(undef); $retval = 0;
  }
  $gz->close or die "Error closing gzipped file: $!";
  $retval;
}

# DROPED SUPPORT for Archive::Tar; main drawback of this module is: it either
# loads an entire tar into memory (horrors!), or when using extract_archive()
# it does not relativize absolute paths (which makes it possible to store
# members in any directory writable by uid), and does not provide a way to
# capture contents of members with the same name. Use pax program instead!
#
#use Archive::Tar;
#sub do_tar($$) {
# my($part, $tempdir) = @_;
# snmp_count('OpsDecByArTar');
# # Work around bug in Archive-Tar
# my $tar = eval { Archive::Tar->new($part->full_name) };
# if (!defined($tar)) {
#   chomp $@;
#   do_log(4, "Faulty archive %s: %s", $part->full_name, $@);
#   die $@  if $@ =~ /^timed out\b/;  # resignal timeout
#   return 0;
# }
# do_log(4,"Untarring %s", $part->base_name);
# my $item_num = 0; my $parent_placement = $part->mime_placement;
# my(@list) = $tar->list_files;
# for (@list) {
#   next  if m{/\z};  # ignore directories
#     # this is bad (reads whole file into scalar)
#     # need some error handling, too
#   my $data = $tar->get_content($_);
#   my $newpart_obj = Amavis::Unpackers::Part->new("$tempdir/parts",$part);
#   $item_num++; $newpart_obj->mime_placement("$parent_placement/$item_num");
#   my $newpart = $newpart_obj->full_name;
#   my $outpart = IO::File->new;
#   # O_WRONLY etc. can become tainted in Perl5.8.9 [perlbug #62502]
#   $outpart->open($newpart, untaint(O_CREAT|O_EXCL|O_WRONLY), 0640)
#     or die "Can't create file $newpart: $!";
#   binmode($outpart) or die "Can't set file $newpart to binmode: $!";
#   $outpart->print($data) or die "Can't write to $newpart: $!";
#   $newpart_obj->size(length($data));
#   consumed_bytes(length($data), 'do_tar');
#   $outpart->close or die "Error closing $newpart: $!";
# }
# 1;
#}

# use external program to expand 7-Zip archives
#
sub do_7zip($$$;$) {
  my($part, $tempdir, $archiver, $testing_for_sfx) = @_;
  ll(4) && do_log(4, "Expanding 7-Zip archive %s", $part->base_name);
  my $decompressor_name = basename((split(' ',$archiver))[0]);
  snmp_count("OpsDecBy\u${decompressor_name}Attempt");
  my $last_line; my $any_encrypted; my $bytes = 0; my $mem_cnt = 0;
  my $retval = 1; my($proc_fh,$pid); my $fn = $part->full_name;
  prolong_timer('do_7zip_pre');  # restart timer
  my $eval_stat;
  eval {
    ($proc_fh,$pid) = run_command(undef, '&1', $archiver,
                                  'l', '-slt', "-w$tempdir/parts", '--', $fn);
    my @list;
    my $ln; my($name,$size,$attr,$enc); my $entries_cnt = 0;
    for ($! = 0; defined($ln=$proc_fh->getline); $! = 0) {
      $last_line = $ln  if $ln =~ /\S/;  # keep last nonempty line
      chomp($ln); local($1);
      if ($ln !~ /\S/) {  # empty line separates members
	if (defined $attr && $attr =~ /^D/) {
          do_log(5,'do_7zip: member: %s "%s", (skipped directory)',
                 $attr,$name);
	} elsif (defined $enc && defined $name) {
          do_log(5,'do_7zip: member: %s "%s", %s bytes (skipped encrypted)',
                 $attr,$name,$size);
          # make a phantom entry - carrying only name and attributes
          my $parent_placement = $part->mime_placement;
          my $newpart_obj =
            Amavis::Unpackers::Part->new("$tempdir/parts",$part);
          $newpart_obj->mime_placement("$parent_placement/$entries_cnt");
          $newpart_obj->name_declared($name);
          $newpart_obj->attributes_add('U','C');
	} elsif (defined $name || defined $size) {
          do_log(5,'do_7zip: member: %s "%s", %s bytes',
                 $attr, $name, defined $size ? $size : '?');
          if ($entries_cnt++, $MAXFILES && $entries_cnt > $MAXFILES) {
            die "Maximum number of files ($MAXFILES) exceeded";
          }
          if (defined $size && $size > 0) {
            push(@list, untaint($name));
            $bytes += $size; $mem_cnt++;
	  }
        }
        undef $name; undef $size; undef $attr; undef $enc;
      }
      elsif ($ln =~ /^Path = (.*)\z/s)       { $name = $1 }
      elsif ($ln =~ /^Size = ([0-9]+)\z/s)   { $size = $1 }
      elsif ($ln =~ /^Attributes = (.*)\z/s) { $attr = $1 }
      elsif ($ln =~ /^Encrypted = \+\z/s)    { $enc = $any_encrypted = 1 }
      elsif ($ln =~ /^ERROR:.* Can not open encrypted archive\. Wrong password\?\z/s) {
        do_log(5,'do_7zip: archive is encrypted');
        $part->attributes_add('U','C');
      }
    }
    defined $ln || $! == 0 || $! == EAGAIN  or die "Error reading (1): $!";
    do_log(-1,"unexpected(do_7zip_1): %s",$!) if !defined($ln) && $! == EAGAIN;
    if (defined $name || defined $size) {
      do_log(5,'do_7zip: member: %s "%s", %s bytes', $attr,$name,$size);
      if (defined $size && $size > 0) { $bytes += $size; $mem_cnt++ }
    }
    # consume all remaining output to avoid broken pipe
    for ($! = 0; defined($ln=$proc_fh->getline); $! = 0) {
      $last_line = $ln  if $ln =~ /\S/;
    }
    defined $ln || $! == 0 || $! == EAGAIN  or die "Error reading (2): $!";
    do_log(-1,"unexpected(do_7zip_2): %s",$!)  if !defined($ln) && $! == EAGAIN;
    my $err = 0; $proc_fh->close or $err = $!;
    my $rv = defined $pid && waitpid($pid,0) > 0 ? $? : undef;
    undef $proc_fh; undef $pid;  local($1,$2);
    if (proc_status_ok($rv,$err,1) && $mem_cnt > 0 && $bytes > 0) { # just warn
      do_log(4,"do_7zip: warning, %s", exit_status_str($rv,$err));
    } elsif (!proc_status_ok($rv,$err)) {
      die sprintf("can't get a list of archive members: %s; %s",
                  exit_status_str($rv,$err), $last_line);
    }
    if ($mem_cnt > 0 || $bytes > 0) {
      consumed_bytes($bytes, 'do_7zip-pre', 1);  # pre-check on estimated size
      snmp_count("OpsDecBy\u${decompressor_name}");
      if (!$any_encrypted) {
        # supplying an empty list extracts all files, avoids exceeding the
        # argv size limit as there is no need to exclude excrypted members
        # (which would result in 7z returning a nonzero status)
        @list = ();
      }
      ($proc_fh,$pid) = run_command(undef, '&1', $archiver, 'x', '-bd', '-y',
                          "-w$tempdir/parts", "-o$tempdir/parts/7zip", '--',
                          $fn, @list);
      collect_results($proc_fh,$pid,$archiver,16384,[0,1]);
      undef $proc_fh; undef $pid;
      my $errn = lstat("$tempdir/parts/7zip") ? 0 : 0+$!;
      if ($errn != ENOENT) {
        my $b = flatten_and_tidy_dir("$tempdir/parts/7zip",
                                     "$tempdir/parts", $part);
        consumed_bytes($b, 'do_7zip');
      }
    }
    1;
  } or do { $eval_stat = $@ ne '' ? $@ : "errno=$!" };
  prolong_timer('do_7zip');  # restart timer
  if (defined $eval_stat) {
    $retval = 0; chomp $eval_stat;
    kill_proc($pid,$archiver,1,$proc_fh,$eval_stat)  if defined $pid;
    undef $proc_fh; undef $pid;
  # if ($testing_for_sfx) { die "do_7zip: $eval_stat" }
  # else { do_log(-1, "do_7zip: %s", $eval_stat) };
    die "do_7zip: $eval_stat\n"  # propagate failure
  }
  $retval;
}

# use external program to expand RAR archives
#
sub do_unrar($$$;$) {
  my($part, $tempdir, $archiver, $testing_for_sfx) = @_;
  ll(4) && do_log(4, "Expanding RAR archive %s", $part->base_name);
  my $decompressor_name = basename((split(' ',$archiver))[0]);
  snmp_count("OpsDecBy\u${decompressor_name}Attempt");
  # unrar exit codes: SUCCESS=0, WARNING=1, FATAL_ERROR=2, CRC_ERROR=3,
  #   LOCK_ERROR=4, WRITE_ERROR=5, OPEN_ERROR=6, USER_ERROR=7, MEMORY_ERROR=8,
  #   CREATE_ERROR=9, USER_BREAK=255
  my(@list); my $hypcount = 0; my $encryptedcount = 0; my $encryptedmeta = 0;
  my $lcnt = 0; my $member_name; my $bytes = 0; my $last_line;
  my $item_num = 0; my $parent_placement = $part->mime_placement;
  my $retval = 1; my $fn = $part->full_name; my($proc_fh,$pid);
  my $unrarvers = 5;
  my(@common_rar_switches) = qw(-c- -p- -idcdp);  # -av-

  prolong_timer('do_unrar_pre');  # restart timer
  my $eval_stat;
  eval {
    ($proc_fh,$pid) =
      run_command(undef, '&1', $archiver, 'v',@common_rar_switches,'--',$fn);
    # jump hoops because there is no simple way to just list all the files
    my $ln; my $entries_cnt = 0;
    for ($! = 0; defined($ln=$proc_fh->getline); $! = 0) {
      $last_line = $ln  if $ln !~ /^\s*$/;  # keep last nonempty line
      chomp;
      if ($ln =~ /^unexpected end of archive/) {
        last;
      } elsif ($ln =~ /^------/) {
        $hypcount++;
        last  if $hypcount >= 2;
      } elsif ($hypcount < 1 &&
               $ln =~ /^Details: RAR [45], (?:SFX, )?encrypted headers/) {
        do_log(4,"do_unrar: %s", $ln);
        $part->attributes_add('U','C');
        $encryptedmeta = 1;
        last;
      } elsif ($hypcount < 1 && $ln =~ /^Encrypted file:/) {
        do_log(4,"do_unrar: %s", $ln);
        $part->attributes_add('U','C');
      } elsif ($hypcount < 1 &&
               $ln =~ /^\s+Size\s+Packed Ratio\s+Date\s+Time\s+Attr\s+CRC/) {
        do_log(5,"do_unrar: found unrar version < 5");
        $unrarvers = 4;
      } elsif ($hypcount == 1) {
        if ($unrarvers >= 5) {
          local($1,$2,$3,$4,$5);
          if ($entries_cnt++, $MAXFILES && $entries_cnt > $MAXFILES)
            { die "Maximum number of files ($MAXFILES) exceeded" }
          if ($ln !~ /^ ([* ]) \s* \S+ \s+ (\d+) \s+ (\d+) \s+
                      ( \d+ % | --> | <-- | <-> ) \s+
                      \S+ \s+ \S+ \s+ \S+ \s+ (.*)/xs) {
            do_log($testing_for_sfx ? 4 : -1,
                   "do_unrar: can't parse info line for \"%s\" %s",
                   $member_name,$ln);
          } else {
            $member_name = $5;
            if ($1 eq '*') {   # member is encrypted
              $encryptedcount++; $item_num++;
              # make a phantom entry - carrying only name and attributes
              my $newpart_obj =
                Amavis::Unpackers::Part->new("$tempdir/parts",$part);
              $newpart_obj->mime_placement("$parent_placement/$item_num");
              $newpart_obj->name_declared($member_name);
              $newpart_obj->attributes_add('U','C');
            } else {  # makes no sense extracting encrypted files
              do_log(5,'do_unrar: member: "%s", size: %s', $member_name,$2);
              if ($2 > 0) { $bytes += $2; push(@list, $member_name) }
            }
            undef $member_name;
          }
        } else {  # old version of unrar
          $lcnt++; local($1,$2,$3);
          if ($lcnt % 2 == 0) {  # information line (every other line)
            if ($entries_cnt++, $MAXFILES && $entries_cnt > $MAXFILES)
              { die "Maximum number of files ($MAXFILES) exceeded" }
            if ($ln !~ /^ \s+ (\d+) \s+ (\d+) \s+
                        ( \d+% | --> | <-- | <-> )/xs) {
              do_log($testing_for_sfx ? 4 : -1,
                     "do_unrar: can't parse info line for \"%s\" %s",
                     $member_name,$ln);
            } elsif (defined $member_name) {
              do_log(5,'do_unrar: member: "%s", size: %s', $member_name,$1);
              if ($1 > 0) { $bytes += $1; push(@list, $member_name) }
            }
            undef $member_name;
          } elsif ($ln =~ /^(.)(.*)\z/s) {
            $member_name = $2; # all but the first character (space or '*')
            if ($1 eq '*') {   # member is encrypted
              $encryptedcount++; $item_num++;
              # make a phantom entry - carrying only name and attributes
              my $newpart_obj =
                Amavis::Unpackers::Part->new("$tempdir/parts",$part);
              $newpart_obj->mime_placement("$parent_placement/$item_num");
              $newpart_obj->name_declared($member_name);
              $newpart_obj->attributes_add('U','C');
              undef $member_name;  # makes no sense extracting encrypted files
            }
          }
        }
      }
    }
    defined $ln || $! == 0 || $! == EAGAIN  or die "Error reading (1): $!";
    do_log(-1,"unexpected(unrar_1): %s",$!)  if !defined($ln) && $! == EAGAIN;
    $ln = undef;  # consume all remaining output to avoid broken pipe
    for ($! = 0; defined($ln=$proc_fh->getline); $! = 0)
      { $last_line = $ln  if $ln !~ /^\s*$/ }
    defined $ln || $! == 0 || $! == EAGAIN  or die "Error reading (2): $!";
    do_log(-1,"unexpected(unrar_2): %s",$!)  if !defined($ln) && $! == EAGAIN;
    my $err = 0; $proc_fh->close or $err = $!;
    my $rv = defined $pid && waitpid($pid,0) > 0 ? $? : undef;
    undef $proc_fh; undef $pid;  local($1,$2);
    if (proc_status_ok($rv,$err, 7)) {       # USER_ERROR
      die printf("perhaps this %s does not recognize switches ".
                 "-av- and -idcdp, it is probably too old. Upgrade: %s",
                 $archiver, 'http://www.rarlab.com/');
    } elsif (proc_status_ok($rv,$err, 3)) {  # CRC_ERROR
      # NOTE: password protected files in the archive cause CRC_ERROR
      do_log(4,"do_unrar: CRC_ERROR - undecipherable, %s",
               exit_status_str($rv,$err));
      $part->attributes_add('U');
    } elsif (proc_status_ok($rv,$err, 1) && @list && $bytes > 0) {
                                             # WARNING, probably still ok
      do_log(4,"do_unrar: warning, %s", exit_status_str($rv,$err));
    } elsif ($encryptedmeta == 1) {
      do_log(1,
             "do_unrar: %s, archive metadata is encrypted, archive retained",
             $part->base_name);
      $retval = 2;
    } elsif (!proc_status_ok($rv,$err)) {
      die("can't get a list of archive members: " .
          exit_status_str($rv,$err) ."; ".$last_line);
    } elsif (!$bytes && $last_line =~ /^\Q$fn\E is not RAR archive$/) {
      chomp($last_line);  die $last_line;
    } elsif ($last_line !~ /^\s*(\d+)\s+(\d+)/s) {
      do_log(-1,"do_unrar: unable to obtain orig total size: %s", $last_line);
    } else {
      do_log(4,"do_unrar: summary size: %d, sum of sizes: %d",
             $2,$bytes)  if abs($bytes - $2) > 100;
      $bytes = $2  if $2 > $bytes;
    }
    consumed_bytes($bytes, 'do_unrar-pre', 1);  # pre-check on estimated size
    if (!@list) {
      do_log(4,"do_unrar: no archive members, or not an archive at all");
      if ($testing_for_sfx) { return $encryptedmeta }
      else { $part->attributes_add('U') }
    } else {
      snmp_count("OpsDecBy\u${decompressor_name}");
      # unrar/rar can make a dir by itself, but can't hurt (sparc64 problem?)
      mkdir("$tempdir/parts/rar", 0750)
        or die "Can't mkdir $tempdir/parts/rar: $!";
      ($proc_fh,$pid) =
        run_command(undef, '&1', $archiver, qw(x -inul -ver -o- -kb),
                    @common_rar_switches, '--', $fn, "$tempdir/parts/rar/");
      collect_results($proc_fh,$pid,$archiver,16384,
                      [0,1,3] );  # one of: SUCCESS, WARNING, CRC
      undef $proc_fh; undef $pid;
      my $errn = lstat("$tempdir/parts/rar") ? 0 : 0+$!;
      if ($errn != ENOENT) {
        my $b = flatten_and_tidy_dir("$tempdir/parts/rar",
                                     "$tempdir/parts", $part);
        consumed_bytes($b, 'do_unrar');
      }
    }
    1;
  } or do { $eval_stat = $@ ne '' ? $@ : "errno=$!" };
  prolong_timer('do_unrar');  # restart timer
  if ($encryptedcount) {
    do_log(1,
      "do_unrar: %s, %d members are encrypted, %s extracted, archive retained",
      $part->base_name, $encryptedcount, !@list ? 'none' : scalar(@list) );
    $retval = 2;
  }
  if (defined $eval_stat) {
    $retval = 0; chomp $eval_stat;
    kill_proc($pid,$archiver,1,$proc_fh,$eval_stat)  if defined $pid;
    undef $proc_fh; undef $pid;
  # if ($testing_for_sfx) { die "do_unrar: $eval_stat" }
  # else { do_log(-1, "do_unrar: %s", $eval_stat) };
    die "do_unrar: $eval_stat\n"  # propagate failure
  }
  $retval;
}

# use external program to expand LHA archives
#
sub do_lha($$$;$) {
  my($part, $tempdir, $archiver, $testing_for_sfx) = @_;
  ll(4) && do_log(4, "Expanding LHA archive %s", $part->base_name);
  my $decompressor_name = basename((split(' ',$archiver))[0]);
  snmp_count("OpsDecBy\u${decompressor_name}Attempt");
  # lha needs extension .exe to understand SFX!
  # the downside is that in this case it only sees MS files in an archive
  my $fn = $part->full_name;
  symlink($fn, $fn.".exe")
    or die sprintf("Can't symlink %s %s.exe: %s", $fn, $fn, $!);
  my(@list); my(@checkerr); my $retval = 1; my($proc_fh,$pid);

  prolong_timer('do_lha_pre');  # restart timer
  my $eval_stat;
  eval {
  # ($proc_fh,$pid) = run_command(undef, '&1', $archiver, 'lq', $fn);
    ($proc_fh,$pid) = run_command(undef, '&1', $archiver, 'lq', $fn.".exe");
    my $ln; my $entries_cnt = 0;
    for ($! = 0; defined($ln=$proc_fh->getline); $! = 0) {
      chomp($ln); local($1);
      if ($entries_cnt++, $MAXFILES && $entries_cnt > $MAXFILES)
        { die "Maximum number of files ($MAXFILES) exceeded" }
      if ($ln =~ m{/\z}) {
        # ignore directories
      } elsif ($ln =~ /^LHa: (Warning|Fatal error): /) {
        push(@checkerr,$ln)  if @checkerr < 3;
      } elsif ($ln=~m{^(?:\S+\s+\d+/\d+|.{23})(?:\s+\S+){5}\s*(\S.*?)\s*\z}s) {
        my $name = $1; $name = $1 if $name =~ m{^(.*) -> (.*)\z}s;  # symlink
        push(@list, $name);
      } else { do_log(5,"do_lha: skip: %s", $ln) }
    }
    defined $ln || $! == 0 || $! == EAGAIN  or die "Error reading: $!";
    do_log(-1,"unexpected(do_lha): %s",$!)  if !defined($ln) && $! == EAGAIN;
    my $err = 0; $proc_fh->close or $err = $!;
    my $child_stat = defined $pid && waitpid($pid,0) > 0 ? $? : undef;
    undef $proc_fh; undef $pid;
    if (!proc_status_ok($child_stat,$err) || @checkerr) {
      die('(' . join(", ",@checkerr) .') ' .exit_status_str($child_stat,$err));
    } elsif (!@list) {
      $part->attributes_add('U')  if !$testing_for_sfx;
      die "no archive members, or not an archive at all";
    }
    1;
  } or do { $eval_stat = $@ ne '' ? $@ : "errno=$!" };
  prolong_timer('do_lha');  # restart timer
  if (defined $eval_stat) {
    unlink($fn.".exe") or do_log(-1, "Can't unlink %s.exe: %s", $fn,$!);
    $retval = 0; chomp $eval_stat;
    kill_proc($pid,$archiver,1,$proc_fh,$eval_stat)  if defined $pid;
    undef $proc_fh; undef $pid;
  # if ($testing_for_sfx) { die "do_lha: $eval_stat" }
  # else { do_log(-1, "do_lha: %s", $eval_stat) };
    die "do_lha: $eval_stat\n";  # propagate failure
  } else {  # preliminary archive traversal done, now extract files
    snmp_count("OpsDecBy\u${decompressor_name}");
    my $rv;
    eval {
      # store_mgr may die, make sure we unlink the .exe file
      $rv = store_mgr($tempdir, $part, \@list, $archiver, 'pq', $fn.".exe");
      1;
    } or do { $eval_stat = $@ ne '' ? $@ : "errno=$!" };
    unlink($fn.".exe") or do_log(-1, "Can't unlink %s.exe: %s", $fn,$!);
    if (defined $eval_stat) { die "do_lha: $eval_stat\n" } # propagate failure
    $rv==0  or die exit_status_str($rv);
  }
  $retval;
}

# use external program to expand ARC archives;
# works with original arc, or a GPL licensed 'nomarch'
# (http://rus.members.beeb.net/nomarch.html)
#
sub do_arc($$$) {
  my($part, $tempdir, $archiver) = @_;
  my $decompressor_name = basename((split(' ',$archiver))[0]);
  snmp_count("OpsDecBy\u${decompressor_name}");
  my $is_nomarch = $archiver =~ /nomarch/i;
  ll(4) && do_log(4,"Unarcing %s, using %s",
                    $part->base_name, ($is_nomarch ? "nomarch" : "arc") );
  my $cmdargs = ($is_nomarch ? '-l -U' : 'ln') . ' ' . $part->full_name;
  my($proc_fh,$pid) = run_command(undef, '/dev/null', $archiver,
                                  split(' ',$cmdargs));
  my(@list); my $ln; my $entries_cnt = 0;
  for ($! = 0; defined($ln=$proc_fh->getline); $! = 0) {
    if ($entries_cnt++, $MAXFILES && $entries_cnt > $MAXFILES)
      { die "Maximum number of files ($MAXFILES) exceeded" }
    push(@list,$ln);
  }
  defined $ln || $! == 0 || $! == EAGAIN  or die "Error reading: $!";
  do_log(-1,"unexpected(do_arc): %s",$!)  if !defined($ln) && $! == EAGAIN;
  my $err = 0; $proc_fh->close or $err = $!;
  my $child_stat = defined $pid && waitpid($pid,0) > 0 ? $? : undef;
  undef $proc_fh; undef $pid;
  proc_status_ok($child_stat,$err)
    or do_log(-1, 'do_arc: %s',exit_status_str($child_stat,$err));
  #*** no spaces in filenames allowed???
  local($1);  s/^([^ \t\r\n]*).*\z/$1/s for @list;  # keep only filenames
  if (@list) {
    # store_mgr may die, allow failure to propagate
    my $rv = store_mgr($tempdir, $part, \@list, $archiver,
                       ($is_nomarch ? ('-p', '-U') : 'p'), $part->full_name);
    do_log(-1, 'arc %', exit_status_str($rv))  if $rv;
  }
  1;
}

# use external program to expand ZOO archives
#
sub do_zoo($$$) {
  my($part, $tempdir, $archiver) = @_;
  my $is_unzoo = $archiver =~ m{\bunzoo[^/]*\z}i ? 1 : 0;
  ll(4) && do_log(4,"Expanding ZOO archive %s, using %s",
                    $part->base_name, ($is_unzoo ? "unzoo" : "zoo") );
  my $decompressor_name = basename((split(' ',$archiver))[0]);
  snmp_count("OpsDecBy\u${decompressor_name}");

  my(@list); my $separ_count = 0; my $bytes = 0; my($ln,$last_line);
  my $retval = 1; my $fn = $part->full_name; my($proc_fh,$pid);
  symlink($fn, "$fn.zoo")  # Zoo needs extension of .zoo!
    or die sprintf("Can't symlink %s %s.zoo: %s", $fn,$fn,$!);

  prolong_timer('do_zoo_pre');  # restart timer
  my $eval_stat; my $entries_cnt = 0;
  eval {
    ($proc_fh,$pid) = run_command(undef, '&1', $archiver,
                                  $is_unzoo ? qw(-l) : qw(l), "$fn.zoo");
    for ($! = 0; defined($ln=$proc_fh->getline); $! = 0) {
      $last_line = $ln  if $ln !~ /^\s*$/;  # keep last nonempty line
      if ($ln =~ /^------/) { $separ_count++ }
      elsif ($separ_count == 1) {
        local($1,$2);
        if ($entries_cnt++, $MAXFILES && $entries_cnt > $MAXFILES)
          { die "Maximum number of files ($MAXFILES) exceeded" }
        if ($ln !~ /^\s*(\d+)(?:\s+\S+){6}\s+(?:[0-7]{3,})?\s*(.*)$/) {
          do_log(3,"do_zoo: can't parse line %s", $ln);
        } else {
          do_log(5,'do_zoo: member: "%s", size: %s', $2,$1);
          if ($1 > 0) { $bytes += $1; push(@list,$2) }
        }
      }
    }
    defined $ln || $! == 0 || $! == EAGAIN  or die "Error reading: $!";
    do_log(-1,"unexpected(do_zoo): %s",$!)  if !defined($ln) && $! == EAGAIN;
    my $err = 0; $proc_fh->close or $err = $!;
    my $rv = defined $pid && waitpid($pid,0) > 0 ? $? : undef;
    undef $proc_fh; undef $pid;  local($1);
    if (!proc_status_ok($rv,$err)) {
      die("can't get a list of archive members: " .
          exit_status_str($rv,$err) ."; ".$last_line);
    } elsif ($last_line !~ /^\s*(\d+)\s+\d+%\s+\d+/s) {
      do_log(-1,"do_zoo: unable to obtain orig total size: %s", $last_line);
    } else {
      do_log(4,"do_zoo: summary size: %d, sum of sizes: %d",
             $1,$bytes)  if abs($bytes - $1) > 100;
      $bytes = $1  if $1 > $bytes;
    }
    consumed_bytes($bytes, 'do_zoo-pre', 1);  # pre-check on estimated size
    $retval = 0  if @list;
    if (!$is_unzoo) {
      # unzoo cannot cleanly extract to stdout without prepending a clutter
      # store_mgr may die
      my $rv = store_mgr($tempdir,$part,\@list,$archiver,'xpqqq:',"$fn.zoo");
      do_log(-1,"do_zoo (store_mgr) %s", exit_status_str($rv))  if $rv;
    } else {  # this code section can handle zoo and unzoo
      # but zoo is unsafe in this mode (and so is unzoo, a little less so)
      my $cwd = "$tempdir/parts/zoo";
      mkdir($cwd, 0750) or die "Can't mkdir $cwd: $!";
      chdir($cwd) or die "Can't chdir to $cwd: $!";
      # don't use "-j ./" in unzoo, it does not protect from relative paths!
      # "-j X" is less bad, but: "unzoo: 'X/h/user/01.lis' cannot be created"
      ($proc_fh,$pid) =
        run_command(undef, '&1', $archiver,
                    $is_unzoo ? qw(-x -j X) : qw(x),
                    "$fn.zoo",  $is_unzoo ? '*;*' : () );
      collect_results($proc_fh,$pid,$archiver,16384,[0]);
      undef $proc_fh; undef $pid;
      my $b = flatten_and_tidy_dir("$tempdir/parts/zoo",
                                   "$tempdir/parts", $part);
      consumed_bytes($b, 'do_zoo');
    }
    1;
  } or do { $eval_stat = $@ ne '' ? $@ : "errno=$!" };
  prolong_timer('do_zoo');  # restart timer
  if (defined $eval_stat) {
    $retval = 0; chomp $eval_stat;
    kill_proc($pid,$archiver,1,$proc_fh,$eval_stat)  if defined $pid;
    undef $proc_fh; undef $pid;
    do_log(-1,"do_zoo: %s", $eval_stat);
  }
  chdir($tempdir) or die "Can't chdir to $tempdir: $!";
  unlink("$fn.zoo") or die "Can't unlink $fn.zoo: $!";
  if (defined $eval_stat) { die "do_zoo: $eval_stat\n" }  # propagate failure
  $retval;
}

# use external program to expand ARJ archives
#
sub do_unarj($$$;$) {
  my($part, $tempdir, $archiver, $testing_for_sfx) = @_;
  do_log(4, "Expanding ARJ archive %s", $part->base_name);
  my $decompressor_name = basename((split(' ',$archiver))[0]);
  snmp_count("OpsDecBy\u${decompressor_name}Attempt");
  # options to arj, ignored by unarj
  # provide some password in -g to turn fatal error into 'bad password' error
  $ENV{ARJ_SW} = "-i -jo -b5 -2h -jyc -ja1 -gsecret -w$tempdir/parts";
  # unarj needs extension of .arj!
  my $fn = $part->full_name;
  symlink($part->full_name, $fn.".arj")
    or die sprintf("Can't symlink %s %s.arj: %s", $fn, $fn, $!);
  my $retval = 1; my($proc_fh,$pid);

  prolong_timer('do_unarj_pre');  # restart timer
  my $eval_stat;
  eval {
    # obtain total original size of archive members from the index/listing
    ($proc_fh,$pid) = run_command(undef, '&1', $archiver, 'l', $fn.".arj");
    my $last_line; my $ln;
    for ($! = 0; defined($ln=$proc_fh->getline); $! = 0)
      { $last_line = $ln  if $ln !~ /^\s*$/ }
    defined $ln || $! == 0 || $! == EAGAIN  or die "Error reading (1): $!";
    do_log(-1,"unexpected(do_unarj_1): %s",$!) if !defined($ln) && $! == EAGAIN;
    my $err = 0; $proc_fh->close or $err = $!;
    my $rv = defined $pid && waitpid($pid,0) > 0 ? $? : undef;
    undef $proc_fh; undef $pid;
    if (!proc_status_ok($rv,$err, 0,1,3)) {  # one of: success, warn, CRC err
      $part->attributes_add('U')  if !$testing_for_sfx;
      die "not an ARJ archive? ".exit_status_str($rv,$err);
    } elsif ($last_line =~ /^\Q$fn\E.arj is not an ARJ archive$/) {
      die "last line: $last_line";
    } elsif ($last_line !~ /^\s*(\d+)\s*files\s*(\d+)/s) {
      $part->attributes_add('U')  if !$testing_for_sfx;
      die "unable to obtain orig size of files: $last_line, ".
          exit_status_str($rv,$err);
    } else {
      consumed_bytes($2, 'do_unarj-pre', 1); # pre-check on estimated size
    }
    # unarj has very limited extraction options, arj is much better!
    mkdir("$tempdir/parts/arj",0750)
      or die "Can't mkdir $tempdir/parts/arj: $!";
    chdir("$tempdir/parts/arj")
      or die "Can't chdir to $tempdir/parts/arj: $!";
    snmp_count("OpsDecBy\u${decompressor_name}");
    ($proc_fh,$pid) = run_command(undef, '&1', $archiver, 'e', $fn.".arj");
    my($encryptedcount,$skippedcount,$entries_cnt) = (0,0,0);
    for ($! = 0; defined($ln=$proc_fh->getline); $! = 0) {
      if ($entries_cnt++, $MAXFILES && $entries_cnt > $MAXFILES)
        { die "Maximum number of files ($MAXFILES) exceeded" }
      $encryptedcount++
        if $ln =~ /^(Extracting.*\bBad file data or bad password|File is password encrypted, Skipped)\b/s;
      $skippedcount++
        if $ln =~ /(\bexists|^File is password encrypted|^Unsupported .*), Skipped\b/s;
    }
    defined $ln || $! == 0 || $! == EAGAIN  or die "Error reading (2): $!";
    do_log(-1,"unexpected(do_unarj_2): %s",$!) if !defined($ln) && $! == EAGAIN;
    $err = 0; $proc_fh->close or $err = $!;
    $rv = defined $pid && waitpid($pid,0) > 0 ? $? : undef;
    undef $proc_fh; undef $pid;
    chdir($tempdir) or die "Can't chdir to $tempdir: $!";
    if (proc_status_ok($rv,$err, 0,1)) {}  # success, warn
    elsif (proc_status_ok($rv,$err, 3))    # CRC err
      { $part->attributes_add('U')  if !$testing_for_sfx }
    else { do_log(0, "unarj: error extracting: %s",exit_status_str($rv,$err)) }
    # add attributes to the parent object, because we didn't remember names
    # of its scrambled members
    $part->attributes_add('U')  if $encryptedcount || $skippedcount;
    $part->attributes_add('C')  if $encryptedcount;
    my $errn = lstat("$tempdir/parts/arj") ? 0 : 0+$!;
    if ($errn != ENOENT) {
      my $b = flatten_and_tidy_dir("$tempdir/parts/arj",
                                   "$tempdir/parts",$part);
      consumed_bytes($b, 'do_unarj');
      snmp_count("OpsDecBy\u${decompressor_name}");
    }
    proc_status_ok($rv,$err, 0,1,3)  # one of: success, warn, CRC err
      or die "unarj: can't extract archive members: ".
             exit_status_str($rv,$err);
    if ($encryptedcount || $skippedcount) {
      do_log(1,
        "do_unarj: %s, %d members are encrypted, %d skipped, archive retained",
        $part->base_name, $encryptedcount, $skippedcount);
      $retval = 2;
    }
    1;
  } or do { $eval_stat = $@ ne '' ? $@ : "errno=$!" };
  prolong_timer('do_unarj');  # restart timer
  unlink($fn.".arj") or die "Can't unlink $fn.arj: $!";
  if (defined $eval_stat) {
    $retval = 0; chomp $eval_stat;
    kill_proc($pid,$archiver,1,$proc_fh,$eval_stat)  if defined $pid;
    undef $proc_fh; undef $pid;
  # if ($testing_for_sfx) { die "do_unarj: $eval_stat" }
  # else { do_log(-1, "do_unarj: %s", $eval_stat) };
    die "do_unarj: $eval_stat\n"  # propagate failure
  }
  $retval;
}

# use external program to expand TNEF archives
#
sub do_tnef_ext($$$) {
  my($part, $tempdir, $archiver) = @_;
  do_log(4, "Extracting from TNEF encapsulation (ext) %s", $part->base_name);
  my $archiver_name = basename((split(' ',$archiver))[0]);
  snmp_count("OpsDecBy\u${archiver_name}");
  mkdir("$tempdir/parts/tnef",0750)
    or die "Can't mkdir $tempdir/parts/tnef: $!";
  my $retval = 1; my($proc_fh,$pid);

  prolong_timer('do_tnef_ext_pre');  # restart timer
  my $rem_quota = max(10*1024, untaint(consumed_bytes(0,'do_tnef_ext')));
  my $eval_stat;
  eval {
    ($proc_fh,$pid) = run_command(undef, '&1', $archiver,
                          '--number-backups', '-x', "$rem_quota",
                          '-C', "$tempdir/parts/tnef", '-f', $part->full_name);
    collect_results($proc_fh,$pid,$archiver,16384,[0]);
    undef $proc_fh; undef $pid;  1;
  } or do { $eval_stat = $@ ne '' ? $@ : "errno=$!" };
  prolong_timer('do_tnef_ext');  # restart timer
  if (defined $eval_stat) {
    $retval = 0; chomp $eval_stat;
    do_log(-1, "tnef_ext: %s", $eval_stat);
  }
  my $b = flatten_and_tidy_dir("$tempdir/parts/tnef","$tempdir/parts",$part);
  if ($b > 0) {
    do_log(4, "tnef_ext extracted %d bytes from a tnef container", $b);
    consumed_bytes($b, 'do_tnef_ext');
  }
  if (defined $eval_stat) { die "do_tnef_ext: $eval_stat\n" }  # propagate
  $retval;
}

# use Convert-TNEF
#
use vars qw($have_tnef_module);
sub do_tnef($$) {
  my($part, $tempdir) = @_;
  do_log(4, "Extracting from TNEF encapsulation (int) %s", $part->base_name);
  if (!defined $have_tnef_module) {
    eval {
      require Convert::TNEF && ($have_tnef_module = 1);
    } or do {
      $have_tnef_module = 0;
      chomp $@;  $@ =~ s/ \(you may need to install the .*\z//i;
      do_log(5,"module Convert::TNEF unavailable: %s", $@);
    };
  }
  return 0 if !$have_tnef_module;
  snmp_count('OpsDecByTnef');

  my $tnef = Convert::TNEF->read_in($part->full_name,
       {output_dir=>"$tempdir/parts", buffer_size=>16384, ignore_checksum=>1});
  defined $tnef or die "Convert::TNEF failed: ".$Convert::TNEF::errstr;
  my $item_num = 0; my $parent_placement = $part->mime_placement;
  for my $a ($tnef->message, $tnef->attachments) {
    for my $attr_name ('AttachData','Attachment') {
      my $dh = $a->datahandle($attr_name);
      if (defined $dh) {
        my $newpart_obj = Amavis::Unpackers::Part->new("$tempdir/parts",$part);
        $item_num++;
        $newpart_obj->mime_placement("$parent_placement/$item_num");
        $newpart_obj->name_declared([$a->name, $a->longname]);
        my $newpart = $newpart_obj->full_name;
        my $outpart = IO::File->new;
        # O_WRONLY etc. can become tainted in Perl5.8.9 [perlbug #62502]
        $outpart->open($newpart, untaint(O_CREAT|O_EXCL|O_WRONLY), 0640)
          or die "Can't create file $newpart: $!";
        binmode($outpart) or die "Can't set file $newpart to binmode: $!";
        my $filepath = $dh->path; my $size = 0;
        if (defined $filepath) {
          my($io,$nbytes,$buff); $dh->binmode(1);
          $io = $dh->open("r") or die "Can't open MIME::Body handle: $!";
          while (($nbytes=$io->read($buff,16384)) > 0) {
            $outpart->print($buff) or die "Can't write to $newpart: $!";
            $size += $nbytes; consumed_bytes($nbytes, 'do_tnef_1');
          }
          defined $nbytes or die "Error reading from MIME::Body handle: $!";
          $io->close or die "Error closing MIME::Body handle: $!";
          undef $buff;  # release storage
        } else {
          my $buff = $dh->as_string; my $nbytes = length($buff);
          $outpart->print($buff) or die "Can't write to $newpart: $!";
          $size += $nbytes; consumed_bytes($nbytes, 'do_tnef_2');
        }
        $newpart_obj->size($size);
        $outpart->close or die "Error closing $newpart: $!";
      }
    }
  }
  $tnef->purge  if defined $tnef;
  1;
}

# The pax and cpio utilities usually support the following archive formats:
#   cpio, bcpio, sv4cpio, sv4crc, tar (old tar), ustar (POSIX.2 tar).
# The utilities from http://heirloom.sourceforge.net/ support
# several other tar/cpio variants such as SCO, Sun, DEC, Cray, SGI
#
sub do_pax_cpio($$$) {
  my($part, $tempdir, $archiver) = @_;
  my $archiver_name = basename((split(' ',$archiver))[0]);
  snmp_count("OpsDecBy\u${archiver_name}");
  ll(4) && do_log(4,"Expanding archive %s, using %s",
                    $part->base_name,$archiver_name);
  my $is_pax = $archiver_name =~ /^cpio/i ? 0 : 1;
  do_log(-1,"WARN: Using %s instead of pax can be a security ".
            "risk; please add:  \$pax='pax';  to amavisd.conf and check that ".
            "the pax(1) utility is available on the system!",
            $archiver_name)  if !$is_pax;
  my(@cmdargs) = $is_pax ? qw(-v) : qw(-i -t -v);
  my($proc_fh,$pid) = run_command($part->full_name, '/dev/null',
                                  $archiver, @cmdargs);
  my $bytes = 0; local($1,$2); local($_); my $entries_cnt = 0;
  for ($! = 0; defined($_=$proc_fh->getline); $! = 0) {
    chomp;
    next  if /^\d+ blocks\z/;
    last  if /^(cpio|pax): (.*bytes read|End of archive volume)/;
    if ($entries_cnt++, $MAXFILES && $entries_cnt > $MAXFILES)
      { die "Maximum number of files ($MAXFILES) exceeded" }
    if (!/^ (?: \S+\s+ ){4} (\d+) \s+ (.+) \z/xs) {
      do_log(-1,"do_pax_cpio: can't parse toc line: %s", $_);
    } else {
      my($size,$mem) = ($1,$2);
      if ($mem =~ /^( (?: \s* \S+ ){3} (?: \s+ \d{4}, )? ) \s+ (.+)\z/xs) {
        $mem = $2;  # strip away time and date
      } elsif ($mem =~ /^\S \s+ (.+)\z/xs) {
        # -rwxr-xr-x  1 1121  users 3135 C errorReport.sh
        $mem = $1;  # strip away a letter in place of a date (?)
      }
      $mem = $1 if $is_pax && $mem =~ /^(.*) =[=>] (.*)\z/; # hard or soft link
      do_log(5,'do_pax_cpio: size: %5s, member: "%s"', $size,$mem);
      $bytes += $size  if $size > 0;
    }
  }
  defined $_ || $! == 0 || $! == EAGAIN  or die "Error reading (1): $!";
  do_log(-1,"unexpected(pax_cpio_1): %s",$!)  if !defined($_) && $! == EAGAIN;
  # consume remaining output to avoid broken pipe
  collect_results($proc_fh,$pid,'do_pax_cpio/1',16384,[0]);
  undef $proc_fh; undef $pid;
  consumed_bytes($bytes, 'do_pax_cpio/pre', 1);  # pre-check on estimated size
  mkdir("$tempdir/parts/arch", 0750)
    or die "Can't mkdir $tempdir/parts/arch: $!";
  my $name_clash = 0;
  my(%orig_names);  # maps filenames to archive member names when possible

  prolong_timer('do_pax_cpio_pre');  # restart timer
  my $eval_stat;
  eval {
    chdir("$tempdir/parts/arch")
      or die "Can't chdir to $tempdir/parts/arch: $!";
    my(@cmdargs) = $is_pax ? qw(-r -k -p am -s /[^A-Za-z0-9_]/-/gp)
                       : qw(-i -d --no-absolute-filenames --no-preserve-owner);
    ($proc_fh,$pid) = run_command($part->full_name, '&1', $archiver, @cmdargs);
    my $output = ''; my $ln; my $entries_cnt = 0;
    for ($! = 0; defined($ln=$proc_fh->getline); $! = 0) {
      chomp($ln);
      if ($entries_cnt++, $MAXFILES && $entries_cnt > $MAXFILES)
        { die "Maximum number of files ($MAXFILES) exceeded" }
      if (!$is_pax || $ln !~ /^(.*) >> (\S*)\z/) { $output .= $ln."\n" }
      else {  # parse output from pax -s///p
        my($member_name,$file_name) = ($1,$2);
        if (!exists $orig_names{$file_name}) {
          $orig_names{$file_name} = $member_name;
        } else {
          do_log(0,'do_pax_cpio: member "%s" is hidden by a '.
                   'previous archive member "%s", file: %s',
                   $member_name, $orig_names{$file_name}, $file_name);
          undef $orig_names{$file_name};  # cause it to exist but undefined
          $name_clash = 1;
        }
      }
    }
    defined $ln || $! == 0 || $! == EAGAIN  or die "Error reading (2): $!";
    do_log(-1,"unexpected(pax_cpio_2): %s",$!) if !defined($ln) && $! == EAGAIN;
    my $err = 0; $proc_fh->close or $err = $!;
    my $child_stat = defined $pid && waitpid($pid,0) > 0 ? $? : undef;
    undef $proc_fh; undef $pid; chomp($output);
    proc_status_ok($child_stat,$err)
      or die(exit_status_str($child_stat,$err).' '.$output);
    1;
  } or do { $eval_stat = $@ ne '' ? $@ : "errno=$!" };
  prolong_timer('do_pax_cpio');  # restart timer
  chdir($tempdir) or die "Can't chdir to $tempdir: $!";
  my $b = flatten_and_tidy_dir("$tempdir/parts/arch", "$tempdir/parts",
                               $part, 0, \%orig_names);
  consumed_bytes($b, 'do_pax_cpio');
  if (defined $eval_stat) {
    chomp $eval_stat;
    kill_proc($pid,$archiver,1,$proc_fh,$eval_stat)  if defined $pid;
    undef $proc_fh; undef $pid;
    die "do_pax_cpio: $eval_stat\n";  # propagate failure
  }
  $name_clash ? 2 : 1;
}

# command line unpacker from stuffit.com for Linux
# decodes Macintosh StuffIt archives and others
# (but it appears the Linux version is buggy and a security risk, not to use!)
#
sub do_unstuff($$$) {
  my($part, $tempdir, $archiver) = @_;
  my $archiver_name = basename((split(' ',$archiver))[0]);
  snmp_count("OpsDecBy\u${archiver_name}");
  do_log(4,"Expanding archive %s, using %s", $part->base_name,$archiver_name);
  mkdir("$tempdir/parts/unstuff", 0750)
    or die "Can't mkdir $tempdir/parts/unstuff: $!";
  my($proc_fh,$pid) = run_command(undef, '&1', $archiver,  # '-q',
                               "-d=$tempdir/parts/unstuff", $part->full_name);
  collect_results($proc_fh,$pid,$archiver,16384,[0]);
  undef $proc_fh; undef $pid;
  my $b = flatten_and_tidy_dir("$tempdir/parts/unstuff",
                               "$tempdir/parts", $part);
  consumed_bytes($b, 'do_unstuff');
  1;
}

# ar is a standard Unix binary archiver, also used by Debian packages
#
sub do_ar($$$) {
  my($part, $tempdir, $archiver) = @_;
  ll(4) && do_log(4,"Expanding Unix ar archive %s", $part->full_name);
  my $archiver_name = basename((split(' ',$archiver))[0]);
  snmp_count("OpsDecBy\u${archiver_name}");
  my($proc_fh,$pid) = run_command(undef, '/dev/null',
                                  $archiver, 'tv', $part->full_name);
  my $ln; my $bytes = 0; local($1,$2,$3); my $entries_cnt = 0;
  for ($! = 0; defined($ln=$proc_fh->getline); $! = 0) {
    chomp($ln);
    if ($entries_cnt++, $MAXFILES && $entries_cnt > $MAXFILES)
      { die "Maximum number of files ($MAXFILES) exceeded" }
    if ($ln !~ /^(?:\S+\s+){2}(\d+)\s+((?:\S+\s+){3}\S+)\s+(.*)\z/) {
      do_log(-1,"do_ar: can't parse contents listing line: %s", $ln);
    } else {
      do_log(5,"do_ar: member: \"%s\", size: %s", $3,$1);
      $bytes += $1  if $1 > 0;
    }
  }
  defined $ln || $! == 0 || $! == EAGAIN  or die "Error reading: $!";
  do_log(-1,"unexpected(do_ar): %s",$!)  if !defined($ln) && $! == EAGAIN;
  # consume remaining output to avoid broken pipe
  collect_results($proc_fh,$pid,'ar-1',16384,[0]);
  undef $proc_fh; undef $pid;
  consumed_bytes($bytes, 'do_ar-pre', 1);  # pre-check on estimated size
  mkdir("$tempdir/parts/ar", 0750)
    or die "Can't mkdir $tempdir/parts/ar: $!";
  chdir("$tempdir/parts/ar") or die "Can't chdir to $tempdir/parts/ar: $!";
  ($proc_fh,$pid) = run_command(undef, '&1', $archiver, 'x', $part->full_name);
  collect_results($proc_fh,$pid,'ar-2',16384,[0]);
  undef $proc_fh; undef $pid;
  chdir($tempdir) or die "Can't chdir to $tempdir: $!";
  my $b = flatten_and_tidy_dir("$tempdir/parts/ar","$tempdir/parts",$part);
  consumed_bytes($b, 'do_ar');
  1;
}

sub do_cabextract($$$) {
  my($part, $tempdir, $archiver) = @_;
  do_log(4, "Expanding cab archive %s", $part->base_name);
  my $archiver_name = basename((split(' ',$archiver))[0]);
  snmp_count("OpsDecBy\u${archiver_name}");
  my($proc_fh,$pid) =
    run_command(undef, '/dev/null', $archiver, '-l', $part->full_name);
  local($1,$2); my $bytes = 0; my $ln; my $entries_cnt = 0;
  for ($! = 0; defined($ln=$proc_fh->getline); $! = 0) {
    chomp($ln);
    next  if $ln =~ /^(?: ?File size|----|Viewing cabinet:|\z)/s;
    next  if $ln =~ /^\s*All done, no errors/s;
    if ($entries_cnt++, $MAXFILES && $entries_cnt > $MAXFILES)
      { die "Maximum number of files ($MAXFILES) exceeded" }
    if ($ln !~ /^\s* (\d+) \s* \| [^|]* \| \s (.*) \z/x) {
      do_log(-1, "do_cabextract: can't parse toc line: %s", $ln);
    } else {
      do_log(5, 'do_cabextract: member: "%s", size: %s', $2,$1);
      $bytes += $1  if $1 > 0;
    }
  }
  defined $ln || $! == 0 || $! == EAGAIN  or die "Error reading: $!";
  do_log(-1,"unexpected(cabextract): %s",$!)  if !defined($ln) && $! == EAGAIN;
  # consume remaining output to avoid broken pipe (just in case)
  collect_results($proc_fh,$pid,'cabextract-1',16384,[0]);
  undef $proc_fh; undef $pid;
  mkdir("$tempdir/parts/cab",0750) or die "Can't mkdir $tempdir/parts/cab: $!";
  ($proc_fh,$pid) = run_command(undef, '/dev/null', $archiver, '-q', '-d',
                                "$tempdir/parts/cab", $part->full_name);
  collect_results($proc_fh,$pid,'cabextract-2',16384,[0]);
  undef $proc_fh; undef $pid;
  my $b = flatten_and_tidy_dir("$tempdir/parts/cab", "$tempdir/parts", $part);
  consumed_bytes($b, 'do_cabextract');
  1;
}

sub do_ole($$$) {
  my($part, $tempdir, $archiver) = @_;
  do_log(4,"Expanding MS OLE document %s", $part->base_name);
  my $archiver_name = basename((split(' ',$archiver))[0]);
  snmp_count("OpsDecBy\u${archiver_name}");
  mkdir("$tempdir/parts/ole",0750) or die "Can't mkdir $tempdir/parts/ole: $!";
  my($proc_fh,$pid) = run_command(undef, '&1', $archiver, '-v',
                            '-i', $part->full_name, '-d',"$tempdir/parts/ole");
  # Not all Microsoft documents contain embedded objects, and we won't know
  # until we look. The ripOLE program knows how to check if we do in fact
  # have an OLE document; but it exits with code 102 if we don't. This isn't
  # really an error, so we add "102" to the list of successful exit codes.
  collect_results($proc_fh,$pid,$archiver,16384,[0,102]);
  undef $proc_fh; undef $pid;
  my $b = flatten_and_tidy_dir("$tempdir/parts/ole", "$tempdir/parts", $part);
  if ($b > 0) {
    do_log(4, "ripOLE extracted %d bytes from an OLE document", $b);
    consumed_bytes($b, 'do_ole');
  }
  2;  # always keep the original OLE document
}

# Check for self-extracting archives.  Note that we do not depend on
# file magic here since it's not reliable.  Instead we will try each
# archiver.
#
sub do_executable($$@) {
  my($part, $tempdir, $unrar, $lha, $unarj) = @_;

  ll(4) && do_log(4,"Check whether %s is a self-extracting archive",
                    $part->base_name);
# # ZIP?
# return 2  if eval { do_unzip($part,$tempdir,undef,1) };
# chomp $@;
# do_log(3, "do_executable: not a ZIP sfx, ignoring: %s", $@)  if $@ ne '';

  # RAR?
  return 2  if defined $unrar && eval { do_unrar($part,$tempdir,$unrar,1) };
  chomp $@;
  do_log(3, "do_executable: not a RAR sfx, ignoring: %s", $@)  if $@ ne '';

# # LHA?  not safe, tends to crash
# return 2  if defined $lha && eval { do_lha($part,$tempdir,$lha,1) };
# chomp $@;
# do_log(3, "do_executable: not an LHA sfx, ignoring: %s", $@)  if $@ ne '';

  # ARJ?
  return 2  if defined $unarj && eval { do_unarj($part,$tempdir,$unarj,1) };
  chomp $@;
  do_log(3, "do_executable: not an ARJ sfx, ignoring: %s", $@)  if $@ ne '';

  0;
}

# my($k,$v,$fn);
# while (($k,$v) = each(%::)) {
#   local(*e)=$v; $fn=fileno(\*e);
#   printf STDOUT ("%-10s %-10s %s\n",$k,$v,$fn)  if defined $fn;
# }

# Given a file handle (typically opened pipe to a subprocess, as returned
# by run_command), copy from it to a specified output file in binary mode.
#
sub run_command_copy($$$) {
  my($outfile, $ifh, $pid) = @_;
  my $ofh = IO::File->new;
  # O_WRONLY etc. can become tainted in Perl5.8.9 [perlbug #62502]
  $ofh->open($outfile, untaint(O_CREAT|O_EXCL|O_WRONLY), 0640)  # calls sysopen
    or die "Can't create file $outfile: $!";
  binmode($ofh) or die "Can't set file $outfile to binmode: $!";
  binmode($ifh) or die "Can't set binmode on pipe: $!";
  my($eval_stat, $rv, $rerr); $rerr = 0;
  eval {
    my($nread, $nwrite, $tosend, $offset, $inbuf);
    for (;;) {
      $nread = sysread($ifh, $inbuf, 65536);
      if (!defined($nread)) {
        if ($! == EAGAIN || $! == EINTR) {
          Time::HiRes::sleep(0.1);  # just in case
        } else {
          die "Error reading: $!";
        }
      } elsif ($nread < 1) {  # sysread returns 0 at eof
        last;
      } else {
        consumed_bytes($nread, 'run_command_copy');
        $tosend = $nread; $offset = 0;
        while ($tosend > 0) {  # handle partial writes
          $nwrite = syswrite($ofh, $inbuf, $tosend, $offset);
          if (!defined($nwrite)) {
            if ($! == EAGAIN || $! == EINTR) {
              Time::HiRes::sleep(0.1);  # just in case
            } else {
              die "Error writing to $outfile: $!";
            }
          } elsif ($nwrite < 1) {
            Time::HiRes::sleep(0.1);  # just in case
          } else {
            $tosend -= $nwrite; $offset += $nwrite;
          }
        }
      }
    }
    $ifh->close or $rerr = $!;
    $rv = defined $pid && waitpid($pid,0) > 0 ? $? : undef;
    $ofh->close or die "Error closing $outfile: $!";
    1;
  } or do {
    $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
    # remember error, close socket ignoring status
    $rerr = $!; $ifh->close;
    $rv = defined $pid && waitpid($pid,0) > 0 ? $? : undef;
    do_log(-1, "run_command_copy: %s", $eval_stat);
    $ofh->close  or do_log(-1, "Error closing %s: %s", $outfile,$!);
  };
  if (defined $eval_stat) { die "run_ccpy: $eval_stat\n" }  # propagate failure
  ($rv,$rerr);  # return subprocess termination status and reading/close errno
}

# extract listed files from archive and store each in a new file
#
sub store_mgr($$$@) {
  my($tempdir, $parent_obj, $list, $archiver, @args) = @_;
  my $item_num = 0; my $parent_placement = $parent_obj->mime_placement;
  my $retval = 0; my($proc_fh,$pid);
  prolong_timer('store_mgr_pre');  # restart timer
  my $eval_stat;
  eval {
    for my $f (@$list) {
      next  if $f =~ m{/\z};  # ignore directories
      my $newpart_obj =
        Amavis::Unpackers::Part->new("$tempdir/parts",$parent_obj);
      $item_num++; $newpart_obj->mime_placement("$parent_placement/$item_num");
      $newpart_obj->name_declared($f);  # store tainted name
      my $newpart = $newpart_obj->full_name;
      ll(5) && do_log(5,'store_mgr: extracting "%s" to file %s using %s',
                        $f, $newpart, $archiver);
      if ($f =~ m{^\.?[A-Za-z0-9_][A-Za-z0-9/._=~-]*\z}) { #presumably safe arg
      } else {  # this is not too bad, as run_command does not use shell
        do_log(1, 'store_mgr: NOTICE: suspicious file name "%s"', $f);
      }
      ($proc_fh,$pid) = run_command(undef, '/dev/null',
                                    $archiver, @args, untaint($f));
      my($rv,$err) = run_command_copy($newpart,$proc_fh,$pid);  # may die
      my $ll = proc_status_ok($rv,$err) ? 5 : 1;
      ll($ll) && do_log($ll,"store_mgr: extracted by %s, %s",
                            $archiver, exit_status_str($rv,$err));
      $retval = $rv  if $retval == 0 && $rv != 0;
    }
    1;
  } or do { $eval_stat = $@ ne '' ? $@ : "errno=$!" };
  prolong_timer('store_mgr');  # restart timer
  if (defined $eval_stat) {
    $retval = 0; chomp $eval_stat;
    kill_proc($pid,$archiver,1,$proc_fh,$eval_stat)  if defined $pid;
    undef $proc_fh; undef $pid;
    die "store_mgr: $eval_stat\n";  # propagate failure
  }
  $retval;  # return the first nonzero status (if any), or 0
}
1;
