"Fossies" - the Fresh Open Source Software Archive

Member "memcached-1.6.9/t/watcher.t" (21 Nov 2020, 4564 Bytes) of package /linux/www/memcached-1.6.9.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 latest Fossies "Diffs" side-by-side code changes report for "watcher.t": 1.6.8_vs_1.6.9.

    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 => 12;
    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 combined logs
   76 # fill to evictions, then enable watcher, set again, and look for both lines
   77 
   78 {
   79     my $value = "B"x11000;
   80     my $keycount = 8000;
   81 
   82     for (1 .. $keycount) {
   83         print $client "set n,foo$_ 0 0 11000 noreply\r\n$value\r\n";
   84     }
   85     # wait for all of the writes to go through.
   86     print $client "version\r\n";
   87     $res = <$client>;
   88 
   89     my $mwatcher = $server->new_sock;
   90     print $mwatcher "watch mutations evictions\n";
   91     $res = <$mwatcher>;
   92     is($res, "OK\r\n", "new watcher enabled");
   93     my $watcher2 = $server->new_sock;
   94     print $watcher2 "watch evictions\n";
   95     $res = <$watcher2>;
   96     is($res, "OK\r\n", "evictions watcher enabled");
   97 
   98     print $client "set bfoo 0 0 11000 noreply\r\n$value\r\n";
   99     my $found_log = 0;
  100     my $found_ev  = 0;
  101     while (my $log = <$mwatcher>) {
  102         $found_log = 1 if ($log =~ m/type=item_store/);
  103         $found_ev = 1 if ($log =~ m/type=eviction/);
  104         last if ($found_log && $found_ev);
  105     }
  106     is($found_log, 1, "found rawcmd log entry");
  107     is($found_ev, 1, "found eviction log entry");
  108 }
  109 
  110 # test cas command logs
  111 # TODO: need to expose active watchers in stats, so we can monitor for when
  112 # the previous ones are fully disconnected. They might be swallowing the logs
  113 # before we get them. Since I can't reproduce this locally and travis takes 30
  114 # minutes to fail I can't instrument this.
  115 SKIP: {
  116     skip "Mysteriously fails on travis CI.", 1;
  117     $watcher = $server->new_sock;
  118     print $watcher "watch mutations\n";
  119     $res = <$watcher>;
  120     is($res, "OK\r\n", "mutations watcher enabled");
  121 
  122     # There's a bit of a startup race where some workers may not have the log
  123     # enabled yet, so we try a little harder to get the log line in there.
  124     sleep 1;
  125     for (1 .. 20) {
  126         print $client "cas cas_watch_key 0 0 5 0\r\nvalue\r\n";
  127         $res = <$client>;
  128     }
  129     my $tries = 30;
  130     my $found_cas = 0;
  131     while (my $log = <$watcher>) {
  132         $found_cas = 1 if ($log =~ m/cmd=cas/ && $log =~ m/cas_watch_key/);
  133         last if ($tries-- == 0 || $found_cas);
  134     }
  135     is($found_cas, 1, "correctly logged cas command");
  136 }
  137 
  138 # test no_watch option
  139 {
  140     my $nowatch_server = new_memcached('-W');
  141     my $watchsock = $nowatch_server->new_sock;
  142 
  143     print $watchsock "watch mutations\n";
  144 
  145     my $watchresult = <$watchsock>;
  146 
  147     is($watchresult, "CLIENT_ERROR watch commands not allowed\r\n", "attempted watch gave client error with no_watch option set");
  148 }