"Fossies" - the Fresh Open Source Software Archive

Member "memcached-1.6.15/t/watcher.t" (21 Feb 2022, 7681 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. See also the last Fossies "Diffs" side-by-side code changes report for "watcher.t": 1.6.13_vs_1.6.14.

    1 #!/usr/bin/perl
    2 # Networked logging tests.
    3 
    4 use strict;
    5 use warnings;
    6 use Socket qw/SO_RCVBUF/;
    7 
    8 use Test::More tests => 30;
    9 use FindBin qw($Bin);
   10 use lib "$Bin/lib";
   11 use MemcachedTest;
   12 
   13 my $server = new_memcached('-m 60 -o watcher_logbuf_size=8');
   14 my $client = $server->sock;
   15 my $watcher = $server->new_sock;
   16 
   17 # This doesn't return anything.
   18 print $watcher "watch\n";
   19 my $res = <$watcher>;
   20 is($res, "OK\r\n", "watcher enabled");
   21 
   22 print $client "get foo\n";
   23 $res = <$client>;
   24 is($res, "END\r\n", "basic get works");
   25 my $spacer = "X"x180;
   26 
   27 # This is a flaky test... depends on buffer sizes. Could either have memc
   28 # shrink the watcher buffer, or loop this and keep doubling until we get some
   29 # skipped values.
   30 for (1 .. 80000) {
   31     print $client "get foo$_$spacer\n";
   32     $res = <$client>;
   33 }
   34 
   35 # Let the logger thread catch up before we start reading.
   36 sleep 1;
   37 my $do_fetch = 0;
   38 #print STDERR "RESULT: $res\n";
   39 while (my $log = <$watcher>) {
   40     # The "skipped" line won't actually print until some space frees up in the
   41     # buffer, so we need to occasionally cause new lines to generate.
   42     if (($do_fetch++ % 100) == 0) {
   43          print $client "get foo\n";
   44          $res = <$client>;
   45     }
   46     next unless $log =~ m/skipped/;
   47     like($log, qr/skipped=/, "skipped some lines");
   48     # This should unjam more of the text.
   49     print $client "get foob\n";
   50     $res = <$client>;
   51     last;
   52 }
   53 $res = <$watcher>;
   54 like($res, qr/ts=\d+\.\d+\ gid=\d+ type=item_get/, "saw a real log line after a skip");
   55 
   56 # testing the longest uri encoded key length
   57 {
   58 my $new_watcher = $server->new_sock;
   59 print $new_watcher "watch mutations\n";
   60 my $watch_res = <$new_watcher>;
   61 my $key = "";
   62 my $max_keylen = 250;
   63 for (1 .. $max_keylen) { $key .= "#"; }
   64 print $client "set $key 0 0 9\r\nmemcached\r\n";
   65 $res = <$client>;
   66 is ($res, "STORED\r\n", "stored the long key");
   67 if ($res eq "STORED\r\n") {
   68     $watch_res = <$new_watcher>;
   69     my $max_uri_keylen = $max_keylen * 3 + length("key=");
   70     my @tab = split(/\s+/, $watch_res);
   71     is (length($tab[3]), $max_uri_keylen, "got the correct uri encoded key length");;
   72 }
   73 }
   74 
   75 # test connection events
   76 {
   77     # start a dedicated server so that connection close events from previous
   78     # tests don't leak into this one due to races.
   79     my $conn_server = new_memcached('-m 60 -o watcher_logbuf_size=8');
   80     my $conn_watcher = $conn_server->new_sock;
   81 
   82     sleep 1;
   83     print $conn_watcher "watch connevents\n";
   84     $res = <$conn_watcher>;
   85     is($res, "OK\r\n", 'connevents watcher enabled');
   86 
   87     # normal close
   88     my $conn_client = $conn_server->new_sock;
   89     print $conn_client "version\r\n";
   90     $res = <$conn_client>;
   91     print $conn_client "quit\r\n";
   92     $res = <$conn_watcher>;
   93     like($res, qr/ts=\d+\.\d+\ gid=\d+ type=conn_new .+ transport=(local|tcp)/,
   94         'logged new connection');
   95     $res = <$conn_watcher>;
   96     like($res, qr/ts=\d+\.\d+\ gid=\d+ type=conn_close .+ transport=(local|tcp) reason=normal/,
   97         'logged closed connection due to client disconnect');
   98 
   99     # error close
  100     $conn_client = $conn_server->new_sock;
  101     print $conn_client "GET / HTTP/1.1\r\n";
  102     $res = <$conn_watcher>;
  103     like($res, qr/ts=\d+\.\d+\ gid=\d+ type=conn_new .+ transport=(local|tcp)/,
  104         'logged new connection');
  105     $res = <$conn_watcher>;
  106     like($res, qr/ts=\d+\.\d+\ gid=\d+ type=conn_close .+ transport=(local|tcp) reason=error/,
  107         'logged closed connection due to client protocol error');
  108 }
  109 
  110 # test combined logs
  111 # fill to evictions, then enable watcher, set again, and look for both lines
  112 
  113 {
  114     my $value = "B"x11000;
  115     my $keycount = 8000;
  116 
  117     for (1 .. $keycount) {
  118         print $client "set n,foo$_ 0 0 11000 noreply\r\n$value\r\n";
  119     }
  120     # wait for all of the writes to go through.
  121     print $client "version\r\n";
  122     $res = <$client>;
  123 
  124     my $mwatcher = $server->new_sock;
  125     print $mwatcher "watch mutations evictions\n";
  126     $res = <$mwatcher>;
  127     is($res, "OK\r\n", "new watcher enabled");
  128     my $watcher2 = $server->new_sock;
  129     print $watcher2 "watch evictions\n";
  130     $res = <$watcher2>;
  131     is($res, "OK\r\n", "evictions watcher enabled");
  132 
  133     print $client "set bfoo 0 0 11000 noreply\r\n$value\r\n";
  134     my $found_log = 0;
  135     my $found_ev  = 0;
  136     while (my $log = <$mwatcher>) {
  137         $found_log = 1 if ($log =~ m/type=item_store/);
  138         $found_ev = 1 if ($log =~ m/type=eviction/);
  139         last if ($found_log && $found_ev);
  140     }
  141     is($found_log, 1, "found rawcmd log entry");
  142     is($found_ev, 1, "found eviction log entry");
  143 }
  144 
  145 # test cas command logs
  146 # TODO: need to expose active watchers in stats, so we can monitor for when
  147 # the previous ones are fully disconnected. They might be swallowing the logs
  148 # before we get them. Since I can't reproduce this locally and travis takes 30
  149 # minutes to fail I can't instrument this.
  150 SKIP: {
  151     skip "Mysteriously fails on travis CI.", 1;
  152     $watcher = $server->new_sock;
  153     print $watcher "watch mutations\n";
  154     $res = <$watcher>;
  155     is($res, "OK\r\n", "mutations watcher enabled");
  156 
  157     # There's a bit of a startup race where some workers may not have the log
  158     # enabled yet, so we try a little harder to get the log line in there.
  159     sleep 1;
  160     for (1 .. 20) {
  161         print $client "cas cas_watch_key 0 0 5 0\r\nvalue\r\n";
  162         $res = <$client>;
  163     }
  164     my $tries = 30;
  165     my $found_cas = 0;
  166     while (my $log = <$watcher>) {
  167         $found_cas = 1 if ($log =~ m/cmd=cas/ && $log =~ m/cas_watch_key/);
  168         last if ($tries-- == 0 || $found_cas);
  169     }
  170     is($found_cas, 1, "correctly logged cas command");
  171 }
  172 
  173 # test get/set value sizes
  174 {
  175     my $watcher = $server->new_sock;
  176     print $watcher "watch fetchers mutations\n";
  177     is(<$watcher>, "OK\r\n", "fetchers and mutations watcher enabled");
  178 
  179     print $client "set vfoo 0 0 4\r\nvbar\r\n";
  180     is(<$client>, "STORED\r\n", "stored the key");
  181 
  182     print $client "get vfoo\r\n";
  183     is(<$client>, "VALUE vfoo 0 4\r\n", "read the key header");
  184     is(<$client>, "vbar\r\n", "read the key value");
  185     is(<$client>, "END\r\n", "read the value trailer");
  186 
  187     sleep 1;
  188     like(<$watcher>, qr/ts=\d+\.\d+\ gid=\d+ type=item_get key=vfoo .+ size=0/,
  189         "logged initial item fetch");
  190     like(<$watcher>, qr/ts=\d+\.\d+\ gid=\d+ type=item_store key=vfoo .+ size=4/,
  191         "logged item store with correct size");
  192     like(<$watcher>, qr/ts=\d+\.\d+\ gid=\d+ type=item_get key=vfoo .+ size=4/,
  193         "logged item get with correct size");
  194 }
  195 
  196 # test watcher stats
  197 {
  198     my $stats_server = new_memcached('-m 60 -o watcher_logbuf_size=8');
  199     my $stats_client = $stats_server->sock;
  200     my $stats;
  201 
  202     my $watcher1 = $stats_server->new_sock;
  203     print $watcher1 "watch fetchers\n";
  204     $res = <$watcher1>;
  205     is($res, "OK\r\n", 'fetchers watcher enabled');
  206     sleep 1;
  207     $stats = mem_stats($stats_client);
  208     is($stats->{log_watchers}, 1, 'tracked new fetchers watcher');
  209 
  210     my $watcher2 = $stats_server->new_sock;
  211     print $watcher2 "watch fetchers\n";
  212     $res = <$watcher2>;
  213     is($res, "OK\r\n", 'mutations watcher enabled');
  214     sleep 1;
  215     $stats = mem_stats($stats_client);
  216     is($stats->{log_watchers}, 2, 'tracked new mutations watcher');
  217 
  218     $watcher1->close();
  219     $watcher2->close();
  220     sleep 1;
  221     $stats = mem_stats($stats_client);
  222     is($stats->{log_watchers}, 0, 'untracked all watchers');
  223 }
  224 
  225 # test no_watch option
  226 {
  227     my $nowatch_server = new_memcached('-W');
  228     my $watchsock = $nowatch_server->new_sock;
  229 
  230     print $watchsock "watch mutations\n";
  231 
  232     my $watchresult = <$watchsock>;
  233 
  234     is($watchresult, "CLIENT_ERROR watch commands not allowed\r\n", "attempted watch gave client error with no_watch option set");
  235 }