#!/usr/bin/perl -w

# mxgraphs -- detailed postfix mail traffic statistics
# copyright (c) 2000-2007 ETH Zurich
# copyright (c) 2000-2007 David Schweikert <david@schweikert.ch>
# modifed 2011 for grey Markus Neubauer <neubauer@std-service.com>
# modified 2013 for mxgraphs by Django <django@it-ignorant.de>
# released under the GNU General Public License

use RRDs;
use POSIX qw(uname);

my $VERSION = "0.02";

my $host = (POSIX::uname())[1];
my $scriptname = 'mxgraphs.cgi';
my $xpoints = 800;
my $points_per_sample = 3;
my $ypoints = 160;
my $ypoints_err = 160;
my $ypoints_grey = 160;
my $ypoints_greydetail = 160;
my $ypoints_queue = 160;
my $rrd = '/var/lib/mailgraph/mailgraph.rrd';                           # path to where the Mailgraph RRD database is
my $rrd_virus = '/var/lib/mailgraph/mailgraph_virus.rrd';               # path to where the Virus     RRD database is
my $rrd_queue = '/var/lib/queuegraph/mailqueues.rrd';                   # path to where the Mailqueue RRD database is
my $rrd_grey = '/var/lib/greygraph/greygraph.rrd';                      # path to where the Greygraph RRD database is
my $rrd_spam = '/var/lib/greygraph/greygraph_spam.rrd';                 # path to where the Spam      RRD database is
my $tmp_dir = '/var/cache/mxgraphs';                                    # temporary directory where to store the images

my @graphs = (
        { title => 'Letzten 24 Stunden', seconds => 3600*24,     },
        { title => 'Letzten 7 Tage',     seconds => 3600*24*7,   },
        { title => 'Letzten 31 Tage',    seconds => 3600*24*31,  },
        { title => 'Letzten 12 Monate',  seconds => 3600*24*365, },
);

my %color = (
        sent        => '000099',                                        # rrggbb in hex
        received    => '009900',
        whitelist   => '999999',
        new         => 'C1C1C1',
        early       => 'AA0000', 
        qspam       => '000000',
        awl         => 'DDBB00',
        reconnectok => '88FF00',
        rejected    => 'AA0000', 
        bounced     => '000000',
        virus       => 'DDBB00',
        spam        => '999999',
        active      => 'EFEF00',
        deferred    => 'DD8800',
);

sub rrd_graph(@)
        {
        my ($range, $file, $ypoints, @rrdargs) = @_;
        my $step = $range*$points_per_sample/$xpoints;
        my $end  = time; $end -= $end % $step;
        my $date = localtime(time);
        $date =~ s|:|\\:|g unless $RRDs::VERSION < 1.199908;

        my ($graphret,$xs,$ys) = RRDs::graph($file,
                '--imgformat', 'PNG',
                '--width', $xpoints,
                '--height', $ypoints,
                '--start', "-$range",
                '--end', $end,
                '--vertical-label', 'msgs/min',
                '--lower-limit', 0,
                '--units-exponent', 0,                                  # don't show milli-messages/s
                '--lazy',
                '--color', 'SHADEA#ffffff',
                '--color', 'SHADEB#ffffff',
                '--color', 'BACK#ffffff',

                $RRDs::VERSION < 1.2002 ? () : ( '--slope-mode'),

                @rrdargs,

                'COMMENT:['.$date.']\r',
        );
        my $ERR=RRDs::error;
        die "ERROR: $ERR\n" if $ERR;
}


sub graph($$)
        {
        my ($range, $file) = @_;
        my $step = $range*$points_per_sample/$xpoints;
        rrd_graph($range, $file, $ypoints,

                "DEF:sent=$rrd:sent:AVERAGE",
                "DEF:msent=$rrd:sent:MAX",
                "CDEF:rsent=sent,60,*",
                "CDEF:rmsent=msent,60,*",
                "CDEF:dsent=sent,UN,0,sent,IF,$step,*",
                "CDEF:ssent=PREV,UN,dsent,PREV,IF,dsent,+",
                "AREA:rsent#$color{sent}:Sent                    ",
                'GPRINT:ssent:MAX:total\: %15.0lf msgs',
                'GPRINT:rsent:AVERAGE:avg\: %12.2lf msgs/min',
                'GPRINT:rmsent:MAX:max\: %11.0lf msgs/min\l',

                "DEF:recv=$rrd:recv:AVERAGE",
                "DEF:mrecv=$rrd:recv:MAX",
                "CDEF:rrecv=recv,60,*",
                "CDEF:rmrecv=mrecv,60,*",
                "CDEF:drecv=recv,UN,0,recv,IF,$step,*",
                "CDEF:srecv=PREV,UN,drecv,PREV,IF,drecv,+",
                "LINE2:rrecv#$color{received}:Received                ",
                'GPRINT:srecv:MAX:total\: %15.0lf msgs',
                'GPRINT:rrecv:AVERAGE:avg\: %12.2lf msgs/min',
                'GPRINT:rmrecv:MAX:max\: %11.0lf msgs/min\l',
        );
}


