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 Carp;
   7
   8 use parent 'Exporter';
   9 our @EXPORT_OK = qw(mailgroup dynamic_socket);
  10 our %EXPORT_TAGS = (
  11     all => \@EXPORT_OK,
  12 );
  13
  14 use List::Util qw'shuffle';
  15
  16 =head1 NAME
  17
  18 Exim::Runtest - helper functions for the runtest script
  19
  20 =head1 SYNOPSIS
  21
  22  use Exim::Runtest;
  23  my $foo = Exim::Runtest::foo('foo');
  24
  25 =head1 DESCRIPTION
  26
  27 The B<Exim::Runtest> module provides some simple functions
  28 for the F<runtest> script. No functions are exported yet.
  29
  30 =cut
  31
  32 sub mailgroup {
  33     my $group = shift // croak "Need a default group name.";
  34
  35     croak "Need a group *name*, not a numeric group id."
  36         if $group =~ /^\d+$/;
  37
  38     return $group if getgrnam $group;
  39
  40     my @groups;
  41     setgrent or die "setgrent: $!\n";
  42     push @groups, $_ while defined($_ = getgrent);
  43     endgrent;
  44     return (shuffle @groups)[0];
  45 }
  46
  47 sub dynamic_socket {
  48     my $socket;
  49     for (my $port = 1024; $port < 65000; $port++) {
  50         $socket = IO::Socket::INET->new(
  51             LocalHost => '127.0.0.1',
  52             LocalPort => $port,
  53             Listen => 10,
  54             ReuseAddr => 1,
  55         ) and return $socket;
  56     }
  57     croak 'Can not allocate a free port.';
  58 }
  59
  60 1;
  61
  62 __END__
  63
  64 =head1 FUNCTIONS
  65
  66 =over
  67
  68 =item B<mailgroup>(I<$default>)
  69
  70 Check if the mailgroup I<$default> exists. Return the checked
  71 group name or some other random but existing group.
  72
  73 =item B<dynamic_socket>()
  74
  75 Return a dynamically allocated listener socket in the range
  76 between 1024 and 65534;
  77
  78 =back
  79
  80 =cut