← Back to branch summary

~yolanda.robla/ubuntu/trusty/memcached/add_distribution

« back to all changes in this revision

Viewing changes to scripts/damemtop

  • Committer: Bazaar Package Importer
  • Author(s): David Martínez Moreno
  • Date: 2010-05-12 11:41:22 UTC
  • mfrom: (1.1.7 upstream) (3.3.3 squeeze)
  • Revision ID: james.westby@ubuntu.com-20100512114122-e2dphwiezevuny1t
Tags: 1.4.5-1
http://bugs.debian.org/579913
* New upstream release.  Main changes since 1.4.2 are:
  New features:
  - Support for SASL authentication.
  - New script damemtop - a memcached top.
  - Slab optimizations.
  - New stats, for reclaimed memory and SASL events.
  Bugs fixed:
  - Malicious input can crash server (CVE-2010-1152).  Closes: #579913.
  - Fixed several problems with slab handling and growth.
  - Provide better error reporting.
  - Fix get stats accounting.
  - Fixed backwards compatibility with delete 0.
  - Documentation fixes.
  - Various build fixes, among others, fixed FTBFS with gcc-4.5 (closes:
    #565033).
* Refreshed and renamed 01_init_script_compliant_with_LSB.patch.
* Fixed lintian warnings by adding $remote_fs to init.d script.
* Removed non-existent document (doc/memory_management.txt).
* debian/control: Bumped Standards-Version to 3.8.4 (no changes).
* 

Show diffs side-by-side

added added

removed removed

Lines of Context:
scripts/damemtop
 
1
#!/usr/bin/perl
 
2
#  dormando's awesome memcached top utility!
 
3
#
 
4
#  Copyright 2009 Dormando (dormando@rydia.net).  All rights reserved.
 
5
#
 
6
#  Use and distribution licensed under the BSD license.  See
 
7
#  the COPYING file for full text.
 
8
 
 
9
use strict;
 
10
use warnings FATAL => 'all';
 
11
 
 
12
use AnyEvent;
 
13
use AnyEvent::Socket;
 
14
use AnyEvent::Handle;
 
15
use Getopt::Long;
 
16
use YAML qw/Dump Load LoadFile/;
 
17
use Term::ReadKey qw/ReadMode ReadKey GetTerminalSize/;
 
18
 
 
19
our $VERSION = '0.1';
 
20
 
 
21
my $CLEAR     = `clear`;
 
22
my @TERM_SIZE = ();
 
23
$|++;
 
24
 
 
25
my %opts = ();
 
26
GetOptions(\%opts, 'help|h', 'config=s');
 
27
 
 
28
if ($opts{help}) {
 
29
    show_help(); exit;
 
30
}
 
31
 
 
32
$SIG{INT} = sub {
 
33
    ReadMode('normal');
 
34
    print "\n";
 
35
    exit;
 
36
};
 
37
 
 
38
# TODO: make this load from central location, and merge in homedir changes.
 
39
# then merge Getopt::Long stuff on top of that
 
40
# TODO: Set a bunch of defaults and merge in.
 
41
my $CONF = load_config();
 
42
my %CONS    = ();
 
43
my $LAST_RUN = time; # time after the last loop cycle.
 
44
my $TIME_SINCE_LAST_RUN = time; # time since last loop cycle.
 
45
my $loop_timer;
 
46
my $main_cond;
 
47
my $prev_stats_results;
 
48
 
 
49
my %display_modes = (
 
50
    't' => \&display_top_mode,
 
51
    '?' => \&display_help_mode,
 
52
    'h' => \&display_help_mode,
 
53
);
 
54
 
 
55
my %column_compute = (
 
56
    'hostname' => { stats => [], code => \&compute_hostname},
 
57
    'hit_rate' => { stats => ['get_hits', 'get_misses'],
 
58
                    code  => \&compute_hit_rate },
 
59
    'fill_rate' => { stats => ['bytes', 'limit_maxbytes'],
 
60
                    code => \&compute_fill_rate },
 
61
);
 
62
 
 
63
my %column_format = (
 
64
    'hit_rate' => \&format_percent,
 
65
    'fill_rate' => \&format_percent,
 
66
);
 
67
 
 
68
# This can collapse into %column_compute
 
69
my %column_format_totals = (
 
70
    'hit_rate' => 0,
 
71
    'fill_rate' => 0,
 
72
);
 
73
 
 
74
ReadMode('cbreak');
 
75
my $LAST_KEY = '';
 
76
my $read_keys = AnyEvent->io (
 
77
    fh => \*STDIN, poll => 'r',
 
78
    cb => sub {
 
79
        $LAST_KEY = ReadKey(-1);
 
80
        # If there is a running timer, cancel it.
 
81
        # Don't want to interrupt a main loop run.
 
82
        # fire_main_loop()'s iteration will pick up the keypress.
 
83
        if ($loop_timer) {
 
84
            $loop_timer = undef;
 
85
            $main_cond->send;
 
86
        }
 
87
    }
 
88
);
 
89
 
 
90
# start main loop
 
91
fire_main_loop();
 
92
 
 
93
### AnyEvent related code.
 
94
 
 
95
sub fire_main_loop {
 
96
    for (;;) {
 
97
        $loop_timer = undef;
 
98
        $main_cond = AnyEvent->condvar;
 
99
        my $time_taken = main_loop();
 
100
        my $delay = $CONF->{delay} - $time_taken;
 
101
        $delay = 0 if $delay < 0;
 
102
        $loop_timer = AnyEvent->timer(
 
103
            after => $delay,
 
104
            cb    => $main_cond,
 
105
        );
 
106
        $main_cond->recv;
 
107
    }
 
108
}
 
109
 
 
110
sub main_loop {
 
111
    my $start = AnyEvent->now; # use ->time to find the end.
 
112
    maintain_connections();
 
113
 
 
114
    my $cv = AnyEvent->condvar;
 
115
 
 
116
    # FIXME: Need to dump early if there're no connected conns
 
117
    # FIXME: Make this only fetch stats from cons we care to visualize?
 
118
    # maybe keep everything anyway to maintain averages?
 
119
    my %stats_results = ();
 
120
    while (my ($hostname, $con) = each %CONS) {
 
121
        $cv->begin;
 
122
        call_stats($con, ['', 'items', 'slabs'], sub {
 
123
            $stats_results{$hostname} = shift;
 
124
            $cv->end;
 
125
        });
 
126
    }
 
127
    $cv->recv;
 
128
 
 
129
    # Short circuit since we don't have anything to compare to.
 
130
    unless ($prev_stats_results) {
 
131
        $prev_stats_results = \%stats_results;
 
132
        return $CONF->{delay};
 
133
    }
 
134
 
 
135
    # Semi-exact global time diff for stats that want to average
 
136
    # themselves per-second.
 
137
    my $this_run = AnyEvent->time;
 
138
    $TIME_SINCE_LAST_RUN = $this_run - $LAST_RUN;
 
139
    $LAST_RUN = $this_run;
 
140
 
 
141
    # Done all our fetches. Drive the display.
 
142
    display_run($prev_stats_results, \%stats_results);
 
143
    $prev_stats_results = \%stats_results;
 
144
 
 
145
    my $end  = AnyEvent->time;
 
146
    my $diff = $LAST_RUN - $start;
 
147
    print "loop took: $diff";
 
148
    return $diff;
 
149
}
 
150
 
 
151
sub maintain_connections {
 
152
    my $cv    = AnyEvent->condvar;
 
153
 
 
154
    $cv->begin (sub { shift->send });
 
155
    for my $host (@{$CONF->{servers}}) {
 
156
        next if $CONS{$host};
 
157
        $cv->begin;
 
158
        $CONS{$host} = connect_memcached($host, sub {
 
159
            if ($_[0] eq 'err') {
 
160
                print "Failed connecting to $host: ", $_[1], "\n";
 
161
                delete $CONS{$host};
 
162
            }
 
163
            $cv->end;
 
164
        });
 
165
    }
 
166
    $cv->end;
 
167
 
 
168
    $cv->recv;
 
169
}
 
170
 
 
171
sub connect_memcached {
 
172
    my ($fullhost, $cb)   = @_;
 
173
    my ($host, $port) = split /:/, $fullhost;
 
174
 
 
175
    my $con; $con = AnyEvent::Handle->new (
 
176
        connect => [$host => $port],
 
177
        on_connect => sub {
 
178
            $cb->('con');
 
179
        },
 
180
        on_connect_error => sub {
 
181
            $cb->('err', $!);
 
182
            $con->destroy;
 
183
        },
 
184
        on_eof   => sub {
 
185
            $cb->('err', $!);
 
186
            $con->destroy;
 
187
        },
 
188
    );
 
189
    return $con;
 
190
}
 
191
 
 
192
# Function's getting a little weird since I started optimizing it.
 
193
# As of my first set of production tests, this routine is where we spend
 
194
# almost all of our processing time.
 
195
sub call_stats {
 
196
    my ($con, $cmds, $cb) = @_;
 
197
 
 
198
    my $stats = {};
 
199
    my $num_types = @$cmds;
 
200
 
 
201
    my $reader; $reader = sub {
 
202
        my ($con, $results) = @_;
 
203
        {
 
204
            my %temp = ();
 
205
            for my $line (split(/\n/, $results)) {
 
206
                my ($k, $v) = (split(/\s+/, $line))[1,2];
 
207
                $temp{$k} = $v;
 
208
            }
 
209
            $stats->{$cmds->[0]} = \%temp;
 
210
        }
 
211
        shift @$cmds;
 
212
        unless (@$cmds) {
 
213
            # Out of commands to process, return goodies.
 
214
            $cb->($stats);
 
215
            return;
 
216
        }
 
217
    };
 
218
 
 
219
    for my $cmd (@$cmds) {
 
220
        $con->push_write('stats ' . $cmd . "\n");
 
221
        $stats->{$cmd} = {};
 
222
        $con->push_read(line => "END\r\n", $reader);
 
223
    }
 
224
}
 
225
 
 
226
### Compute routines
 
227
 
 
228
sub compute_hostname {
 
229
    return $_[0];
 
230
}
 
231
 
 
232
sub compute_hit_rate {
 
233
    my $s = $_[1];
 
234
    my $total = $s->{get_hits} + $s->{get_misses};
 
235
    return 'NA' unless $total;
 
236
    return $s->{get_hits} / $total;
 
237
}
 
238
 
 
239
sub compute_fill_rate {
 
240
    my $s = $_[1];
 
241
    return $s->{bytes} / $s->{limit_maxbytes};
 
242
}
 
243
 
 
244
sub format_column {
 
245
    my ($col, $val) = @_;
 
246
    my $res;
 
247
    $col =~ s/^all_//;
 
248
    if ($column_format{$col}) {
 
249
        if (ref($column_format{$col}) eq 'CODE') {
 
250
            return $column_format{$col}->($val);
 
251
        } else {
 
252
            return $val .= $column_format{$col};
 
253
        }
 
254
    } else {
 
255
        return format_commas($val);
 
256
    }
 
257
}
 
258
 
 
259
sub column_can_total {
 
260
    my $col = shift;
 
261
    $col =~ s/^all_//;
 
262
    return 1 unless exists $column_format_totals{$col};
 
263
    return $column_format_totals{$col};
 
264
}
 
265
 
 
266
### Display routines
 
267
 
 
268
# If there isn't a specific column type computer, see if we just want to
 
269
# look at the specific stat and return it.
 
270
# If column is a generic type and of 'all_cmd_get' format, return the more
 
271
# complete stat instead of the diffed stat.
 
272
sub compute_column {
 
273
    my ($col, $host, $prev_stats, $curr_stats) = @_;
 
274
    my $diff_stats = 1;
 
275
    $diff_stats    = 0 if ($col =~ s/^all_//);
 
276
 
 
277
    # Really should decide on whether or not to flatten the hash :/
 
278
    my $find_stat = sub {
 
279
        for my $type (keys %{$_[0]}) {
 
280
            return $_[0]->{$type}->{$_[1]} if exists $_[0]->{$type}->{$_[1]};
 
281
        }
 
282
    };
 
283
 
 
284
    my $diff_stat = sub {
 
285
        my $stat = shift;
 
286
        return 'NA' unless defined $find_stat->($curr_stats, $stat);
 
287
        if ($diff_stats) {
 
288
            my $diff = eval {
 
289
                return ($find_stat->($curr_stats, $stat)
 
290
                       - $find_stat->($prev_stats, $stat))
 
291
                       / $TIME_SINCE_LAST_RUN;
 
292
            };
 
293
            return 'NA' if ($@);
 
294
            return $diff;
 
295
        } else {
 
296
            return $find_stat->($curr_stats, $stat);
 
297
        }
 
298
    };
 
299
 
 
300
    if (my $comp = $column_compute{$col}) {
 
301
        my %s = ();
 
302
        for my $stat (@{$comp->{stats}}) {
 
303
            $s{$stat} = $diff_stat->($stat);
 
304
        }
 
305
        return $comp->{code}->($host, \%s);
 
306
    } else {
 
307
        return $diff_stat->($col);
 
308
    }
 
309
    return 'NA';
 
310
}
 
311
 
 
312
# We have a bunch of stats from a bunch of connections.
 
313
# At this point we run a particular display mode, capture the lines, then
 
314
# truncate and display them.
 
315
sub display_run {
 
316
    my $prev_stats = shift;
 
317
    my $curr_stats = shift;
 
318
    @TERM_SIZE = GetTerminalSize;
 
319
    die "cannot detect terminal size" unless $TERM_SIZE[0] && $TERM_SIZE[1];
 
320
 
 
321
    if ($LAST_KEY eq 'q') {
 
322
        print "\n";
 
323
        ReadMode('normal'); exit;
 
324
    }
 
325
 
 
326
    if ($LAST_KEY ne $CONF->{mode} && exists $display_modes{$LAST_KEY}) {
 
327
        $CONF->{prev_mode} = $CONF->{mode};
 
328
        $CONF->{mode} = $LAST_KEY;
 
329
    } elsif ($CONF->{mode} eq 'h' || $CONF->{mode} eq '?') {
 
330
        # Bust out of help mode on any key.
 
331
        $CONF->{mode} = $CONF->{prev_mode};
 
332
    }
 
333
    my $lines = $display_modes{$CONF->{mode}}->($prev_stats, $curr_stats);
 
334
    display_lines($lines) if $lines;
 
335
}
 
336
 
 
337
# Default "top" mode.
 
338
# create a set of computed columns as requested by the config.
 
339
# this has gotten a little out of hand... needs more cleanup/abstraction.
 
340
sub display_top_mode {
 
341
    my $prev_stats = shift;
 
342
    my $curr_stats = shift;
 
343
 
 
344
    my @columns = @{$CONF->{top_mode}->{columns}};
 
345
    my @rows    = ();
 
346
    my @tot_row = ();
 
347
 
 
348
    # Round one.
 
349
    for my $host (sort keys %{$curr_stats}) {
 
350
        my @row = ();
 
351
        for my $colnum (0 .. @columns-1) {
 
352
            my $col = $columns[$colnum];
 
353
            my $res = compute_column($col, $host, $prev_stats->{$host},
 
354
                      $curr_stats->{$host});
 
355
            $tot_row[$colnum] += $res if is_numeric($res);
 
356
            push @row, $res;
 
357
        }
 
358
        push(@rows, \@row);
 
359
    }
 
360
 
 
361
    # Sort rows by sort column (ascending or descending)
 
362
    if (my $sort = $CONF->{top_mode}->{sort_column}) {
 
363
        my $order  = $CONF->{top_mode}->{sort_order} || 'asc';
 
364
        my $colnum = 0;
 
365
        for (0 .. @columns-1) { $colnum = $_ if $columns[$_] eq $sort; }
 
366
        my @newrows;
 
367
        if ($order eq 'asc') {
 
368
            if (is_numeric($rows[0]->[$colnum])) {
 
369
                @newrows = sort { $a->[$colnum] <=> $b->[$colnum] } @rows;
 
370
            } else {
 
371
                @newrows = sort { $a->[$colnum] cmp $b->[$colnum] } @rows;
 
372
            }
 
373
        } else {
 
374
            if (is_numeric($rows[0]->[$colnum])) {
 
375
                @newrows = sort { $b->[$colnum] <=> $a->[$colnum] } @rows;
 
376
            } else {
 
377
                @newrows = sort { $b->[$colnum] cmp $a->[$colnum] } @rows;
 
378
            }
 
379
        }
 
380
        @rows = @newrows;
 
381
    }
 
382
 
 
383
    # Format each column after the sort...
 
384
    {
 
385
        my @newrows = ();
 
386
        for my $row (@rows) {
 
387
            my @newrow = ();
 
388
            for my $colnum (0 .. @columns-1) {
 
389
                push @newrow, is_numeric($row->[$colnum]) ?
 
390
                            format_column($columns[$colnum], $row->[$colnum]) :
 
391
                            $row->[$colnum];
 
392
            }
 
393
            push @newrows, \@newrow;
 
394
        }
 
395
        @rows = @newrows;
 
396
    }
 
397
 
 
398
    # Create average and total rows.
 
399
    my @avg_row = ();
 
400
    for my $col (0 .. @columns-1) {
 
401
        if (is_numeric($tot_row[$col])) {
 
402
            my $countable_rows = 0;
 
403
            for my $row (@rows) {
 
404
                next unless $row->[$col];
 
405
                $countable_rows++ unless $row->[$col] eq 'NA';
 
406
            }
 
407
            $countable_rows = 1 unless $countable_rows;
 
408
            push @avg_row, format_column($columns[$col],
 
409
                 sprintf('%.2f', $tot_row[$col] / $countable_rows));
 
410
        } else {
 
411
            push @avg_row, 'NA';
 
412
        }
 
413
        $tot_row[$col] = 'NA' unless defined $tot_row[$col];
 
414
        $tot_row[$col] = 'NA' unless (column_can_total($columns[$col]));
 
415
        $tot_row[$col] = format_column($columns[$col], $tot_row[$col])
 
416
                         unless $tot_row[$col] eq 'NA';
 
417
    }
 
418
    unshift @rows, \@avg_row;
 
419
    unshift @rows, ['AVERAGE:'];
 
420
    unshift @rows, \@tot_row;
 
421
    unshift @rows, ['TOTAL:'];
 
422
 
 
423
    # Round two. Pass @rows into a function which returns an array with the
 
424
    # desired format spacing for each column.
 
425
    unshift @rows, \@columns;
 
426
    my $spacing = find_optimal_spacing(\@rows);
 
427
 
 
428
    my @display_lines = ();
 
429
    for my $row (@rows) {
 
430
        my $line = '';
 
431
        for my $col (0 .. @$row-1) {
 
432
            my $space = $spacing->[$col];
 
433
            $line .= sprintf("%-${space}s ", $row->[$col]);
 
434
        }
 
435
        push @display_lines, $line;
 
436
    }
 
437
 
 
438
    return \@display_lines;
 
439
}
 
440
 
 
441
sub display_help_mode {
 
442
    my $help = <<"ENDHELP";
 
443
 
 
444
dormando's awesome memcached top utility version v$VERSION
 
445
 
 
446
This early version requires you to edit the ~/.damemtop/damemtop.yaml
 
447
(or /etc/damemtop.yaml) file in order to change options.
 
448
See --help for more info.
 
449
 
 
450
Hit any key to exit help.
 
451
ENDHELP
 
452
    my @lines = split /\n/, $help;
 
453
    display_lines(\@lines);
 
454
    $LAST_KEY = ReadKey(0);
 
455
    return;
 
456
}
 
457
 
 
458
# Takes a set of lines, clears screen, dumps header, trims lines, etc
 
459
# MAYBE: mode to wrap lines instead of trim them?
 
460
sub display_lines {
 
461
    my $lines = shift;
 
462
 
 
463
    my $width         = $TERM_SIZE[0];
 
464
    my $height_remain = $TERM_SIZE[1];
 
465
 
 
466
    unshift @$lines, display_header($width);
 
467
    clear_screen() unless $CONF->{no_clear};
 
468
 
 
469
    while (--$height_remain && @$lines) {
 
470
        # truncate too long lines.
 
471
        my $line = shift @$lines;
 
472
        $line = substr $line, 0, $width-1;
 
473
        print $line, "\n";
 
474
    }
 
475
}
 
476
 
 
477
sub display_header {
 
478
    my $topbar = 'damemtop: ' . scalar localtime;
 
479
    if ($CONF->{mode} eq 't' && $CONF->{top_mode}->{sort_column}) {
 
480
        $topbar .= ' [sort: ' . $CONF->{top_mode}->{sort_column} . ']';
 
481
    }
 
482
    $topbar .= ' [delay: ' . $CONF->{delay} . 's]';
 
483
    return $topbar;
 
484
}
 
485
 
 
486
### Utilities
 
487
 
 
488
# find the optimal format spacing for each column, which is:
 
489
# longest length of item in col + 2 (whitespace).
 
490
sub find_optimal_spacing {
 
491
    my $rows  = shift;
 
492
    my @maxes = ();
 
493
 
 
494
    my $num_cols = @{$rows->[0]};
 
495
    for my $row (@$rows) {
 
496
        for my $col (0 .. $num_cols-1) {
 
497
            $maxes[$col] = 0 unless $maxes[$col];
 
498
            next unless $row->[$col];
 
499
            $maxes[$col] = length($row->[$col])
 
500
                if length($row->[$col]) > $maxes[$col];
 
501
        }
 
502
    }
 
503
    for my $col (0 .. $num_cols) {
 
504
        $maxes[$col] += 1;
 
505
    }
 
506
 
 
507
    return \@maxes;
 
508
}
 
509
 
 
510
# doesn't try too hard to identify numbers...
 
511
sub is_numeric {
 
512
    return 0 unless $_[0];
 
513
    return 1 if $_[0] =~ m/^\d+(\.\d*)?(\w+)?$/;
 
514
    return 0;
 
515
}
 
516
 
 
517
sub format_percent {
 
518
    return sprintf("%.2f%%", $_[0] * 100);
 
519
}
 
520
 
 
521
sub format_commas {
 
522
    my $num = shift;
 
523
    $num = int($num);
 
524
    $num =~ s/(^[-+]?\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g;
 
525
    return $num;
 
526
}
 
527
 
 
528
# Can tick counters/etc here as well.
 
529
sub clear_screen {
 
530
    print $CLEAR;
 
531
}
 
532
 
 
533
# tries minimally to find a localized config file.
 
534
# TODO: Handle the YAML error and make it prettier.
 
535
sub load_config {
 
536
    my $config = $opts{config} if $opts{config};
 
537
    my $homedir = "$ENV{HOME}/.damemtop/damemtop.yaml";
 
538
    if (-e $homedir) {
 
539
        $config = $homedir;
 
540
    } else {
 
541
        $config = '/etc/damemtop.yaml';
 
542
    }
 
543
    return LoadFile($config);
 
544
}
 
545
 
 
546
sub show_help {
 
547
    print <<"ENDHELP";
 
548
dormando's awesome memcached top utility version v$VERSION
 
549
 
 
550
This program is copyright (c) 2009 Dormando.
 
551
Use and distribution licensed under the BSD license.  See
 
552
the COPYING file for full text.
 
553
 
 
554
contact: dormando\@rydia.net or memcached\@googlegroups.com.
 
555
 
 
556
This early version requires you to edit the ~/.damemtop/damemtop.yaml
 
557
(or /etc/damemtop.yaml) file in order to change options.
 
558
 
 
559
You may display any column that is in the output of
 
560
'stats', 'stats items', or 'stats slabs' from memcached's ASCII protocol.
 
561
Start a column with 'all_' (ie; 'all_get_hits') to display the current stat,
 
562
otherwise the stat is displayed as an average per second.
 
563
 
 
564
Specify a "sort_column" under "top_mode" to sort the output by any column.
 
565
 
 
566
Some special "computed" columns exist:
 
567
hit_rate (get/miss hit ratio)
 
568
fill_rate (% bytes used out of the maximum memory limit)
 
569
ENDHELP
 
570
    exit;
 
571
}