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