test/lib/Exim/Runtest.pm

   1 package Exim::Runtest;
   2 use 5.010;
   3 use strict;
   4 use warnings;
   5 use IO::Socket::INET;
   6 use Cwd;
   7 use Carp;
   8
   9 use parent 'Exporter';
  10 our @EXPORT_OK = qw(mailgroup dynamic_socket exim_binary);
  11 our %EXPORT_TAGS = (
  12     all => \@EXPORT_OK,
  13 );
  14
  15 use List::Util qw'shuffle';
  16
  17 =head1 NAME
  18
  19 Exim::Runtest - helper functions for the runtest script
  20
  21 =head1 SYNOPSIS
  22
  23  use Exim::Runtest;
  24  my $foo = Exim::Runtest::foo('foo');
  25
  26 =head1 DESCRIPTION
  27
  28 The B<Exim::Runtest> module provides some simple functions
  29 for the F<runtest> script. No functions are exported yet.
  30
  31 =cut
  32
  33 sub mailgroup {
  34     my $group = shift // croak "Need a default group name.";
  35
  36     croak "Need a group *name*, not a numeric group id."
  37         if $group =~ /^\d+$/;
  38
  39     return $group if getgrnam $group;
  40
  41     my @groups;
  42     setgrent or die "setgrent: $!\n";
  43     push @groups, $_ while defined($_ = getgrent);
  44     endgrent;
  45     return (shuffle @groups)[0];
  46 }
  47
  48 sub dynamic_socket {
  49     my $socket;
  50     for (my $port = 1024; $port < 65000; $port++) {
  51         $socket = IO::Socket::INET->new(
  52             LocalHost => '127.0.0.1',
  53             LocalPort => $port,
  54             Listen => 10,
  55             ReuseAddr => 1,
  56         ) and return $socket;
  57     }
  58     croak 'Can not allocate a free port.';
  59 }
  60
  61 sub exim_binary {
  62
  63     # two simple cases, absolute path or relative path and executable
  64     return @_ if $_[0] =~ /^\//;
  65     return Cwd::abs_path(shift), @_ if -x $_[0];
  66
  67     # so we're still here, if the simple approach didn't help.
  68
  69     # if there is '../exim-snapshot/<build-dir>/exim', use this
  70     # if there is '../exim4/<build-dir>/exim', use this
  71     # if there is '../exim-*.*/<build-dir>/exim', use the one with the highest version
  72     #   4.84 < 4.85RC1 < 4.85RC2 < 4.85 < 4.86RC1 < … < 4.86
  73     # if there is '../src/<build-dir>', use this
  74     #
  75
  76     my $prefix = '..';  # was intended for testing.
  77
  78     # get a list of directories having the "scripts/{os,arch}-type"
  79     # scripts
  80     my @candidates = grep { -x "$_/scripts/os-type" and -x "$_/scripts/arch-type" }
  81         "$prefix/exim-snapshot", "$prefix/exim4", # highest priority
  82         (reverse sort {                           # list of exim-*.* directories
  83         # split version number from RC number
  84         my @a = ($a =~ /(\d+\.\d+)(?:RC(\d+))?/);
  85         my @b = ($b =~ /(\d+\.\d+)(?:RC(\d+))?/);
  86         # if the versions are not equal, we're fine,
  87         # but otherwise we've to compare the RC number, where an
  88         # empty RC number is better than a non-empty
  89         ($a[0] cmp $b[0]) || (defined $a[1] ? defined $b[1] ? $a[1] cmp $b[1] : -1 : 1)
  90         } glob "$prefix/exim-*.*"),
  91         "$prefix/src";                       # the "normal" source
  92
  93     # binaries should be found now depending on the os-type and
  94     # arch-type in the directories we got above
  95     my @binaries = grep { -x }
  96         map { ("$_/exim", "$_/exim4") }
  97         map {
  98             my $os = `$_/scripts/os-type`;
  99             my $arch = `$_/scripts/arch-type`;
 100             chomp($os, $arch);
 101             "$_/build-$os-$arch" . ($ENV{EXIM_BUILD_SUFFIX} ? ".$ENV{EXIM_BUILD_SUFFIX}" : '');
 102         } @candidates;
 103
 104     return $binaries[0], @_;
 105 }
 106
 107
 108 1;
 109
 110 __END__
 111
 112 =head1 FUNCTIONS
 113
 114 =over
 115
 116 =item B<mailgroup>(I<$default>)
 117
 118 Check if the mailgroup I<$default> exists. Return the checked
 119 group name or some other random but existing group.
 120
 121 =item B<dynamic_socket>()
 122
 123 Return a dynamically allocated listener socket in the range
 124 between 1024 and 65534;
 125
 126 =item ($binary, @argv) = B<exim_binary>(I<@argv>)
 127
 128 Find the Exim binary. Consider the first element of I<@argv>
 129 and remove it from I<@argv>, if it is an executable binary.
 130 Otherwise search the binary (while honouring C<EXIM_BUILD_SUFFIX>,
 131 C<../scripts/os-type> and C<../os-arch>) and return the
 132 the path to the binary and the unmodified I<@argv>.
 133
 134 =back
 135
 136 =cut