#!/usr/bin/perl -w

# listgraph -- a mbox statistics tool 
# copyright (c) 2007 Robin Gareus <robin@gareus.org>
# based on mailgraph, which is
# copyright (c) 2000-2002 David Schweikert <dws@ee.ethz.ch>
# released under the GNU General Public License

use RRDs;
use POSIX qw(uname);

my $VERSION = "0.1.1";

my $host = (POSIX::uname())[1];
my $scriptname = 'listgraph.cgi';
my $tmp_dir = '/var/cache/listgraph'; # tmp directory where to store the images

my $c0="70f040c0";
my $c1="f07040a0";
my $c2="70f040a0";
my $c3="7040f0a0";

#my $xpoints=540;
#my $ypoints=100;
my $xpoints=485;
my $ypoints=80;

my @graphs = (
	{ 
		title => 'linuxaudio.org mailing lists',
		seconds => 0,
		graph => 0
	},
	{ 
		title => 'linuxaudio.org mailing lists',
		seconds => 0,
		graph => 1
	},
	{ 
		title => 'Linux-Audio-User',
		seconds => 3600*24*365*3,
		graph => 2
	},
	{ 
		title => 'Linux-Audio-Dev',
		seconds => 3600*24*365*3,
		graph => 3
	},
	{ 
		title => 'Linux-Audio-Announce',
		seconds => 3600*24*365*3,
		graph => 4
	},
	{ 
		title => 'Linux-Audio-Tuning',
	#	seconds => 3600*24*365*.1,
		seconds => time() - 1214800000,
		graph => 5
	},
);

my %color = (
	sent     => '000099', # rrggbb in hex
	received => '00FF00',
	rejected => '999999', 
	bounced  => '993399',
	virus    => 'FFFF00',
	spam     => 'FF0000',
);

sub graph($$$$)
{
	my $graph = shift;
	my $file = shift;
	my $title = shift;
	my $range = shift;

	my $start=1031529600;
	my $end="now";
	if ($range > 0 ) {
		$start="-$range";
		$end="-".int($range*0.01);
	}

	my $date = localtime(time);
	$date =~ s|:|\\:|g;
	my $xgrid="MONTH:1:MONTH:6:MONTH:6:0:%b%Y";

	if ($graph == 0) {
	    my ($graphret,$xs,$ys) = RRDs::graph($file,
		'--imgformat', 'PNG',
		'--width', $xpoints,
		'--height', $ypoints,
		'--start', $start,
		'--end', $end,
 		'--x-grid', $xgrid,
	# LAO boundaries.
		"--lower-limit=0",
		"--upper-limit=90",
		"--rigid",
	#
  		'--vertical-label', 'msg per day',
		'--title', $title,
		'--lazy',
 		'--slope-mode',
			"DEF:lau=/var/lib/listgraph/lau.rrd:messages:AVERAGE",
			"DEF:lad=/var/lib/listgraph/lad.rrd:messages:AVERAGE",
			"DEF:laa=/var/lib/listgraph/laa.rrd:messages:AVERAGE",
			"AREA:lau#$c1:LAU",
			"AREA:lad#$c2:LAD",
			"AREA:laa#$c3:LAA",
            );
	} elsif ($graph == 1) {
	    my ($graphret,$xs,$ys) = RRDs::graph($file,
		'--imgformat', 'PNG',
		'--width', $xpoints,
		'--height', $ypoints,
		'--start', $start,
		'--end', $end,
 		'--x-grid', $xgrid,
	# LAO boundaries.
		"--lower-limit=0",
		"--upper-limit=90",
		"--rigid",
	#
  		'--vertical-label', 'msg per day',
		'--title', $title,
		'--lazy',
 		'--slope-mode',
			"DEF:lau=/var/lib/listgraph/lau.rrd:messages:AVERAGE",
			"DEF:lad=/var/lib/listgraph/lad.rrd:messages:AVERAGE",
			"DEF:laa=/var/lib/listgraph/laa.rrd:messages:AVERAGE",
			"AREA:lau#$c1:LAU",
			'GPRINT:lau:MAX:Maximum\: %0.0lf ',
			'GPRINT:lau:AVERAGE:Average\: %0.0lf/day\n',
			"AREA:lad#$c2:LAD",
			'GPRINT:lad:MAX:Maximum\: %0.0lf ',
			'GPRINT:lad:AVERAGE:Average\: %0.0lf/day\n',
			"AREA:laa#$c3:LAA",
			'GPRINT:laa:MAX:Maximum\: %0.0lf ',
			'GPRINT:laa:AVERAGE:Average\: %0.0lf/day\n',
		'HRULE:0#000000',
        	'COMMENT:\n',
 		'COMMENT:['.$date.']\r',
            );
	} else {
		# TODO: store rrd file-name in @graphs hash.
		# and pass as argument to graph()
		# or better pass a hash to graph()
		# check upstream: mailgraph, etc.
	    my $name="lau";
	    my $rrd="/var/lib/listgraph/lau.rrd";
	    if ($graph == 3) {
	      $name="lad";
	      $rrd="/var/lib/listgraph/lad.rrd";
	    }
	    if ($graph == 4) {
	      $name="laa";
	      $rrd="/var/lib/listgraph/laa.rrd";
	    }
	    if ($graph == 5) {
	      $name="lat";
	      $rrd="/var/lib/listgraph/lat.rrd";
	    }
	    my ($graphret,$xs,$ys) = RRDs::graph($file,
		'--imgformat', 'PNG',
		'--width', $xpoints,
		'--height', $ypoints,
		'--start', $start,
		'--end', $end,
 		'--x-grid', $xgrid,
	# LAO boundaries.
	#	"--lower-limit=0",
	#	"--upper-limit=90",
	#	"--rigid",
	#
  		'--vertical-label', 'msg per day',
		'--title', $title,
		'--lazy',
 		'--slope-mode',
			"DEF:$name=$rrd:messages:AVERAGE",
			"AREA:$name#$c0:".uc($name),
			"GPRINT:$name:MAX:Maximum".'\: %0.0lf ',
			"GPRINT:$name:AVERAGE:Average".'\: %0.0lf/day\n',
            );
	}
	my $ERR=RRDs::error;
	die "ERROR: $ERR\n" if $ERR;
}

