"Fossies" - the Fresh Open Source Software Archive

Member "memcached-1.6.15/t/stats-conns.t" (21 Feb 2022, 2419 Bytes) of package /linux/www/memcached-1.6.15.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 #!/usr/bin/perl
    2 
    3 use strict;
    4 use Test::More;
    5 use FindBin qw($Bin);
    6 use lib "$Bin/lib";
    7 use MemcachedTest;
    8 
    9 ## First make sure we report UNIX-domain sockets correctly
   10 if (supports_unix_socket()) {
   11     plan tests => 12;
   12 
   13     my $filename = "/tmp/memcachetest$$";
   14 
   15     my $server = new_memcached("-s $filename");
   16     my $sock = $server->sock;
   17     my $stats_sock = $server->new_sock;
   18 
   19     ok(-S $filename, "creating unix domain socket $filename");
   20 
   21     print $sock "set foo 0 0 6\r\n";
   22     sleep(1);    # so we can test secs_since_last_cmd is nonzero
   23     print $stats_sock "stats conns\r\n";
   24 
   25     my $stats;
   26     while (<$stats_sock>) {
   27         last if /^(\.|END)/;
   28         $stats .= $_;
   29     }
   30 
   31     like($stats, qr/STAT \d+:addr /);
   32     $stats =~ m/STAT (\d+):addr unix:(.*[^\r\n])/g;
   33     my $listen_fd = $1;
   34     my $socket_path = $2;
   35     # getsockname(2) doesn't return socket path on GNU/Hurd (and maybe others)
   36     SKIP: {
   37         skip "socket path checking on GNU kernel", 1 if ($^O eq 'gnu');
   38         is($socket_path, $filename, "unix domain socket path reported correctly");
   39     };
   40     $stats =~ m/STAT (\d+):state conn_listening\r\n/g;
   41     is($1, $listen_fd, "listen socket fd reported correctly");
   42 
   43     like($stats, qr/STAT \d+:state conn_nread/,
   44          "one client is sending data");
   45     like($stats, qr/STAT \d+:state conn_parse_cmd/,
   46          "one client is in command processing");
   47     like($stats, qr/STAT \d+:secs_since_last_cmd [1-9]\r/,
   48          "nonzero secs_since_last_cmd");
   49     like($stats, qr/STAT \d+:listen_addr unix:\/tmp\/memcachetest\d+\r/,
   50          "found listen_addr for the UNIX-domain socket");
   51 
   52     $server->stop;
   53     unlink($filename);
   54 } else {
   55     plan tests => 4;
   56 }
   57 
   58 ## Now look at TCP
   59 
   60 my $server = new_memcached("-l 0.0.0.0");
   61 my $sock = $server->sock;
   62 my $stats_sock = $server->new_sock;
   63 
   64 print $sock "set foo 0 0 6\r\n";
   65 print $stats_sock "stats conns\r\n";
   66 
   67 my $stats = '';
   68 while (<$stats_sock>) {
   69     last if /^(\.|END)/;
   70     $stats .= $_;
   71 }
   72 
   73 like($stats, qr/STAT \d+:state conn_listen/, "there is a listen socket");
   74 $stats =~ m/STAT \d+:addr udp:0.0.0.0:(\d+)/;
   75 is($1, $server->udpport, "udp port number is correct");
   76 $stats =~ m/STAT \d+:addr tcp:0.0.0.0:(\d+)/;
   77 print STDERR "PORT: ", $server->port, "\n";
   78 is($1, $server->port, "tcp port number is correct");
   79 
   80 $stats =~ m/STAT \d+:listen_addr tcp:0.0.0.0:(\d+)/;
   81 is($1, $server->port, "listen_addr is correct for the tcp port");