squid_icp

#!@@PERL@@ -w
# -*- perl -*-

=head1 NAME

squid_icp - Plugin to graph traffic to the ICP peers

=head1 CONFIGURATION

The following configuration variables are used by this plugin:

 [squid_icp]
  env.squidhost    - host (default "localhost")
  env.squidport    - port (default "3128")
  env.squiduser    - username (default "")
  env.squidpasswd  - password (default "")

=head1 ABOUT

When using squid as a "load balancer" (of sorts), who gets the
request?

=head1 AUTHORS

Copyright (C) 2004 Jimmy Olsen

=head1 LICENSE

Gnu GPLv2

=begin comment

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; version 2 dated June, 1991.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301 USA.

=end comment

=head1 MAGIC MARKERS

 #%# family=manual
 #%# capabilities=autoconf

=cut

my $ret = undef;

if (! eval "require IO::Socket;")
{
	$ret = "IO::Socket not found";
}
if (! eval "require MIME::Base64;")
{
	$ret = "MIME::Base64 not found";
}
if (! eval "require Net::hostent;")
{
	$ret = "Net::hostent not found";
}

$squid_host = $ENV{squidhost} || "localhost";
$squid_port = $ENV{squidport} || 3128;
$user = $ENV{squiduser} || "";
$passwd = $ENV{squidpasswd} || "";

if($ARGV[0] and $ARGV[0] eq "autoconf") {
    &autoconf($squid_host, $squid_port, $user, $passwd);
}

sub autoconf {
    my ($host, $port, $user, $passwd) = @_;

	if ($ret)
	{
		print "no ($ret)\n";
		exit 0;
	}

    my $cachemgr = IO::Socket::INET->new(PeerAddr => $host,
					PeerPort => $port,
					Proto    => 'tcp',
					Timeout  => 5);

    if (!$cachemgr)
    {
	print "no (could not connect: $!)\n";
	exit 0;
    }

    my $request = "GET cache_object://$host/counters HTTP/1.0\r\n" .
	"Accept: */*\r\n" .
	&make_auth_header($user, $passwd) .
	"\r\n";

    $cachemgr->syswrite($request, length($request));
    my @lines = $cachemgr->getlines();

    print "yes\n";
    exit 0;
}

sub make_auth_header {
    my ($user, $passwd) = @_;

    if(!defined $passwd || $passwd eq "") {
	return "";
    } else {
	my $auth = MIME::Base64::encode_base64(($user ? $user : "") . ":$passwd", "");
	return "Authorization: Basic $auth\r\n" .
	    "Proxy-Authorization: Basic $auth\r\n";
    }
}


sub query_squid {
    my ($host, $port, $user, $passwd) = @_;
    my $ret;

    my $cachemgr = IO::Socket::INET->new(PeerAddr => $host,
					PeerPort => $port,
					Proto    => 'tcp') or die($!);



    my $request = "GET cache_object://$host/server_list HTTP/1.0\r\n" .
	"Accept: */*\r\n" .
	&make_auth_header($user, $passwd) .
	"\r\n";

    $cachemgr->syswrite($request, length($request));
    my @lines = $cachemgr->getlines();
    my $id = "";
    for(my $i = 0; $i <= $#lines; $i++) {
	chomp $lines[$i];
	if($lines[$i] =~ /Address[^:]+:\s*([\d\.]+)\s*$/) {
	    my $host = $1;
	    $id = "h" . $host;
	    $id =~ s/\.//g;

	    my $h;
	    if ($h = Net::hostent::gethost ($host)) {
		$ret->{$id}->{host} = lc $h->name;
	    } else {
		$ret->{$id}->{host} = $host;
	    }
	}
	elsif($lines[$i] =~ /FETCHES\s*:\s*(\d+)/) {
	    $ret->{$id}->{fetches} = $1;
	}
    }
    return $ret;
}

my $hosts = &query_squid($squid_host, $squid_port, $user, $passwd);

if($ARGV[0] and $ARGV[0] eq "config") {
    my $first = 1;
    print "graph_title Squid relay statistics\n";
    print "graph_vlabel requests / \${graph_period}\n";
    print "graph_args -l 0 --base 1000\n";
    print "graph_total total\n";
	print "graph_category squid\n";
    foreach my $i (sort keys %{$hosts}) {
	print "$i.label ", $hosts->{$i}->{host}, "\n";
	print "$i.type DERIVE\n";
	print "$i.max 500000\n";
	print "$i.min 0\n";
	if ($first) {
	    print "$i.draw AREA\n";
	    $first = 0;
	} else {
	    print "$i.draw STACK\n";
	}
    }
    exit 0;
}

foreach my $i (keys %{$hosts}) {
    print "$i.value ", $hosts->{$i}->{fetches}, "\n";
}

# vim:syntax=perl