# SATest with unused functions removed
# remove all references to spamc and spamd
# removed unused end block and untaint_cmd function
# remove read_config and a bit more
# remove call to tempdir, put it in the test
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
            $SKIP_SETUID_NOBODY_TESTS $SKIP_DNSBL_TESTS
            $have_inet4 $have_inet6
            $workdir $siterules $localrules $userrules $userstate
            $keep_workdir $mainpid);
my $sa_code_dir;
BEGIN {
  require Exporter;
  use vars qw(@ISA @EXPORT @EXPORT_OK);
  @ISA = qw(Exporter);
  @EXPORT = qw($have_inet4 $have_inet6);
  $RUNNING_ON_WINDOWS = ($^O =~ /^(mswin|dos|os2)/oi);
  $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";
  $salearn = $ENV{'SALEARN_SCRIPT'};
  $salearn ||= "$perl_cmd ../sa-learn.raw";
  $saawl = $ENV{'SAAWL_SCRIPT'};
  $saawl ||= "$perl_cmd ../sa-awl";
  (-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);
    }
  }
  ##########
  ### Test return here but keep some code that comes after to be compiled
  return if $tname;
  # 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
  $keep_workdir = 0;
  # $siterules contains all stock *.pre files
  $siterules = "$workdir/siterules";
  # $localrules contains all stock *.cf files
  $localrules = "$workdir/localrules";
  # $userrules contains user rules
  $userrules = "$workdir/user.cf";
  # user_state directory
  $userstate = "$workdir/user_state";
  mkdir($siterules) or die "FATAL: failed to create $siterules\n";
  mkdir($localrules) or die "FATAL: failed to create $localrules\n";
  open(OUT, ">$userrules") or die "FATAL: failed to create $userrules\n";
  close(OUT);
  mkdir($userstate) or die "FATAL: failed to create $userstate\n";
  $scr_localrules_args =   " --siteconfigpath $siterules";
  $salearn_localrules_args =   " --siteconfigpath $siterules";
  $scr_cf_args = "-C $localrules";
  $scr_pref_args = "-p $userrules";
  $salearn_cf_args = "-C $localrules";
  $salearn_pref_args = "-p $userrules";
  $scr_test_args = "";
  $salearn_test_args = "";
  $set_user_prefs = 0;
  $default_cf_lines = "
    bayes_path ./$userstate/bayes
    auto_welcomelist_path ./$userstate/auto-welcomelist
  ";
#  read_config();
  # if running as root, ensure "nobody" can write to it too
  if ($> == 0) {
    $tmp_dir_mode = 0777;
    umask 022;  # ensure correct permissions on files and dirs created here
    # Bug 5529 initial fix: For now don't run a test as root if it has a problem resuting from setuid nobody
    # FIXME: Eventually we can actually test setuid nobody and accessing ./log to make this test more fine grained
    #  and we can create an accessible temp dir that some of the tests can use. But for now just skip those tests.
    $SKIP_SETUID_NOBODY_TESTS = 1;
  } else {
    $tmp_dir_mode = 0755;
  }
  for $tainted (<../rules/*.pm>, <../rules/*.pre>, <../rules/languages>) {
    $tainted =~ /(.*)/;
    my $file = $1;
    $base = basename $file;
    copy ($file, "$siterules/$base")
      or warn "cannot copy $file to $siterules/$base: $!";
  }
  for $tainted (<../rules/*.cf>) {
    $tainted =~ /(.*)/;
    my $file = $1;
    $base = basename $file;
    copy ($file, "$localrules/$base")
      or warn "cannot copy $file to $localrules/$base: $!";
  }
  # copy ("data/01_test_rules.pre", "$localrules/01_test_rules.pre")
  #   or warn "cannot copy data/01_test_rules.cf to $localrules/01_test_rules.pre: $!";
  # copy ("data/01_test_rules.cf", "$localrules/01_test_rules.cf")
  #   or warn "cannot copy data/01_test_rules.cf to $localrules/01_test_rules.cf: $!";
  # open (PREFS, ">>$localrules/99_test_default.cf")
  #   or die "cannot append to $localrules/99_test_default.cf: $!";
  # print PREFS $default_cf_lines
  #   or die "error writing to $localrules/99_test_default.cf: $!";
  # close PREFS
  #   or die "error closing $localrules/99_test_default.cf: $!";
  # $home = $ENV{'HOME'};
  # $home ||= $ENV{'WINDIR'} if (defined $ENV{'WINDIR'});
  # $cwd = getcwd;
  # $ENV{'TEST_DIR'} = $cwd;
  # $testname = $tname;
}
# sub read_config {
#   return if defined($already_read_config);
#   $already_read_config = 1;
#   # allow reading config from top-level dir, outside the test suite;
#   # this is so read_config() will work even when called from
#   # a "use constant" line at compile time.
#   my $prefix = '';
#   if (-f 't/test_dir') { $prefix = "t/"; }
#   if (!open (CF, "<${prefix}config")) {
#     if (!open (CF, "<${prefix}config.dist")) {   # fall back to defaults
#       die "cannot open test suite configuration file 'config.dist': $!";
#     }
#   }
#   while (<CF>) {
#     s/#.*$//; s/^\s+//; s/\s+$//; next if /^$/;
#     /^([^=]+)=(.*)$/ or next;
#     $conf{$1} = $2;
#   }
#   # allow our xt test suite to override
#   if (defined $ARGV[0] && $ARGV[0] eq '--override') {
#     shift @ARGV;
#     my $k = shift @ARGV;
#     my $v = shift @ARGV;
#     # Override only allows setting one variable.  Some xt tests need to set more
#     # config variables.  Adding : as a delimiter for config variable and value 
#     # parameters
#     @k = split (/:/,$k);
#     @v = split (/:/,$v);
#     if (scalar(@k) != scalar(@v)) {
#       print "Error: The number of override arguments for variables and values did not match\n!";
#       exit;
#     } else {
#       print "\nProcessing Overrides:\n\n";
#     }
#     for (my $i = 0; $i < scalar(@k); $i++) {
#       $conf{$k[$i]} = $v[$i];
#       print "Overriding $k[$i] with value $v[$i]\n";
#     }
#   }
#   close CF;
# }
# Simple version of untaint_var for internal use
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);
}
1;