Introduce EXIM_BUILD_SUFFIX for src/Makefile and testsuite
[exim.git] / test / lib / Exim / Runtest.pm
CommitLineData
1f187290 1package Exim::Runtest;
87e93574 2use 5.010;
1f187290
HSHR
3use strict;
4use warnings;
b369d470 5use IO::Socket::INET;
fefe59d9 6use Cwd;
1f187290
HSHR
7use Carp;
8
87e93574 9use parent 'Exporter';
fefe59d9 10our @EXPORT_OK = qw(mailgroup dynamic_socket exim_binary);
87e93574
HSHR
11our %EXPORT_TAGS = (
12 all => \@EXPORT_OK,
13);
14
1f187290
HSHR
15use List::Util qw'shuffle';
16
10012250
HSHR
17=head1 NAME
18
19Exim::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
28The B<Exim::Runtest> module provides some simple functions
29for the F<runtest> script. No functions are exported yet.
30
31=cut
1f187290 32
1f187290 33sub mailgroup {
b1227303 34 my $group = shift // croak "Need a default group name.";
1f187290
HSHR
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];
b369d470
HSHR
46}
47
48sub 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}
1f187290 60
fefe59d9
HSHR
61sub 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
1f187290 1081;
10012250
HSHR
109
110__END__
111
112=head1 FUNCTIONS
113
114=over
115
116=item B<mailgroup>(I<$default>)
117
118Check if the mailgroup I<$default> exists. Return the checked
119group name or some other random but existing group.
120
121=item B<dynamic_socket>()
122
123Return a dynamically allocated listener socket in the range
124between 1024 and 65534;
125
fefe59d9
HSHR
126=item ($binary, @argv) = B<exim_binary>(I<@argv>)
127
128Find the Exim binary. Consider the first element of I<@argv>
129and remove it from I<@argv>, if it is an executable binary.
130Otherwise search the binary (while honouring C<EXIM_BUILD_SUFFIX>,
131C<../scripts/os-type> and C<../os-arch>) and return the
132the path to the binary and the unmodified I<@argv>.
133
10012250
HSHR
134=back
135
136=cut