view release on metacpan or  search on metacpan

t/SATest.pm  view on Meta::CPAN

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

  $NO_SPAMC_EXE = $TEST_DOES_NOT_RUN_SPAMC_OR_D ||
                  ($RUNNING_ON_WINDOWS &&
                   !$ENV{'SPAMC_SCRIPT'} &&
                   !(-e "../spamc/spamc.exe"));
  $SKIP_SPAMC_TESTS = ($NO_SPAMC_EXE ||
                     ($RUNNING_ON_WINDOWS && !$ENV{'SPAMD_HOST'})); 
  $SSL_AVAILABLE = (!$TEST_DOES_NOT_RUN_SPAMC_OR_D) &&
                  (!$SKIP_SPAMC_TESTS) &&  # no SSL test if no spamc
                  (!$SKIP_SPAMD_TESTS) &&  # or if no local spamd
                  (untaint_cmd("$spamc -V") =~ /with SSL support/) &&
                  (untaint_cmd("$spamd --version") =~ /with SSL support/);

  for (<../rules/*.pm>, <../rules/*.pre>, <../rules/languages>) {
    my $file = untaint_var($_);
    $base = basename $file;
    copy ($file, "$siterules/$base")
      or warn "cannot copy $file to $siterules/$base: $!";
  }

  for (<../rules/*.cf>) {
    my $file = untaint_var($_);
    $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;

  $spamd_run_as_user = ($RUNNING_ON_WINDOWS || ($> == 0)) ? "nobody" : (getpwuid($>))[0] ;
}

# remove all rules - $localrules/*.cf
# when you want to only use rules declared inside a specific *.t
sub clear_localrules {
  for (<$localrules/*.cf>) {
    my $file = untaint_var($_);
    # Keep some useful, should not contain any rules
    next if $file =~ /10_default_prefs.cf$/;
    next if $file =~ /20_aux_tlds.cf$/;
    # Keep our own tstprefs() or tstlocalrules()
    next if $file =~ /99_test_prefs.cf$/;
    next if $file =~ /99_test_rules.cf$/;
    unlink $file;
  }
}

# a port number between 40000 and 65520; used to allow multiple test
# suite runs on the same machine simultaneously
sub probably_unused_spamd_port {
  return 0 if $SKIP_SPAMD_TESTS;

  my $port;
  my @nstat;
  if (!open(NSTAT, "netstat -a -n 2>&1 |")) {
    # not too bad if failing on some architecture, with some luck should be alright
  } else {
    @nstat = grep(/^\s*tcp/i, <NSTAT>);
    close(NSTAT);
  }
  for (1..20) {
    $port = 40000 + int(rand(65500-40000));
    last unless (getservbyport($port, "tcp") || grep(/[:.]$port\s/, @nstat));
  }
  return $port;
}

sub locate_command {
  my ($command) = @_;

  my @path = File::Spec->path();
  push(@path, '/usr/bin') if ! grep { m@/usr/bin/?$@ } @path;
  for my $path (@path) {
    $location = "$path/$command";
    $location =~ s@//@/@g;
    return $location if -x $location;
  }
  return 0;
}

sub sa_t_finish {
  # no-op currently
}

sub tstfile {
  my $file = shift;
  open (OUT, ">$workdir/mail.txt") or die;
  print OUT $file; close OUT;
}