X-Git-Url: https://vcs.fsf.org/?p=exim.git;a=blobdiff_plain;f=test%2Flib%2FExim%2FRuntest.pm;h=bdf9c60d6bcb544baf2d2a51113d62a56e081ef7;hp=845388b8b268cb172e17b0582ebd7fa3d97dad03;hb=6336058cedeecb91a64ed69143b8b5221d08e16c;hpb=b1227303735a346c79fd0734c9efb5d13609ad55 diff --git a/test/lib/Exim/Runtest.pm b/test/lib/Exim/Runtest.pm index 845388b8b..bdf9c60d6 100644 --- a/test/lib/Exim/Runtest.pm +++ b/test/lib/Exim/Runtest.pm @@ -1,9 +1,18 @@ package Exim::Runtest; +use 5.010; use strict; use warnings; +use File::Basename; use IO::Socket::INET; +use Cwd; use Carp; +use parent 'Exporter'; +our @EXPORT_OK = qw(mailgroup dynamic_socket exim_binary flavour flavours); +our %EXPORT_TAGS = ( + all => \@EXPORT_OK, +); + use List::Util qw'shuffle'; =head1 NAME @@ -50,6 +59,83 @@ sub dynamic_socket { croak 'Can not allocate a free port.'; } +sub exim_binary { + + # two simple cases, absolute path or relative path and executable + return @_ if $_[0] =~ /^\//; + return Cwd::abs_path(shift), @_ if -x $_[0]; + + # so we're still here, if the simple approach didn't help. + + # if there is '../exim-snapshot//exim', use this + # if there is '../exim4//exim', use this + # if there is '../exim-*.*//exim', use the one with the highest version + # 4.84 < 4.85RC1 < 4.85RC2 < 4.85 < 4.86RC1 < … < 4.86 + # if there is '../src/', use this + # + + my $prefix = '..'; # was intended for testing. + + # get a list of directories having the "scripts/{os,arch}-type" + # scripts + my @candidates = grep { -x "$_/scripts/os-type" and -x "$_/scripts/arch-type" } + "$prefix/exim-snapshot", "$prefix/exim4", # highest priority + (reverse sort { # list of exim-*.* directories + # split version number from RC number + my @a = ($a =~ /(\d+\.\d+)(?:RC(\d+))?/); + my @b = ($b =~ /(\d+\.\d+)(?:RC(\d+))?/); + # if the versions are not equal, we're fine, + # but otherwise we've to compare the RC number, where an + # empty RC number is better than a non-empty + ($a[0] cmp $b[0]) || (defined $a[1] ? defined $b[1] ? $a[1] cmp $b[1] : -1 : 1) + } glob "$prefix/exim-*.*"), + "$prefix/src"; # the "normal" source + + # binaries should be found now depending on the os-type and + # arch-type in the directories we got above + my @binaries = grep { -x } + map { ("$_/exim", "$_/exim4") } + map { + my $os = `$_/scripts/os-type`; + my $arch = `$_/scripts/arch-type`; + chomp($os, $arch); + "$_/build-$os-$arch" . ($ENV{EXIM_BUILD_SUFFIX} ? ".$ENV{EXIM_BUILD_SUFFIX}" : ''); + } @candidates; + + return $binaries[0], @_; +} + +sub flavour { + my $etc = '/etc'; + + if (@_) { + croak "do not pass a directory, it's for testing only" + unless $ENV{HARNESS_ACTIVE}; + $etc = shift; + } + + if (open(my $f, '<', "$etc/os-release")) { + local $_ = join '', <$f>; + my ($id) = /^ID="?(.*?)"?\s*$/m; + my ($version) = /^VERSION_ID="?(.*?)"?\s*$/m; + return "$id$version"; + } + + if (open(my $f, '<', "$etc/debian_version")) { + chomp(local $_ = <$f>); + $_ = int $_; + return "debian$_"; + } + + undef; +} + +sub flavours { + my %h = map { /\.(\S+)$/, 1 } + glob('stdout/*.*'), glob('stderr/*.*'); + return sort keys %h; +} + 1; __END__ @@ -68,6 +154,24 @@ group name or some other random but existing group. Return a dynamically allocated listener socket in the range between 1024 and 65534; +=item ($binary, @argv) = B(I<@argv>) + +Find the Exim binary. Consider the first element of I<@argv> +and remove it from I<@argv>, if it is an executable binary. +Otherwise search the binary (while honouring C, +C<../scripts/os-type> and C<../os-arch>) and return the +the path to the binary and the unmodified I<@argv>. + +=item B() + +Find a hint for the current flavour (Linux distro). It does so by checking +typical files in the F directory. + +=item B() + +Return a list of available flavours. It does so by scanning F and +F for I files (extensions after the numerical prefix. + =back =cut