#!/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";
$QUERY_STRING="host=another.com\&port=80\&user_name=proxy\&operation=delay\&passwd=pAssw0rdHer3";

$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} = 0;
        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*((\S*\s*)*)/ ||
        $line =~ /\s+Current:\s*(\d+)/) {
        if ($aggregate){$aggregate_current{$pool} = $1;}
        if ($individual){$individual_current{$pool} = $1;}
        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";
}

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";
     }
     @pairs = split / /,$individual_current{$n};
     $nuse=0;
     $i=1;
     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 ($verbose)
     {
         if ($nuse==1){$appear = "appears"}else{$appear = "appear"};
         print "$nb individual buckets exist, $nuse $appear to be in use.\n";
     }
     #- easier to parse for rrdtool
     print "Mem: $membytes\n";
     print "Buckets: $nb\n";
     print "Inuse: $nuse\n";
}