git.sesse.net Git - remoteglot/blob - varnishcount.pl

   1 #! /usr/bin/perl
   2 use AnyEvent;
   3 use AnyEvent::Handle;
   4 use EV;
   5 use LWP::Simple;
   6 require 'config.pm';
   7 use strict;
   8 use warnings;
   9 no warnings qw(once);
  10
  11 open my $fh, "-|", "varnishncsa -F '%{%s}t %U %q tffb=%{Varnish:time_firstbyte}x' -q 'ReqURL ~ \"^/analysis.pl\"'"
  12         or die "varnishncsa: $!";
  13 my %uniques = ();
  14
  15 my $ev = AnyEvent::Handle->new(
  16         fh => $fh,
  17         on_read => sub {
  18                 my ($hdl) = @_;
  19                 $hdl->push_read(
  20                         line => sub {
  21                                 my ($hdl, $line, $eof) = @_;
  22                                 handle_line($line);
  23                         }
  24                 );
  25         },
  26 );
  27 my $ev2 = AnyEvent->timer(
  28         interval => 1.0,
  29         cb => \&output
  30 );
  31 EV::run;
  32
  33 sub handle_line {
  34         my $line = shift;
  35         $line =~ m#(\d+) /analysis.pl \?ims=\d+&unique=(.*) tffb=(.*)# or return;
  36         $uniques{$2} = {
  37                 last_seen => $1 + $3,
  38                 grace => undef,
  39         };
  40         my $now = time;
  41         print "[$now] $1 $2 $3\n";
  42 }
  43
  44 sub output {
  45         my $mtime = (stat($remoteglotconf::json_output))[9] - 1;  # Compensate for subsecond issues.
  46         my $now = time;
  47
  48         while (my ($unique, $hash) = each %uniques) {
  49                 my $last_seen = $hash->{'last_seen'};
  50                 if ($now - $last_seen <= 5) {
  51                         # We've seen this user in the last five seconds;
  52                         # it's okay.
  53                         next;
  54                 }
  55                 if ($last_seen >= $mtime) {
  56                         # This user has the latest version;
  57                         # they are probably just hanging.
  58                         next;
  59                 }
  60                 if (!defined($hash->{'grace'})) {
  61                         # They have five seconds after a new JSON has been
  62                         # provided to get get it, or they're out.
  63                         # We don't simply use $mtime, since we don't want to
  64                         # reset the grace timer just because a new JSON is
  65                         # published.
  66                         $hash->{'grace'} = $mtime;
  67                 }
  68                 if ($now - $hash->{'grace'} > 5) {
  69                         printf "Timing out %s (last_seen=%d, now=%d, mtime=%d, grace=%d)\n",
  70                                 $unique, $last_seen, $now, $mtime, $hash->{'grace'};
  71                         delete $uniques{$unique};
  72                 }
  73         }
  74
  75         my $num_viewers = scalar keys %uniques;
  76         printf "%d entries in hash, mtime=$mtime\n", scalar keys %uniques;
  77         LWP::Simple::get('http://127.0.0.1:5000/override-num-viewers?num=' . $num_viewers);
  78 }