# Like SATest but ends after tempdir call that fails anyway on machines of interest
# removed unused subs but kept everything that came before the tempdir call even if not used later
package main;
require v5.14.0;
# use strict;
# use warnings;
# use re 'taint';
use Cwd;
use Config;
use File::Basename;
use File::Copy;
use File::Path;
use File::Spec;
use File::Temp qw(tempdir);
use Test::Builder ();
use Test::More    ();
use POSIX qw(WIFEXITED WIFSIGNALED WIFSTOPPED WEXITSTATUS WTERMSIG WSTOPSIG);
use vars qw($RUNNING_ON_WINDOWS $SSL_AVAILABLE
            $SKIP_SPAMD_TESTS $SKIP_SPAMC_TESTS $NO_SPAMC_EXE
            $SKIP_SETUID_NOBODY_TESTS $SKIP_DNSBL_TESTS
            $have_inet4 $have_inet6 $spamdhost $spamdport
            $workdir $siterules $localrules $userrules $userstate
            $keep_workdir $mainpid $spamd_pidfile);
my $sa_code_dir;
BEGIN {
  require Exporter;
  use vars qw(@ISA @EXPORT @EXPORT_OK);
  @ISA = qw(Exporter);
  @EXPORT = qw($have_inet4 $have_inet6 $spamdhost $spamdport);
  # No spamd test in Windows unless env override says user figured out a way
  # If you want to know why these are vars and no constants, read this thread:
  #   <http://www.mail-archive.com/dev%40perl.apache.org/msg05466.html>
  #  -- mss, 2004-01-13
  $RUNNING_ON_WINDOWS = ($^O =~ /^(mswin|dos|os2)/oi);
  $SKIP_SPAMD_TESTS =
        $RUNNING_ON_WINDOWS ||
        ( $ENV{'SPAMD_HOST'} && !($ENV{'SPAMD_HOST'} eq '127.0.0.1' ||
                                  $ENV{'SPAMD_HOST'} eq '::1' ||
                                  $ENV{'SPAMD_HOST'} eq 'localhost') );
  $SKIP_SETUID_NOBODY_TESTS = 0;
  $SKIP_DNSBL_TESTS = 0;
  $have_inet4 = eval {
    require IO::Socket::INET;
    my $sock = IO::Socket::INET->new(LocalAddr => '127.0.0.1', Proto => 'udp');
    $sock->close or die "error closing inet socket: $!"  if $sock;
    $sock ? 1 : undef;
  };
  $have_inet6 = eval {
    require IO::Socket::INET6;
    my $sock = IO::Socket::INET6->new(LocalAddr => '::1', Proto => 'udp');
    $sock->close or die "error closing inet6 socket: $!"  if $sock;
    $sock ? 1 : undef;
  };
  # Clean PATH so taint doesn't complain
  if (!$RUNNING_ON_WINDOWS) {
    $ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';
    # Remove tainted envs, at least ENV used in FreeBSD
    delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
  } else {
    # Windows might need non-system directories in PATH to run a Perl installation
    # The best we can do is clean out obviously bad stuff such as relative paths or \..\
    my @pathdirs = split(';', $ENV{'PATH'});
    $ENV{'PATH'} =
      join(';', # filter for only dirs that are canonical absolute paths that exist
        map {
              my $pathdir = $_;
              $pathdir =~ s/\\*\z//;
              my $abspathdir = File::Spec->canonpath(Cwd::realpath($pathdir)) if (-d $pathdir);
              if (defined $abspathdir) {
                $abspathdir  =~ /^(.*)\z/s;
                $abspathdir = $1; # untaint it
              }
              ((defined $abspathdir) and (lc $pathdir eq lc $abspathdir))?($abspathdir):()
            }
          @pathdirs);
  }
   
  # Fix INC to point to absolute path of built SA
  if (-e 't/test_dir') { $sa_code_dir = 'blib/lib'; }
  elsif (-e 'test_dir') { $sa_code_dir = '../blib/lib'; }
  else { die "FATAL: not in or below test directory?\n"; }
  File::Spec->rel2abs($sa_code_dir) =~ /^(.*)\z/s;
  $sa_code_dir = $1;
  if (not -d $sa_code_dir) {
    die "FATAL: not in expected directory relative to built code tree?\n";
  }
}
# use is run at compile time, but after the variable has been computed in the BEGIN block
use lib $sa_code_dir;
# Set up for testing. Exports (as global vars):
# out: $home: $HOME env variable
# out: $cwd: here
# out: $scr: spamassassin script
# in: if --override appears at start of command line, next 2 args are used to set
# an environment variable to control test behaviour.
#
sub sa_t_init {
  my $tname = shift;
  $mainpid = $$;
  if ($config{PERL_PATH}) {
    $perl_path = $config{PERL_PATH};
  }
  elsif ($^X =~ m|^/|) {
    $perl_path = $^X;
  }
  else {
    $perl_path = $Config{perlpath};
    $perl_path =~ s|/[^/]*$|/$^X|;
  }
  $perl_cmd  = $perl_path;
  # propagate $PERL5OPT; seems to be necessary, at least for the common idiom of
  # "PERL5OPT=-MFoo::Bar ./test.t"
  if ($ENV{'PERL5OPT'}) {
    my $o = $ENV{'PERL5OPT'};
    if ($o =~ /(Devel::Cover)/) {
      warn "# setting TEST_PERL_TAINT=no to avoid lack of taint-safety in $1\n";
      $ENV{'TEST_PERL_TAINT'} = 'no';
    }
    $perl_cmd .= " \"$o\"";
  }
  $perl_cmd .= " -T" if !defined($ENV{'TEST_PERL_TAINT'}) or $ENV{'TEST_PERL_TAINT'} ne 'no';
  $perl_cmd .= " -w" if !defined($ENV{'TEST_PERL_WARN'})  or $ENV{'TEST_PERL_WARN'}  ne 'no';
  # Copy directories in PERL5LIB into -I options in perl_cmd because -T suppresses use of PERL5LIB in call to ./spamassassin
  # If PERL5LIB is empty copy @INC instead because on some platforms like FreeBSD MakeMaker clears PER5LIB and sets @INC
  # Filter out relative paths, and canonicalize so no symlinks or /../ will be left in untainted result as a nod to security
  # Since this is only used to run tests, the security considerations are not as strict as with more general situations.
  my @pathdirs = @INC;
  if ($ENV{'PERL5LIB'}) {
    @pathdirs = split($Config{path_sep}, $ENV{'PERL5LIB'});
  }
  my $inc_opts =
    join(' -I', # filter for only dirs that are absolute paths that exist, then canonicalize them
      map {
            my $pathdir = $_;
            my $canonpathdir = File::Spec->canonpath(Cwd::realpath($pathdir)) if ((-d $pathdir) and File::Spec->file_name_is_absolute($pathdir));
            if (defined $canonpathdir) {
               $canonpathdir =~ /^(.*)\z/s;
               $canonpathdir = $1; # untaint it
            }
            ((defined $canonpathdir))?($canonpathdir):()
          }
         @pathdirs);
  $perl_cmd .= " -I$inc_opts" if ($inc_opts);
   
  # To work in Windows, the perl scripts have to be launched by $perl_cmd and
  # the ones that are exe files have to be directly called in the command lines
   
  $scr = $ENV{'SPAMASSASSIN_SCRIPT'};
  $scr ||= "$perl_cmd ../spamassassin.raw";
  $spamd = $ENV{'SPAMD_SCRIPT'};
  $spamd ||= "$perl_cmd ../spamd/spamd.raw";
  $spamc = $ENV{'SPAMC_SCRIPT'};
  $spamc ||= "../spamc/spamc";
  $salearn = $ENV{'SALEARN_SCRIPT'};
  $salearn ||= "$perl_cmd ../sa-learn.raw";
  $saawl = $ENV{'SAAWL_SCRIPT'};
  $saawl ||= "$perl_cmd ../sa-awl";
  $sacheckspamd = $ENV{'SACHECKSPAMD_SCRIPT'};
  $sacheckspamd ||= "$perl_cmd ../sa-check_spamd";
  $spamdlocalhost = $ENV{'SPAMD_LOCALHOST'};
  if (!$spamdlocalhost) {
    $spamdlocalhost = $have_inet4 || !$have_inet6 ? '127.0.0.1' : '::1';
  }
  $spamdhost = $ENV{'SPAMD_HOST'};
  $spamdhost ||= $spamdlocalhost;
  # optimisation -- don't setup spamd test parameters unless we're
  # not skipping all spamd tests and this particular test is called
  # called "spamd_something" or "spamc_foo"
  # We still run spamc tests when there is an external SPAMD_HOST, but don't have to set up the spamd parameters for it
  if ($tname !~ /spam[cd]/) {
    $TEST_DOES_NOT_RUN_SPAMC_OR_D = 1;
  } else {
    $spamdport = $ENV{'SPAMD_PORT'};
  }
  (-f "t/test_dir") && chdir("t");        # run from ..
  -f "test_dir"  or die "FATAL: not in test directory?\n";
  mkdir ("log", 0755);
  -d "log" or die "FATAL: failed to create log dir\n";
  chmod (0755, "log"); # set in case log already exists with wrong permissions
  if (!$RUNNING_ON_WINDOWS) {
    untaint_system("chacl -B log 2>/dev/null || setfacl -b log 2>/dev/null"); # remove acls that confuse test
  }
  # clean old workdir if sa_t_init called multiple times
  if (defined $workdir) {
    if (!$keep_workdir) {
      rmtree($workdir);
    }
  }
  # individual work directory to make parallel tests possible
  $workdir = tempdir("$tname.XXXXXX", DIR => "log");
  die "FATAL: failed to create workdir: $!" unless -d $workdir;
  chmod (0755, $workdir); # sometimes tempdir() ignores umask
}
sub untaint_var {
    local($1);
    $_[0] =~ /^(.*)\z/s;
    return $1;
}
# untainted system()
sub untaint_system {
    my @args;
    push @args, untaint_var($_) foreach (@_);
    return system(@args);
}
END {
  # Cleanup workdir (but not if inside forked process)
  if (defined $workdir && !$keep_workdir && $$ == $mainpid) {
    rmtree($workdir);
  }
}
1;