sub graph_err($$)
        {
        my ($range, $file) = @_;
        my $step = $range*$points_per_sample/$xpoints;
        rrd_graph($range, $file, $ypoints_err,

                "DEF:bounced=$rrd:bounced:AVERAGE",
                "DEF:mbounced=$rrd:bounced:MAX",
                "CDEF:rbounced=bounced,60,*",
                "CDEF:dbounced=bounced,UN,0,bounced,IF,$step,*",
                "CDEF:sbounced=PREV,UN,dbounced,PREV,IF,dbounced,+",
                "CDEF:rmbounced=mbounced,60,*",
                "AREA:rbounced#$color{bounced}:Bounced                 ",
                'GPRINT:sbounced:MAX:total\: %15.0lf msgs',
                'GPRINT:rbounced:AVERAGE:avg\: %12.2lf msgs/min',
                'GPRINT:rmbounced:MAX:max\: %11.0lf msgs/min\l',

                "DEF:virus=$rrd_virus:virus:AVERAGE",
                "DEF:mvirus=$rrd_virus:virus:MAX",
                "CDEF:rvirus=virus,60,*",
                "CDEF:dvirus=virus,UN,0,virus,IF,$step,*",
                "CDEF:svirus=PREV,UN,dvirus,PREV,IF,dvirus,+",
                "CDEF:rmvirus=mvirus,60,*",
                "STACK:rvirus#$color{virus}:Viruses                 ",
                'GPRINT:svirus:MAX:total\: %15.0lf msgs',
                'GPRINT:rvirus:AVERAGE:avg\: %12.2lf msgs/min',
                'GPRINT:rmvirus:MAX:max\: %11.0lf msgs/min\l',

                "DEF:spam=$rrd_virus:spam:AVERAGE",
                "DEF:mspam=$rrd_virus:spam:MAX",
                "CDEF:rspam=spam,60,*",
                "CDEF:dspam=spam,UN,0,spam,IF,$step,*",
                "CDEF:sspam=PREV,UN,dspam,PREV,IF,dspam,+",
                "CDEF:rmspam=mspam,60,*",
                "STACK:rspam#$color{spam}:Spam                    ",
                'GPRINT:sspam:MAX:total\: %15.0lf msgs',
                'GPRINT:rspam:AVERAGE:avg\: %12.2lf msgs/min',
                'GPRINT:rmspam:MAX:max\: %11.0lf msgs/min\l',

                "DEF:rejected=$rrd:rejected:AVERAGE",
                "DEF:mrejected=$rrd:rejected:MAX",
                "CDEF:rrejected=rejected,60,*",
                "CDEF:drejected=rejected,UN,0,rejected,IF,$step,*",
                "CDEF:srejected=PREV,UN,drejected,PREV,IF,drejected,+",
                "CDEF:rmrejected=mrejected,60,*",
                "LINE2:rrejected#$color{rejected}:Rejected                ",
                'GPRINT:srejected:MAX:total\: %15.0lf msgs',
                'GPRINT:rrejected:AVERAGE:avg\: %12.2lf msgs/min',
                'GPRINT:rmrejected:MAX:max\: %11.0lf msgs/min\l',

        );
}


sub graph_queue($$)
        {
        my ($range, $file) = @_;
        my $step = $range*$points_per_sample/$xpoints;
        rrd_graph($range, $file, $ypoints_queue,
                "DEF:deferred=$rrd_queue:deferred:AVERAGE",
                "AREA:deferred#$color{deferred}:Deferred                ",
                'GPRINT:deferred:MAX:total\: %15.0lf msgs',
                'GPRINT:deferred:AVERAGE:avg\: %12.2lf msgs/min',
                'GPRINT:deferred:MAX:max\: %11.0lf msgs/min\l',

                "DEF:active=$rrd_queue:active:AVERAGE",
                "LINE2:active#$color{active}:Active+Incoming+Maildrop",
                'GPRINT:active:MAX:total\: %15.0lf msgs',
                'GPRINT:active:AVERAGE:avg\: %12.2lf msgs/min',
                'GPRINT:active:MAX:max\: %11.0lf msgs/min\l',
        );
}


