#!/usr/bin/perl
#
# Script to get delaypools statistics from squid server
# using the cachemgr.cgi interface without using an
# intermediate webserver.
#
# probably only works on class 2 configurations.
#
use Getopt::Std;
$CACHEMGRCGI="/usr/local/squid-2.4/libexec/squid/cachemgr.cgi";
#nopasswd
#$QUERY_STRING="host=server.test.pl\&port=80\&user_name=proxy\&operation=delay\&auth=";
#passwd
$QUERY_STRING="host=server.test.pl\&port=80\&user_name=proxy\&operation=delay\&passwd=passwordhere";

$ENV{'QUERY_STRING'} = $QUERY_STRING;
#print "running $CACHEMGRCGI\?$ENV{'QUERY_STRING'}\n";

$verbose=0;
getopts('v');
if ($opt_v){$verbose=1}

@stats=`$CACHEMGRCGI`;
$first=1;
$pool=0;
foreach $line (@stats) 
{
    chomp($line);
    if ($first) {
        if ($line !~ /Status:\s+200\s+200\s+OK/) {
            print "Server Error:\n$line\n";
            for ($i=1;$i<=$#stats;$i++){chomp $stats[$i];print "$stats[$i]\n";}
            exit(1);
        }
        $first=0; next;
    }
    if ($line =~ /^Delay pools configured:\s*(\d+)/) {
        $npools = $1;
    }
    if ($line =~ /^Pool:\s*(\d+)/) {
        $pool = $1;
        $aggregate=0; 
        $individual=0;
        $class{$pool} =0;
        $aggregate_max{$pool} = 0;
        $individual_max{$pool} = 0;
        $aggregate_restore{$pool} = 0;
        $individual_restore{$pool} = 0;
        $aggregate_current{$pool} = 0;
        $individual_current{$pool} = ();
        $individual_network{$pool} = ();
        next;
    }
    if ($line =~ /\s+Class:\s*(\d+)/) {
        $class{$pool} = $1;
        next;
    }
    if ($line =~ /\s+Individual:/) {
        $individual=1;
        $aggregate=0;
        next;
    }
    if ($line =~ /\s+Aggregate:/) {
        $aggregate=1;
        $individual=0;
        next;
    }
    if ($line =~ /\s+Max:\s*(\d+)/) {
        if ($aggregate){$aggregate_max{$pool} = $1;}
        if ($individual){$individual_max{$pool} = $1;}
        next;
    }
    if ($line =~ /\s+Rate:\s*(\d+)/) {
        if ($individual){$individual_restore{$pool} = $1;}
        next;
    }
    if ($line =~ /\s+Restore:\s*(\d+)/) {
        if ($aggregate){$aggregate_restore{$pool} = $1;}
        next;
    }
    if ($line =~ /\s+Current:\s*(\d+)/) {
        if ($aggregate){$aggregate_current{$pool} = $1;}
        if ($individual){push (@{$individual_current{$pool}},$1);}
        next;
    }
    if ($line =~ /\s+Current:\s*((\S*\s*)*)/) {
        push (@{$individual_current{$pool}},$1);
        next;
    } 
    if ($line =~ /\s+Current\s*\[Network\s*(\d*)\]:\s*((\S*\s*)*)/){
        push (@{$individual_network{$pool}},$1);
        push (@{$individual_current{$pool}},$2);
        next;
    }
    if ($line =~ /^Memory Used:/) {
        (@memory) = split / /,$line;
        $membytes = $memory[2]; # - mem used in bytes
    }
}

if ($verbose){
print "$membytes bytes of memory used by $npools delaypools\n";
}
print "Mem: $membytes\n";
$total_buckets=0;
$total_inuse=0;

for ($n=1;$n<=$npools;$n++)
{
     if($verbose){
      print "Pool $n: Class $class{$n}:\n";
      print "Aggregate: Max = $aggregate_max{$n}, Restore = $aggregate_restore{$n}\n";
      print "Individual: Max = $individual_max{$n}, Rate = $individual_restore{$n}\n";
      print "Global bucket current: $aggregate_current{$n}\n";
      print "\n";
      if ($individual_current{$n} =~ /\s*Not used/i) {
          print "No individual buckets are in use yet for this pool\n";
          next;
      }
      print "Num  Bucket   Current\n";
      print "---------------------\n";
     }
     $max_buckets_per_net = 0;
     $total_buckets_this_pool = 0;
     $nuse_per_pool=0;
     foreach my $networklist (@{$individual_current{$n}})
     {
         @pairs = split / /,$networklist;
         $i=1;
         %bucketnum = ();
         $nuse=0;
         for $pair (@pairs)
         {
             ($num,$used) = split /:/,$pair,2;
             $bucketnum{$num}=$i;
             if ($verbose){printf("%3d%8d%10d",$bucketnum{$num},$num,$used);}
             if ($used != $individual_max{$n}){
                 $nuse++;
                 if ($verbose) {print "<== in use";}
             }
             if ($verbose){print "\n";}
             $i++;
         }
         if ($verbose)
         {
             print "\n";
             print "Used(*)/Unused Buckets\n";
             print "---------------------\n";
             for ($i=1;$i<256;$i++)
             {
                  if (exists $bucketnum{$i}) {
                      print "$i*";
                  } else {
                      print "$i";
                  }
                  if ($i<255){print ",";}
             }
             print "\n\n";
          }       
          $nb = $#pairs+1;
          if ($nb > $max_buckets_per_net) {$max_buckets_per_net = $nb;}
          $total_buckets_this_pool += $nb;
          if ($verbose)
          {
              #- gramatyka jest wasny :-)
              if ($nuse==1){$appear = "appears"}else{$appear = "appear"};
              print "$nb individual buckets exist, $nuse $appear to be in use.\n";
          }
          $nuse_per_pool+=$nuse;
     }
     #- easier to parse for rrdtool
#    print "Pool$n\n";
#    print "Buckets: $total_buckets_this_pool\n";
#    print "Inuse: $nuse_per_pool\n";
#    print "Max: $max_buckets_per_net\n";
     print "Pool$n buckets: $total_buckets_this_pool inuse: $nuse_per_pool\n";
     $total_buckets += $total_buckets_this_pool;
     $total_inuse += $nuse_per_pool;
}
print "Total buckets: $total_buckets inuse: $total_inuse\n";