GD&ip&graph

#!/usr/local/bin/perl

use lib ('/export/web/ipanalyze.example.com/data/lib');

use strict;
use GD;
use DBI;
use CGI qw(:standard);
use GD::Graph::lines;
use GD::Graph::pie;
use IPAnalyze::Auth;
use IPAnalyze::Misc;
use IPAnalyze::IPmath;

my %cfg;
open(CONFIG, '/export/web/ipanalyze.example.com/data/ipanalyze.conf') || die "cannot open config: $!\n";
while(){
   s/^(.*)\s*#.*/$1/;
   next if(/^$/);
	chomp;
	if(/^(\S+)\s*=>\s?(.+)/){
		$cfg{$1} = $2;
	}
}
close CONFIG;

my $d_dbh;
until($d_dbh){
	$d_dbh = DBI->connect ($cfg{d_dsn}, $cfg{d_dbun}, $cfg{d_dbpw}, {RaiseError => 1});
	warn "$DBI::errstr\n" if($DBI::errstr);
	sleep 1;
}

my $q = new CGI();
my $auth = IPAnalyze::Auth->new();
my $misc = IPAnalyze::Misc->new();
my $ipmath = IPAnalyze::IPmath->new();
my $font = gdSmallFont;
my ($cols,$rows) = (960,1800); # 80 As fit in 480
my $length = sprintf('%.0f',($cols/6));
my %e = ( 30 => 'A', 29 => 'B', 28 => 'C', 27 => 'D',
          26 => 'E', 25 => 'F', 24 => 'G', 23 => 'H',
          22 => 'I', 21 => 'J', 20 => 'K', 19 => 'L' );

