1 #!/usr/bin/perl
3 # Copyright (C) 2008-2011 Florian Forster
4 # Copyright (C) 2011 noris network AG
5 #
6 # This program is free software; you can redistribute it and/or modify it under
7 # the terms of the GNU General Public License as published by the Free Software
8 # Foundation; only version 2 of the License is applicable.
9 #
10 # This program is distributed in the hope that it will be useful, but WITHOUT
11 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 # FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
13 # details.
14 #
15 # You should have received a copy of the GNU General Public License along with
16 # this program; if not, write to the Free Software Foundation, Inc.,
17 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
18 #
19 # Authors:
20 # Florian "octo" Forster <octo at collectd.org>
22 use strict;
23 use warnings;
24 use utf8;
25 use vars (qw($BASE_DIR));
27 BEGIN
28 {
29 if (defined $ENV{'SCRIPT_FILENAME'})
30 {
31 if ($ENV{'SCRIPT_FILENAME'} =~ m{^(/.+)/bin/[^/]+$})
32 {
33 $BASE_DIR = $1;
34 unshift (@INC, "$BASE_DIR/lib");
35 }
36 }
37 }
39 use Carp (qw(confess cluck));
40 use CGI (':cgi');
41 use RRDs ();
42 use File::Temp (':POSIX');
44 use Collectd::Graph::Config (qw(gc_read_config gc_get_scalar));
45 use Collectd::Graph::TypeLoader (qw(tl_load_type));
47 use Collectd::Graph::Common (qw(sanitize_type get_selected_files
48 epoch_to_rfc1123 flush_files));
49 use Collectd::Graph::Type ();
51 $::MODPERL = 1;
53 my $have_init = 0;
54 sub init
55 {
56 if ($have_init)
57 {
58 return;
59 }
61 #gc_read_config ("$RealBin/../etc/collection.conf");
62 gc_read_config ("$BASE_DIR/etc/collection.conf");
64 $have_init = 1;
65 }
67 sub main
68 {
69 my $Begin = param ('begin');
70 my $End = param ('end');
71 my $GraphWidth = param ('width');
72 my $GraphHeight = param ('height');
73 my $Index = param ('index') || 0;
74 my $OutputFormat = 'PNG';
75 my $ContentType = 'image/png';
77 if (param ('format'))
78 {
79 my $temp = param ('format') || '';
80 $temp = uc ($temp);
82 if ($temp =~ m/^(PNG|SVG|EPS|PDF)$/)
83 {
84 $OutputFormat = $temp;
86 if ($OutputFormat eq 'SVG') { $ContentType = 'image/svg+xml'; }
87 elsif ($OutputFormat eq 'EPS') { $ContentType = 'image/eps'; }
88 elsif ($OutputFormat eq 'PDF') { $ContentType = 'application/pdf'; }
89 }
90 }
92 if (param ('debug'))
93 {
94 print <<HTTP;
95 Content-Type: text/plain
97 HTTP
98 $ContentType = 'text/plain';
99 }
101 init ();
103 if ($GraphWidth)
104 {
105 $GraphWidth =~ s/\D//g;
106 }
108 if (!$GraphWidth)
109 {
110 $GraphWidth = gc_get_scalar ('GraphWidth', 400);
111 }
113 if ($GraphHeight)
114 {
115 $GraphHeight =~ s/\D//g;
116 }
118 if (!$GraphHeight)
119 {
120 $GraphHeight = gc_get_scalar ('GraphHeight', 100);
121 }
123 { # Sanitize begin and end times
124 $End ||= 0;
125 $Begin ||= 0;
127 if ($End =~ m/\D/)
128 {
129 $End = 0;
130 }
132 if (!$Begin || !($Begin =~ m/^-?([1-9][0-9]*)$/))
133 {
134 $Begin = -86400;
135 }
137 if ($Begin < 0)
138 {
139 if ($End)
140 {
141 $Begin = $End + $Begin;
142 }
143 else
144 {
145 $Begin = time () + $Begin;
146 }
147 }
149 if ($Begin < 0)
150 {
151 $Begin = time () - 86400;
152 }
154 if (($End > 0) && ($Begin > $End))
155 {
156 my $temp = $End;
157 $End = $Begin;
158 $Begin = $temp;
159 }
160 }
162 my $type = param ('type') or die;
163 my $obj;
165 $obj = tl_load_type ($type);
166 if (!$obj)
167 {
168 confess ("tl_load_type ($type) failed");
169 }
171 $type = ucfirst (lc ($type));
172 $type =~ s/_([A-Za-z])/\U$1\E/g;
173 $type = sanitize_type ($type);
175 my $files = get_selected_files ();
176 if (param ('debug'))
177 {
178 require Data::Dumper;
179 print Data::Dumper->Dump ([$files], ['files']);
180 }
181 for (@$files)
182 {
183 $obj->addFiles ($_);
184 }
186 my $expires = time ();
187 # IF (End is `now')
188 # OR (Begin is before `now' AND End is after `now')
189 if (($End == 0) || (($Begin <= $expires) && ($End >= $expires)))
190 {
191 # 400 == width in pixels
192 my $timespan;
194 if ($End == 0)
195 {
196 $timespan = $expires - $Begin;
197 }
198 else
199 {
200 $timespan = $End - $Begin;
201 }
202 $expires += int ($timespan / 400.0);
203 }
204 # IF (End is not `now')
205 # AND (End is before `now')
206 # ==> Graph will never change again!
207 elsif (($End > 0) && ($End < $expires))
208 {
209 $expires += (366 * 86400);
210 }
211 elsif ($Begin > $expires)
212 {
213 $expires = $Begin;
214 }
216 # Send FLUSH command to the daemon if necessary and possible.
217 flush_files ($files,
218 begin => $Begin,
219 end => $End,
220 addr => gc_get_scalar ('UnixSockAddr', undef),
221 interval => gc_get_scalar ('Interval', 10));
223 print header (-Content_type => $ContentType,
224 -Last_Modified => epoch_to_rfc1123 ($obj->getLastModified ()),
225 -Expires => epoch_to_rfc1123 ($expires));
227 if (param ('debug'))
228 {
229 print "\$expires = $expires;\n";
230 }
232 my $args = $obj->getRRDArgs (0 + $Index);
233 if (param ('debug'))
234 {
235 require Data::Dumper;
236 print Data::Dumper->Dump ([$obj], ['obj']);
237 print join (",\n", @$args) . "\n";
238 print "Last-Modified: " . epoch_to_rfc1123 ($obj->getLastModified ()) . "\n";
239 }
240 else
241 {
242 my @timesel = ();
243 my $tmpfile = tmpnam ();
244 my $status;
246 if ($End) # $Begin is always true
247 {
248 @timesel = ('-s', $Begin, '-e', $End);
249 }
250 else
251 {
252 @timesel = ('-s', $Begin); # End is implicitely `now'.
253 }
255 if (-S "/var/run/rrdcached.sock" && -w "/var/run/rrdcached.sock")
256 {
257 $ENV{"RRDCACHED_ADDRESS"} = "/var/run/rrdcached.sock";
258 }
259 unlink ($tmpfile);
260 RRDs::graph ($tmpfile, '-a', $OutputFormat, '--width', $GraphWidth, '--height', $GraphHeight, @timesel, @$args);
261 if (my $err = RRDs::error ())
262 {
263 print STDERR "RRDs::graph failed: $err\n";
264 exit (1);
265 }
267 $status = open (IMG, '<', $tmpfile) or die ("open ($tmpfile): $!");
268 if (!$status)
269 {
270 print STDERR "graph.cgi: Unable to open temporary file \"$tmpfile\" for reading: $!\n";
271 }
272 else
273 {
274 local $/ = undef;
275 while (my $data = <IMG>)
276 {
277 print STDOUT $data;
278 }
280 close (IMG);
281 unlink ($tmpfile);
282 }
283 }
284 } # sub main
286 main ();
288 # vim: set shiftwidth=2 softtabstop=2 tabstop=8 :