sub print_html()
{
	print "Content-Type: text/html\n\n";

	print <<HEADER;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/REC-html40/loose.dtd">
<HTML>
<HEAD>
<TITLE>Message Statistics for $host</TITLE>
<link rel="stylesheet" type="text/css" media="all" href="/style.css">
</HEAD>
<BODY BGCOLOR="#FFFFFF">
<div id="back">
<a href="/">stats overview</a><br>
<br><h3>MRTG</h3>
<a href="/mrtg/">brief</a><br>
<a href="/mrtg/index_all.html">all</a><br>
<a href="/mrtg/index_cpu.html">processor</a><br>
<a href="/mrtg/index_mem.html">memory</a><br>
<a href="/mrtg/index_dsk.html">disk</a><br>
<a href="/mrtg/index_net.html">network</a><br>
<br><h3>Email</h3>
<a href="/cgi-bin/mailgraph.cgi">Mail Statistics</a><br>
<a href="/cgi-bin/queuegraph.cgi">Queue Statistics</a>
</div><div id="page">
HEADER

	print "<H1>Message Statistics for $host</H1>\n";
	print '<div style="padding-left:44px;">';
	for my $n (0..$#graphs) {
		print '<div style="background: #dddddd; width: 600px">';
		print "<H2>$graphs[$n]{title}</H2>\n";
		print "</div>\n";
		print "<P><IMG BORDER=\"0\" SRC=\"$scriptname/listgraph_${n}.png\" ALT=\"listgraph\">\n";
	}
	print "</div>";

	print <<FOOTER;
<div id="footer" style="padding: 4px 0px 5px 44px;">
<table border="0" width="600"><tr><td align="left">
listgraph $VERSION by Robin Gareus,
based on <A href="http://people.ee.ethz.ch/~dws/software/mailgraph">mailgraph</A> 
by <A href="http://people.ee.ethz.ch/~dws/">David Schweikert</A></td>
<td ALIGN="right">
</td></tr></table></div></div>
</BODY>
FOOTER
}

sub send_image($)
{
	my $file = shift;
	-r $file or do {
		print "Content-Type: text/plain\n\nERROR: can't find $file\n";
		exit 1;
	};

	print "Content-Type: image/png\n";
	print "Content-Length: ".((stat($file))[7])."\n";
	print "\n";
	open(IMG, $file) or die;
	my $data;
	print $data while read IMG, $data, 1;
}

sub main()
{
	if($ENV{PATH_INFO}) {
		my $uri = $ENV{REQUEST_URI};
		$uri =~ s/\/[^\/]+$//;
		$uri =~ s/\//,/g;
		$uri =~ s/(\~|\%7E)/tilde,/g;
		mkdir $tmp_dir, 0777 unless -d $tmp_dir;
		mkdir "$tmp_dir/$uri", 0777 unless -d "$tmp_dir/$uri";
		my $file = "$tmp_dir/$uri$ENV{PATH_INFO}";
		if($ENV{PATH_INFO} =~ /^\/listgraph_(\d+)\.png$/) {
			graph($graphs[$1]{graph}, $file, $graphs[$1]{title}, $graphs[$1]{seconds});
		}
		else {
			print "Content-Type: text/plain\n\nERROR: unknown image $ENV{PATH_INFO}\n";
			exit 1;
		}
		send_image($file);
	}
	else {
		print_html;
	}
}

main;
