1#!/usr/local/bin/perl 2 3# $Id: graph.cgi,v 1.45 2011/06/28 00:13:48 sbajic Exp $ 4# DSPAM 5# COPYRIGHT (C) 2002-2012 DSPAM PROJECT 6# 7# This program is free software: you can redistribute it and/or modify 8# it under the terms of the GNU Affero General Public License as 9# published by the Free Software Foundation, either version 3 of the 10# License, or (at your option) any later version. 11# 12# This program is distributed in the hope that it will be useful, 13# but WITHOUT ANY WARRANTY; without even the implied warranty of 14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15# GNU Affero General Public License for more details. 16# 17# You should have received a copy of the GNU Affero General Public License 18# along with this program. If not, see <http://www.gnu.org/licenses/>. 19 20use CGI ':standard'; 21use GD::Graph::lines3d; 22use GD::Graph::lines; 23use strict; 24use vars qw { %CONFIG %FORM %LANG $LANGUAGE @spam_day @nonspam_day @period @data }; 25 26# 27# Read configuration parameters common to all CGI scripts 28# 29if (!(-e "configure.pl") || !(-r "configure.pl")) { 30 &htmlheader; 31 print "<html><head><title>Error!</title></head><body bgcolor='white' text='black'><center><h1>"; 32 print "Missing file configure.pl"; 33 print "</h1></center></body></html>\n"; 34 exit; 35} 36require "configure.pl"; 37 38# 39# Parse form 40# 41%FORM = &ReadParse(); 42 43# 44# Configure languages 45# 46 47if ($FORM{'language'} ne "") { 48 $LANGUAGE = $FORM{'language'}; 49} else { 50 $LANGUAGE = $CONFIG{'LANGUAGE_USED'}; 51} 52if (! defined $CONFIG{'LANG'}->{$LANGUAGE}->{'NAME'}) { 53 $LANGUAGE = $CONFIG{'LANGUAGE_USED'}; 54} 55 56GD::Graph::colour::read_rgb("rgb.txt"); 57 58do { 59 my($spam, $nonspam, $period) = split(/\_/, $FORM{'data'}); 60 @spam_day = split(/\,/, $spam); 61 @nonspam_day = split(/\,/, $nonspam); 62 @period = split(/\,/, $period); 63}; 64 65@data = ([@period], [@spam_day], [@nonspam_day]); 66my $mygraph; 67if ($CONFIG{'3D_GRAPHS'} == 1) { 68 $mygraph = GD::Graph::lines3d->new(500, 200); 69} else { 70 $mygraph = GD::Graph::lines->new(500, 200); 71} 72$mygraph->set( 73 x_label => "$CONFIG{'LANG'}->{$LANGUAGE}->{'graph_legend_x_label_'.$FORM{'x_label'}}", 74 y_label => "$CONFIG{'LANG'}->{$LANGUAGE}->{'graph_legend_nb_messages'}", 75# title => "$FORM{'title'}", 76 line_width => 2, 77 dclrs => [ qw(lred dgreen) ], 78 fgclr => 'gray85', 79 boxclr => 'gray95', 80 textclr => 'black', 81 legendclr => 'black', 82 labelclr => 'gray60', 83 axislabelclr => 'gray40', 84 long_ticks => 1, 85 show_values => 0 86) or warn $mygraph->error; 87 88# dclrs => [ qw( darkorchid2 mediumvioletred deeppink darkturquoise ) ], 89 90if (defined $CONFIG{'GRAPHS_X_LABEL_FONT'} && $CONFIG{'GRAPHS_X_LABEL_FONT'} ne "" && -r $CONFIG{'GRAPHS_X_LABEL_FONT'}) { 91 $mygraph->set_x_label_font([$CONFIG{'GRAPHS_X_LABEL_FONT'}, GD::gdMediumBoldFont, 'verdana', 'arial'], 8); 92} else { 93 $mygraph->set_x_label_font(GD::gdMediumBoldFont); 94} 95if (defined $CONFIG{'GRAPHS_Y_LABEL_FONT'} && $CONFIG{'GRAPHS_Y_LABEL_FONT'} ne "" && -r $CONFIG{'GRAPHS_Y_LABEL_FONT'}) { 96 $mygraph->set_y_label_font([$CONFIG{'GRAPHS_Y_LABEL_FONT'}, GD::gdMediumBoldFont, 'verdana', 'arial'], 8); 97} else { 98 $mygraph->set_y_label_font(GD::gdMediumBoldFont); 99} 100if (defined $CONFIG{'GRAPHS_LEGEND_FONT'} && $CONFIG{'GRAPHS_LEGEND_FONT'} ne "" && -r $CONFIG{'GRAPHS_LEGEND_FONT'}) { 101 $mygraph->set_legend_font([$CONFIG{'GRAPHS_LEGEND_FONT'}, GD::gdMediumBoldFont, 'verdana', 'arial'], 8); 102} else { 103 $mygraph->set_legend_font(GD::gdMediumBoldFont); 104} 105$mygraph->set_legend("$CONFIG{'LANG'}->{$LANGUAGE}->{'graph_legend_spam'}","$CONFIG{'LANG'}->{$LANGUAGE}->{'graph_legend_good'}"); 106my $myimage = $mygraph->plot(\@data) or die $mygraph->error; 107 108print "Content-type: image/png\n\n"; 109print $myimage->png; 110 111sub ReadParse { 112 my(@pairs, %FORM); 113 if ($ENV{'REQUEST_METHOD'} =~ /GET/i) 114 { @pairs = split(/&/, $ENV{'QUERY_STRING'}); } 115 else { 116 my($buffer); 117 read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); 118 @pairs = split(/\&/, $buffer); 119 } 120 foreach(@pairs) { 121 my($name, $value) = split(/\=/, $_); 122 123 $name =~ tr/+/ /; 124 $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; 125 $value =~ tr/+/ /; 126 $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; 127 $value =~ s/<!--(.|\n)*-->//g; 128 $FORM{$name} = $value; 129 } 130 return %FORM; 131} 132 133sub htmlheader { 134 print "Expires: now\n"; 135 print "Pragma: no-cache\n"; 136 print "Cache-control: no-cache\n"; 137 print "Content-type: text/html\n\n"; 138} 139