listgraph.cgi
- About
- Sources

listgraph.cgi

listgraph.cgi is a web-frontend to render and display Email message statistics. An example is online at linuxaudio.org.

About

Listgraph is a perl CGI script based on mailgraph by David Schweikert using the RRDtool round-robin-database by T.Oetiker for data storage. Besides the CGI script (which generates and caches the images) there is a perl-script to write RRD from mbox data (here: mailman mboxes) which is invoked once a day by cron.

Sources

The configuration (paths, title, etc) is pragmatically included in the CGI executable and requires a bit of tinkering: colors and grid-boundaries have been optimized and hardcoded.

Invoke mbox2rrd.pl <path-to-mbox> to write /var/lib/listgraph/<mbox-file-name>.rrd¹⁾ database. - mbox2rrd counts the total number of emails (actually it takes the Date from From: .* lines) in the given mail box and is gauged to “messages per day”.

Note: mbox2rrd.pl must have permissions to read the mbox file and write to the rrd file, in turn this rrd file must be readable by the CGI script (www-user). last but not least the cgi-script writes/caches images to /var/cache/listgraph/. The paths are configured in the header section of both scripts.

Download listgraph.cgi, mbox2rrd.pl

view CGI source

#!/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;

view mbox-to-rrd source

#! /usr/bin/perl
use RRDs;
use Date::Parse;
 
my $mbox = shift;
my $dbpath = "/var/lib/listgraph/";
 
my $basename=$mbox;
$basename=~s/^.*\///g; # filename
$basename=~s/\.stats$//g; # extension
$basename=~s/\.mbox$//g; # extension
 
my %cnt;
open(INPUT, "< $mbox") or die 'can not open mbox file';
foreach (grep(/^From /, <INPUT>)) {
    ~m/^From ([^ ]*) (.*)$/;
    #print "N:".$1." -- D:$2 \n";
    my $t=str2time($2);
    my $d = int($t/86400);
    $cnt{$d}= 1 + $cnt{$d};
}
 
@dates= sort keys %cnt;
$start = @dates[0];
$end = @dates[-1];
 
my $t;
 
$rrd=$dbpath.$basename.".rrd";
RRDs::create ($rrd, "--start",((int($start)-1)*86400), "--step",86400,
          "DS:messages:GAUGE:100000:U:U",
          "RRA:AVERAGE:0.5:1:3650",
          "RRA:AVERAGE:0.5:7:500",
          "RRA:MIN:0.5:1:3650",
          "RRA:MAX:0.5:1:3650",
          "RRA:MIN:0.5:7:500",
          "RRA:MAX:0.5:7:500",
);
 
my $ERROR = RRDs::error;
die "$0: unable to create `$rrd': $ERROR\n" if $ERROR;
 
 
for ($t=$start; $t <=$end ;$t++) {
    RRDs::update $rrd, int($t*86400).":".int($cnt{$t});
    if ($ERROR = RRDs::error) {
        die "$0: unable to update `$rrd': $ERROR\n";
    }
}

FLOSS, WWW

¹⁾ default path used by listgraph.cgi