"Fossies" - the Fresh Open Source Software Archive

Member "memcached-1.6.15/t/issue_67.t" (16 Jul 2020, 2953 Bytes) of package /linux/www/memcached-1.6.15.tar.gz:

    1 #!/usr/bin/perl
    2 
    3 use strict;
    4 use Test::More tests => 24;
    5 use FindBin qw($Bin);
    6 use lib "$Bin/lib";
    7 use MemcachedTest;
    8 use Carp qw(croak);
    9 use Socket qw(sockaddr_in INADDR_ANY PF_INET SOCK_STREAM);
   10 
   11 use Cwd;
   12 my $builddir = getcwd;
   13 
   14 $ENV{'MEMCACHED_PORT_FILENAME'} = "/tmp/ports.$$";
   15 
   16 sub read_ports {
   17     my %rv = ();
   18     open(my $f, "/tmp/ports.$$") || die("Can't open ports file.");
   19     while(<$f>) {
   20         my ($type, $port) = split(/:\s+/);
   21         $rv{$type} = $port + 0;
   22     }
   23     unlink "/tmp/ports.$$";
   24     return %rv;
   25 }
   26 
   27 sub validate_port {
   28     my ($name, $got, $expected) = @_;
   29     # diag "Wanted $expected, got $got";
   30     if ($expected == -1) {
   31         ok(!defined($got), "$name expected no port, got $got");
   32     } elsif ($expected == 0) {
   33         ok(defined($got) && $got != 11211, "$name expected random port (got $got)");
   34     } else {
   35         is($got, $expected, "$name");
   36     }
   37 }
   38 
   39 sub skip_if_default_addr_in_use(&) {
   40     my ($block) = @_;
   41 
   42     socket(my $socket, PF_INET, SOCK_STREAM, 0) or die $!;
   43     my $addr_in_use = !bind($socket, sockaddr_in(11211, INADDR_ANY));
   44     close($socket);
   45 
   46     SKIP: {
   47         skip 'Default address is in use. Do you have a running instance?', 2 if $addr_in_use;
   48         return $block->();
   49     }
   50 }
   51 
   52 sub run_server {
   53     my ($args) = @_;
   54 
   55     my $exe = "$builddir/memcached-debug";
   56     croak("memcached binary doesn't exist.  Haven't run 'make' ?\n") unless -e $exe;
   57 
   58     my $childpid = fork();
   59 
   60     my $root = '';
   61     $root = "-u root" if ($< == 0);
   62 
   63     # test build requires more privileges
   64     $args .= " -o relaxed_privileges";
   65 
   66     my $cmd = "$builddir/timedrun 10 $exe $root $args";
   67 
   68     unless($childpid) {
   69         exec $cmd;
   70         exit; # NOTREACHED
   71     }
   72 
   73     for (1..20) {
   74         if (-f "/tmp/ports.$$") {
   75             return Memcached::Handle->new(pid  => $childpid);
   76         }
   77         select undef, undef, undef, 0.10;
   78     }
   79     croak "Failed to start server.";
   80 }
   81 
   82 sub when {
   83     my ($name, $params, $expected_tcp, $expected_udp) = @_;
   84 
   85     my $server = run_server($params);
   86     my %ports = read_ports();
   87 
   88     validate_port($name, $ports{'TCP INET'}, $expected_tcp);
   89     validate_port($name, $ports{'UDP INET'}, $expected_udp);
   90 }
   91 
   92 skip_if_default_addr_in_use { when('no arguments', '', 11211, -1) };
   93 when('specifying tcp port', '-p 11212', 11212, -1);
   94 when('specifying udp port', '-U 11222', 11222, 11222);
   95 when('specifying tcp ephemeral port', '-p -1', 0, -1);
   96 when('specifying udp ephemeral port', '-U -1', 0, 0);
   97 when('tcp port disabled', '-p 0', -1, -1);
   98 skip_if_default_addr_in_use { when('udp port disabled', '-U 0', 11211, -1) };
   99 when('specifying tcp and udp ports', '-p 11232 -U 11233', 11232, 11233);
  100 when('specifying tcp and disabling udp', '-p 11242 -U 0', 11242, -1);
  101 when('specifying udp and disabling tcp', '-p -1 -U 11252', 0, 11252);
  102 when('specifying tcp and ephemeral udp', '-p 11262 -U -1', 11262, 0);
  103 when('specifying udp and ephemeral tcp', '-p -1 -U 11272', 0, 11272);