test/lib/Exim/Runtest.pm

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