sub graph_grey($$)
        {
        my ($range, $file) = @_;
        my $step = $range*$points_per_sample/$xpoints;
        rrd_graph($range, $file, $ypoints_grey,

                "DEF:new=$rrd_grey:new:AVERAGE",
                "DEF:mnew=$rrd_grey:new:MAX",
                "CDEF:rnew=new,60,*",
                "CDEF:rmnew=mnew,60,*",
                "CDEF:dnew=new,UN,0,new,IF,$step,*",
                "CDEF:snew=PREV,UN,dnew,PREV,IF,dnew,+",
                "LINE2:rnew#$color{new}:New                     ",
                'GPRINT:snew:MAX:total\: %15.0lf msgs',
                'GPRINT:rnew:AVERAGE:avg\: %12.2lf msgs/min',
                'GPRINT:rmnew:MAX:max\: %11.0lf msgs/min\l',

                "DEF:reconnectok=$rrd_spam:reconnectok:AVERAGE",
                "DEF:mreconnectok=$rrd_spam:reconnectok:MAX",
                "CDEF:rreconnectok=reconnectok,60,*",
                "CDEF:dreconnectok=reconnectok,UN,0,reconnectok,IF,$step,*",
                "CDEF:sreconnectok=PREV,UN,dreconnectok,PREV,IF,dreconnectok,+",
                "CDEF:rmreconnectok=mreconnectok,60,*",
                "LINE2:rreconnectok#$color{reconnectok}:Reconnect O.K.          ",
                'GPRINT:sreconnectok:MAX:total\: %15.0lf msgs',
                'GPRINT:rreconnectok:AVERAGE:avg\: %12.2lf msgs/min',
                'GPRINT:rmreconnectok:MAX:max\: %11.0lf msgs/min\l',

        );
}


sub graph_greydetail($$)
{
        my ($range, $file) = @_;
        my $step = $range*$points_per_sample/$xpoints;
        rrd_graph($range, $file, $ypoints_greydetail,

                "DEF:whitelist=$rrd_grey:whitelist:AVERAGE",
                "DEF:mwhitelist=$rrd_grey:whitelist:MAX",
                "CDEF:rwhitelist=whitelist,60,*",
                "CDEF:rmwhitelist=mwhitelist,60,*",
                "CDEF:dwhitelist=whitelist,UN,0,whitelist,IF,$step,*",
                "CDEF:swhitelist=PREV,UN,dwhitelist,PREV,IF,dwhitelist,+",
                "LINE2:rwhitelist#$color{whitelist}:Whitelist               ",
                'GPRINT:swhitelist:MAX:total\: %15.0lf msgs',
                'GPRINT:rwhitelist:AVERAGE:avg\: %12.2lf msgs/min',
                'GPRINT:rmwhitelist:MAX:max\: %11.0lf msgs/min\l',

                "DEF:awl=$rrd_grey:awl:AVERAGE",
                "DEF:mawl=$rrd_grey:awl:MAX",
                "CDEF:rawl=awl,60,*",
                "CDEF:dawl=awl,UN,0,awl,IF,$step,*",
                "CDEF:sawl=PREV,UN,dawl,PREV,IF,dawl,+",
                "CDEF:rmawl=mawl,60,*",
                "LINE2:rawl#$color{awl}:Auto whitelist          ",
                'GPRINT:sawl:MAX:total\: %15.0lf msgs',
                'GPRINT:rawl:AVERAGE:avg\: %12.2lf msgs/min',
                'GPRINT:rmawl:MAX:max\: %11.0lf msgs/min\l',

                "DEF:spam=$rrd_spam:spam:AVERAGE",
                "DEF:mspam=$rrd_spam:spam:MAX",
                "CDEF:rspam=spam,60,*",
                "CDEF:dspam=spam,UN,0,spam,IF,$step,*",
                "CDEF:sspam=PREV,UN,dspam,PREV,IF,dspam,+",
                "CDEF:rmspam=mspam,60,*",
                "LINE2:rspam#$color{qspam}:Spam                    ",
                'GPRINT:sspam:MAX:total\: %15.0lf msgs',
                'GPRINT:rspam:AVERAGE:avg\: %12.2lf msgs/min',
                'GPRINT:rmspam:MAX:max\: %11.0lf msgs/min\l',

                "DEF:early=$rrd_grey:early:AVERAGE",
                "DEF:mearly=$rrd_grey:early:MAX",
                "CDEF:rearly=early,60,*",
                "CDEF:dearly=early,UN,0,early,IF,$step,*",
                "CDEF:searly=PREV,UN,dearly,PREV,IF,dearly,+",
                "CDEF:rmearly=mearly,60,*",
                "STACK:rearly#$color{early}:Early connect           ",
                'GPRINT:searly:MAX:total\: %15.0lf msgs',
                'GPRINT:rearly:AVERAGE:avg\: %12.2lf msgs/min',
                'GPRINT:rmearly:MAX:max\: %11.0lf msgs/min\l',

        );
}


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

        print <<HEADER;
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html>
 <head>
  <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
  <title>Mailserver Statistiken auf $host</title>
  <meta http-equiv="Refresh" content="300" />
  <meta http-equiv="Pragma" content="no-cache" />
  <link rel="stylesheet" href="mxgraphs.css" type="text/css" />
 </head>
 <body>