if(my($username,$access) = $auth->check_access($d_dbh,$q,$cfg{app})){

	unless($access > 0){
		my @error = ("Access denied.");
		print $q->header(-expires=>'now');
		$misc->show_error($cfg{html_dir},\@error);
		exit;
	}

	if($q->param('cidr')){
		warn "creating utilization graph of CIDR allocations for ${username}\n";
	
		my %cidr = (30 => $q->param('30'),
		            29 => $q->param('29'),	
		            28 => $q->param('28'),	
		            27 => $q->param('27'),	
		            26 => $q->param('26'),	
		            25 => $q->param('25'),	
		            24 => $q->param('24'),
		);

		my $graph = GD::Graph::pie->new(500,300);

		my @data = (
		 [   "/30",  "/25",    "/29",    "/26",      "/27",      "/28",  "/24"],
		 [$cidr{30},$cidr{25},$cidr{29},$cidr{26},$cidr{27},$cidr{28},$cidr{24}],
		);
		my $gd = $graph->plot(\@data) or die $graph->error;
		print $q->header(-type=>'image/png',-expires=>'now');
		binmode STDOUT;
		print $gd->png;
	}elsif((defined(my $high=$q->param('high'))) && (defined(my $low=$q->param('low')))){
		die "invalid high: $high\n" unless($high == int($high));
		die "invalid low: $low\n" unless($low == int($low));
		die "low must be le high\n" unless($low <= $high);
		warn "creating utilization graph of ${low}% to ${high}% for ${username}\n";

		# to answer the question:
		# "how many customers are ge $low and le $high? "

		my $sql = 'SELECT usage_history FROM data WHERE enable_monitoring = 1';
		my $sth = $d_dbh->prepare($sql);
		$sth->execute;
		my @entries;
		my (@zero,@low,@med,@high);
		while(my $row = $sth->fetchrow_arrayref){
			my @history = (split /:/, $row->[0]);
			until(@history == 30){
				unshift @history, undef; # most current is highest element
			}
			foreach(0..29){
				if(defined($history[$_])){
					if($q->param('all')){
						if($history[$_] >= 80){
							$high[$_]++;
						}elsif($history[$_] >= 40){
							$med[$_]++;
						}elsif($history[$_] > 0){
							$low[$_]++;
						}else{
							$zero[$_]++;
						}
					}else{
						if($history[$_] >= $low && $history[$_] <= $high){
							$entries[$_]++;
						}
					}
				}
			}
		}
		my @data = ($q->param('all')) ? 
					  ([29,28,27,26,25,24,23,22,21,20,19,18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1,0],
						[@high],
						[@med],
						[@low],
						[@zero])
					:
					  ([29,28,27,26,25,24,23,22,21,20,19,18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1,0],
						[@entries]);

		my $y_label = 'Number of Networks';
		$y_label .= " ge ${low} and le ${high}" unless($q->param('all'));
		my $graph = GD::Graph::lines->new(500,300);
		$graph->set(x_label => 'Days Ago',
						y_label => $y_label,
						x_label_position => 1/2,
						title	=> '30 Day Usage History',
						y_tick_number => 10,
						line_width => 2,
						x_label_skip => 0,
		            dclrs => [ qw(lgreen lblue lyellow lred) ]) || die $graph->error;
	
		if($q->param('all')){
			my @legend = qw/>=80% >=40% >0% 0%/;
			$graph->set_legend(@legend);
		}
		my $gd = $graph->plot(\@data);
	
		print $q->header(-type=>'image/png',-expires=>'now');
		binmode STDOUT;
		print $gd->png;

	}elsif(my $netid = $q->param('netid')){
		die "invalid netid: $netid from $ENV{'REMOTE_ADDR'}\n" unless($netid == int($netid));
		warn "creating graph for ${username} netid ${netid}\n";

		my $sql = 'SELECT usage_history FROM data WHERE netid = ' . $d_dbh->quote($netid);
		my $sth = $d_dbh->prepare($sql);
		$sth->execute;
		my $row = $sth->fetchrow_arrayref;
	
		my @history = (split /:/, $row->[0]);
		until(@history == 30){
			unshift @history, undef;
		}

		my $graph = GD::Graph::lines->new(500,300);
		$graph->set(x_label => 'Days Ago',
						y_label => 'Percent Alive',
						title	=> '30 Day Usage History',
						x_label_position => 1/2,
						y_min_value => 0,
						y_max_value => 100,
						y_tick_number => 10,
						line_width => 2,
						x_label_skip => 0,
		            dclrs => [ qw /black/ ]) || die $graph->error;

		my @data = ([29,28,27,26,25,24,23,22,21,20,19,18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1,0],
						[@history]);
	
		my $gd = $graph->plot(\@data);
	
		print $q->header(-type=>'image/png',-expires=>'now');
		binmode STDOUT;
		print $gd->png;

	}elsif($q->param('utilizations')){

		my $sql = 'SELECT netblock,cidr FROM data WHERE netblock IS NOT NULL';
		my $sth = $d_dbh->prepare($sql);
		$sth->execute;
		my %used;
		while(my $row = $sth->fetchrow_arrayref){
			$used{$row->[0]} = $row->[1];
		}

		# now we have a built hash of what is in use
		# get info on what is total

		if($q->param('mode') eq 'full'){
			$sql = 'SELECT netblock,cidr FROM grandparent_networks';
		}else{
			$sql = 'SELECT netblock,cidr FROM parent_networks';
		}
		$sth = $d_dbh->prepare($sql);
		$sth->execute;
		my %total;
		while(my $row = $sth->fetchrow_arrayref){
			$total{$row->[0]} = $row->[1];
		}

		my ($string,@lines);
		my $r=0;
		for(map { $_->[0] }
			 sort { $a->[1] <=> $b->[1] ||
			        $a->[2] <=> $b->[2] ||
			        $a->[3] <=> $b->[3] ||
			        $a->[4] <=> $b->[4] }
			 map { [ $_, split /\./ ] } keys %total){

			my @netblocks = $ipmath->get_netblocks($_,$total{$_},30);
			my ($skip,$l);
			foreach my $block (@netblocks){
				$r++;
				if($skip){
					$string .= $l;
					$skip--;
				}else{
					if(my $cidr = $used{$block}){
						$string .= $e{$cidr};
						$l = $e{$cidr};
						if($cidr != 30){
							$skip = ((2 ** (30-$cidr)) - 1); # how many other 30s are in $cidr
						}
					}else{
						$string .= 'U';
					}
				}
				if($r == $length){
					push @lines, $string;
					$string = undef;
					$r=0;
				}
			}
		}
		push @lines, $string if($string);
		
		my $im = new GD::Image($cols,$rows);
		my %c = ( 'white' => $im->colorAllocate(255,255,255),
			       'black' => $im->colorAllocate(0,0,0) );
		$im->transparent($c{white});
		$im->interlaced('true');

		my $n=1;
		my $col=0;
		foreach my $line (@lines){
			if($n > $rows){
			   # need bigger image
				warn "overflow: $col\n";
			}else{
				$im->string($font,1,$col,$line,$c{black});
				$col += 10;
			}
			$n++;
		}
  
		my $line = 'Key: ';
		foreach my $key (reverse sort keys %e){
			$line .= $e{$key} . ' = /' . $key . ', ';
		}
		chop($line); chop($line);
		$col += 10;
		$im->string($font,54,$col,$line,$c{black});

		print $q->header(-type=>'image/png',-expires=>'now');
		binmode STDOUT;
		print $im->png();
	
	}else{
		print $q->header(), $q->start_html(),
				"confused\n",
				$q->end_html();
	}
}else{
	print $q->header(), $q->start_html(),
			"bad sess_id\n",
			$q->end_html();
}