chiark / gitweb /
9aee6434928c7a58fe56465616b054546e645ba1
[rrd-graphs.git] / cgi
1 #!/usr/bin/perl -w
2
3 use strict qw(vars);
4 use CGI qw/:standard -no_xhtml/;
5
6 sub fail ($) {
7     print(header(-status=>500),
8           start_html('Error'),
9           h1('Error'),
10           escapeHTML($_[0]),
11           end_html());
12     exit 0;
13 }
14
15 our $R= '/var/lib/collectd/rrd/chiark.greenend.org.uk';
16 our $SELF= '/home/ijackson/things/rrd-graphs';
17
18 my $self= url(-relative=>1);
19
20 our (@sections, %section_groups, %group_elems, %graphs);
21
22 our @timeranges= (3600, map { $_*86400 } qw(1 7 28), 13*7+1, 366);
23
24 sub graph_of_group ($$$$$) {
25     my ($section, $group, $elem, $basis, $args) = @_;
26     $basis->{Args}= $args;
27     $basis->{Slower}= 0 unless exists $basis->{Slower};
28
29     $graphs{$section,$group,$elem}= $basis;
30     if (!exists $group_elems{$section,$group}) {
31         # new group then
32         if (!exists $section_groups{$section}) {
33             # new section even
34             push @sections, $section;
35         }
36         push @{ $section_groups{$section} }, $group;
37     }
38     push @{ $group_elems{$section,$group} }, $elem;
39 }
40
41 sub graph ($$$$) {
42     my ($section, $gname, $basis, $args) = @_;
43     graph_of_group($section, $gname,'', $basis, $args);
44 }
45
46 graph('General', 'Load and processes', { },
47       [
48        "DEF:load=$R/load/load.rrd:shortterm:AVERAGE",
49        (map { "DEF:$_=$R/processes/ps_state-$_.rrd:value:AVERAGE" }
50             qw(blocked running stopped paging sleeping zombies)),
51        "AREA:running#88f:running:STACK",
52        "AREA:blocked#8f8:disk wait:STACK",
53        "AREA:paging#f88:paging:STACK",
54        "LINE:load#000:load",
55        ]);
56
57 graph('General', 'Processes', { },
58       [
59        (map { "DEF:$_=$R/processes/ps_state-$_.rrd:value:AVERAGE" }
60             qw(blocked running stopped paging sleeping zombies)),
61        "CDEF:busy=0".(join '', map { ",$_,+" } qw(running blocked paging)),
62        "AREA:sleeping#ccc:sleeping:STACK",
63        "AREA:stopped#00f:stopped:STACK",
64        "AREA:zombies#ff0:zombie:STACK",
65        "AREA:busy#000:busy:STACK",
66        ]);
67
68 graph('General', 'CPU', { Units => '[%]' },
69       [
70        (map {
71            my $thing= $_;
72            (map { "DEF:$thing$_=$R/cpu-$_/cpu-$thing.rrd:value:AVERAGE" }
73                 (0..7)),
74            "CDEF:$thing=0".join('', map { ",$thing$_,+" } (0..7)).",8.0,/";
75        } qw(idle interrupt nice softirq steal system user wait)),
76        "CDEF:allintr=softirq,steal,+,interrupt,+",
77        "AREA:system#88f:system:STACK",
78        "AREA:allintr#ff0:interrupt:STACK",
79        "AREA:user#00f:user:STACK",
80        "AREA:nice#ccc:nice:STACK",
81        "AREA:wait#f00:wait:STACK",
82        ]);
83
84 graph('General', 'Memory', { },
85       [ '-b',1024,
86        (map { "DEF:swap_$_=$R/swap/swap-$_.rrd:value:AVERAGE" }
87             qw(free used cached)),
88        (map { "DEF:mem_$_=$R/memory/memory-$_.rrd:value:AVERAGE" }
89             qw(buffered free used cached)),
90        "CDEF:c_swap_used=0,swap_used,-",
91        "CDEF:c_swap_cached=0,swap_cached,-",
92        "CDEF:c_swap_free=0,swap_free,-",
93        "AREA:c_swap_used#000:used swap",
94        "AREA:c_swap_cached#888:\"cached\" swap:STACK",
95 #       "AREA:c_swap_free#88f:free swap:STACK",
96        "AREA:mem_used#ff0:used memory",
97        "AREA:mem_buffered#00f:page cache:STACK",
98        "AREA:mem_cached#008:buffer cache:STACK",
99        "AREA:mem_free#ccc:unused memory:STACK",
100        ]);
101
102 graph('General', 'Network', { Units => '[/sec; tx +ve; errs x1000]' },
103       [
104        (map {
105            ("DEF:tx_$_=$R/interface/if_$_-eth0.rrd:tx:AVERAGE",
106             "DEF:rx_$_=$R/interface/if_$_-eth0.rrd:rx:AVERAGE",
107             "CDEF:mrx_$_=0,rx_$_,-")
108            } qw(octets packets errors)),
109        (map {
110            ("CDEF:${_}_kb=${_}_octets,1024,/",
111             "CDEF:${_}_errsx=${_}_errors,1000,*")
112            } qw(mrx tx)),
113        "AREA:tx_kb#080:kby",
114        "LINE:tx_packets#0f0:pkts",
115        "LINE:tx_errsx#000:errs",
116        "AREA:mrx_kb#008:kby",
117        "LINE:mrx_packets#00f:pkts",
118        "LINE:mrx_errsx#444:errs",
119       ]);
120
121 graph('General', 'Users', {  },
122       [
123        "DEF:users=$R/users/users.rrd:users:AVERAGE",
124        "LINE:users#008:users"
125        ]);
126
127 foreach my $src (<$R/df/df-*.rrd>) {
128     my $vol= $src;
129     $vol =~ s,\.rrd$,, or next;
130     $vol =~ s,.*/,,;
131     $vol =~ s,^df-,,;
132     graph('Disk space', $vol, {
133              Slower => 1,
134           },
135           [ '-A','-l',0,'-r',
136            qw(-b 1024 -l 0),
137            (map { "DEF:$_=$src:$_:AVERAGE" } qw(free used)),
138            "AREA:used#000:used:STACK",
139            "AREA:free#88f:free:STACK",
140            ]);
141 }
142
143 foreach my $src (<$SELF/data/news/*.rrd>) {
144     my $site= $src;
145     $site =~ s,\.rrd$,, or next;
146     $site =~ s,.*/,,;
147     $site =~ s,_(in|out)$,,;
148     my $inout= $1;
149     $site =~ s/^([-.0-9a-z]+)_//;
150     my $us= $1; # all very well but we ignore it
151     graph_of_group("News", $site, $inout,
152           {
153                 Slower => 1,
154                 Units => '[art/s]'
155             }, $inout eq 'out' ?
156           [
157            (map { "DEF:$_=$src:$_:AVERAGE" }
158                 qw(missing deferred unwanted accepted rejected body_missing)),
159            "AREA:accepted#00f:ok",
160            "AREA:body_missing#ff0:miss:STACK",
161            "AREA:rejected#f00:rej:STACK",
162            "AREA:unwanted#aaa:unw:STACK",
163            "AREA:deferred#ddd:defer:STACK",
164            ] :
165           [
166            (map { "DEF:$_=$src:$_:AVERAGE" }
167                 qw(accepted refused rejected duplicate)),
168            (map { ("DEF:bytes_$_=$src:${_}_size:AVERAGE",
169                    "CDEF:kb_$_=bytes_$_,1024,/")
170               } qw(accepted duplicate)),
171            "AREA:accepted#00f:ok:STACK",
172            "AREA:rejected#f00:rej:STACK",
173            "AREA:duplicate#000:dupe:STACK",
174            "AREA:refused#aaa:unw:STACK",
175            "LINE:kb_duplicate#ff0:kb dupe",
176            "LINE:kb_accepted#008:kb",
177            ]);
178 }
179
180 if (param('debug')) {
181     print "Content-Type: text/plain\n\n";
182 }
183
184 our @navsettings;
185
186 sub navsetting ($) {
187     my ($nav) = @_;
188     my $var= $nav->{Variable};
189     $$var= param($nav->{Param});
190     $$var= $nav->{Default} if !defined $$var;
191     die $nav->{Param} unless grep { $_ eq $$var } @{ $nav->{Values} };
192     push @navsettings, $nav;
193 }
194
195 our $section;
196
197 navsetting({
198     Desc => 'Section',
199     Param => 'section',
200     Variable => \$section,
201     Default => $sections[0],
202     Values => [@sections],
203     Show => sub { return $_[0]; }
204 });
205
206
207 sub num_param ($$$$) {
208     my ($param,$def,$min,$max) = @_;
209     my $v= param($param);
210     return $def if !defined $v;
211     $v =~ m/^([1-9]\d{0,8})$/ or die;
212     $v= $1;
213     die unless $v >= $min && $v <= $max;
214     return $v + 0;
215 }
216
217 my $group= param('graph');
218
219 my $elem= param('elem');
220 if (defined $elem) {
221     my $g= $graphs{$section,$group,$elem};
222     die unless $g;
223
224     my @args= @{ $g->{Args} };
225
226     my $width= num_param('w',370,100,1600);
227     my $height= num_param('h',200,100,1600);
228
229     my $sloth= param('sloth');
230     die unless defined $sloth;
231     $sloth =~ m/^(\d+)$/ or die;
232     my $end= $timeranges[$sloth];
233     die unless defined $end;
234     unshift @args, qw(--end now --start), "end-${end}s";
235     
236     if (param('debug')) {
237         print((join "\n",@args),"\n"); exit 0;
238     }
239     print "Content-Type: image/png\n\n";
240
241     my $title= $group;
242     if (length $elem) { $title.= " $elem"; }
243
244     $title .= " $g->{Units}" if $g->{Units};
245     unshift @args, '-t', $title;
246     
247     exec (qw(rrdtool graph - -a PNG --full-size-mode),
248           '-w',$width, '-h',$height,
249           @args);
250     die $!;
251 }
252
253 sub start_page ($) {
254     my ($title) = @_;
255     print header(), start_html($title);
256     my $outerdelim= '';
257     foreach my $nav (@navsettings) {
258         print $outerdelim;
259         print $nav->{Desc}, ": ";
260         my $delim= '';
261         my $current= $nav->{Variable};  $current= $$current;
262         foreach my $couldbe (@{ $nav->{Values} }) {
263             print $delim;
264             my $show= $nav->{Show}($couldbe);
265             if ($couldbe eq $current) {
266                 print "<b>$show</b>";
267             } else {
268                 my $u= $self;
269                 my $delim2= '?';
270                 foreach my $nav2 (@navsettings) {
271                     my $current2= $nav2->{Variable};  $current2= $$current2;
272                     $current2= $couldbe if $nav2->{Param} eq $nav->{Param};
273                     next if $current2 eq $nav2->{Default};
274                     $u .= $delim2;  $u .= "$nav2->{Param}=$current2";
275                     $delim2= '&';
276                 }
277                 print a({href=>$u}, $show);
278             }
279             $delim= ' | ';
280         }
281         $outerdelim= "<br>\n";
282     }
283     print "\n";
284
285     print h1("$title");
286 }
287
288 my $detail= param('detail');
289 if ($detail) {
290     my $elems= $group_elems{$section,$detail};
291     die unless $elems;
292     start_page("$detail graphs");
293     foreach my $xsloth (0..5) {
294         foreach my $elem (@$elems) {
295             my $g= $graphs{$section,$detail,$elem};
296             die unless $g;
297             my $tsloth= $xsloth + $g->{Slower};
298             my $imgurl= "$self?graph=$detail&section=$section".
299                 "&sloth=$tsloth&elem=$elem";
300             print a({href=>"$imgurl&w=780&h=800"},
301                     img({src=>$imgurl, alt=>''}));
302         }
303     }
304     print end_html();
305     exit 0;
306 }
307
308 our $sloth;
309
310 navsetting({
311     Desc => 'Time interval',
312     Param => 'sloth',
313     Variable => \$sloth,
314     Default => 1,
315     Values => [0..3],
316     Show => sub {
317         my ($sl) = @_;
318         return ('Narrower', 'Normal', 'Wider', 'Extra wide')[$sl];
319     }
320 });
321
322 if (param('debug')) {
323     use Data::Dumper;
324     print Dumper(\%graphs);
325     exit 0;
326 }
327
328 start_page("$section graphs");
329
330 foreach my $group (@{ $section_groups{$section} }) {
331     my $elems= $group_elems{$section,$group};
332     if (@$elems > 1) { print "<table><tr><td>"; }
333     print a({href=>"$self?detail=$group&section=$section"});
334     my $imgurl= "$self?graph=$group&section=$section";
335     foreach my $elem (@$elems) {
336         my $g= $graphs{$section,$group,$elem};
337         print img({src=>"$imgurl&elem=$elem&sloth=".($sloth + $g->{Slower}),
338                    alt=>''});
339     }
340     print "</a>\n";
341     if (@$elems > 1) { print "</td></tr></table>"; }
342 }
343