HEADER

        print "<h1>Mailserver Statistiken f&uuml;r<br>$host</h1>\n";

        print "<ul id=\"jump\">\n";
        for my $n (0..$#graphs) {
                print "  <li><a href=\"#G$n\">$graphs[$n]{title}</a>&nbsp;</li>\n";
        }
        print "</ul>\n";

        for my $n (0..$#graphs) {
                print "<h2 id=\"G$n\">$graphs[$n]{title}</h2>\n";
                print "<p><img src=\"$scriptname?${n}-n\" alt=\"mxgraphs - received and sent\"/></p>\n";
                print "<p><img src=\"$scriptname?${n}-e\" alt=\"mxgraphs - blocked\"/></p>\n";
                print "<p><img src=\"$scriptname?${n}-g\" alt=\"mxgraphs - greylisted\"/></p>\n";
                print "<p><img src=\"$scriptname?${n}-d\" alt=\"mxgraphs - greylisted (detailed)\"/></p>\n";
                print "<p><img src=\"$scriptname?${n}-q\" alt=\"mxgraphs - mailqueues\"/></p>\n";
        }

        print <<FOOTER;
 <hr/>
  <table border="0" style="font-size:12px" width="900">
   <colgroup>
    <col width="200">
    <col width="425">
    <col width="123">
   </colgroup>
   <tr class="row0">
    <td class="col0 leftalign">
     <a href="http://dokuwiki.nausch.org/doku.php/centos:mail_c6:mta_11#mxgraphs">MX-Graphs </a>$VERSION by 
     <a href="mailto:django@it-ignorant.org?subject=MX-Graphs%20for%20my%20Mailserver">Django</a> based on
    </td>
    <td>
     <a href="http://david.schweikert.ch/">David Schweikert's</a> <a href="http://mailgraph.schweikert.ch/">Mailgraph</a>, 
    </td>
    <td class="col2 rightalign" rowspan="3"> 
     <a href="http://oss.oetiker.ch/rrdtool/"><img src="rrdtool-3dlogo.png" alt="" width="135" height="50" align="right" align="middle"/></a>
    </td>
   </tr>
   <tr class="row1">
    <td class="col0 leftalign">          
    </td>
    <td class="col1 leftalign">
     <a href="http://www.gichenbacher.de/kontakt">Markus Neubauer's </a> 
     <a href="http://www.std-soft.com/bfaq/46-k-faq-server/117-greygraph-mail-statistik.html">Greygraph</a> and
    </td>
   </tr>
   <tr class="row2">
    <td class="col0 leftalign">          
    </td>
    <td class="col1 leftalign"> 
     <a href="http://www.arschkrebs.de/">Ralf Hildebrandt's </a><a href="http://www.arschkrebs.de/postfix/queuegraph">Queuegraph</a>.  
    </td>
   </tr>
  </table>
 </body>
</html>
FOOTER
}

sub send_image($)
{
        my ($file)= @_;

        -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, 16384)>0;
}

sub main()
{
        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 $img = $ENV{QUERY_STRING};
        if(defined $img and $img =~ /\S/) {
                if($img =~ /^(\d+)-n$/) {
                        my $file = "$tmp_dir/$uri/mxgraph_$1.png";
                        graph($graphs[$1]{seconds}, $file);
                        send_image($file);
                }
                elsif($img =~ /^(\d+)-e$/) {
                        my $file = "$tmp_dir/$uri/mxgraph_$1_err.png";
                        graph_err($graphs[$1]{seconds}, $file);
                        send_image($file);
                }
                elsif($img =~ /^(\d+)-g$/) {
                        my $file = "$tmp_dir/$uri/mxgraph_$1_grey.png";
                        graph_grey($graphs[$1]{seconds}, $file);
                        send_image($file);
                }
                elsif($img =~ /^(\d+)-d$/) {
                        my $file = "$tmp_dir/$uri/mxgraph_$1_greydetail.png";
                        graph_greydetail($graphs[$1]{seconds}, $file);
                        send_image($file);
                }
                elsif($img =~ /^(\d+)-q$/) {
                        my $file = "$tmp_dir/$uri/mxgraph_$1_queue.png";
                        graph_queue($graphs[$1]{seconds}, $file);
                        send_image($file);
                }
                else {
                        die "ERROR: invalid argument\n";
                }
        }
        else {
                print_html;
        }
}

main;