workaround for memory-leak in debian squeeze librrds-perl (Bug #545519)
[upsgraph] / upsgraph.pl
1 #!/usr/bin/perl -w
2
3 #Due to memory leak in Debian squeeze (Bug #545519)
4 my $use_rrds = 0;
5 my $rrd_result = 0;
6
7 if ((@ARGV != 1) && (@ARGV != 2)) {
8 print STDERR "Syntax: ${0} configfile [uid]\n";
9 exit(1);
10 }
11
12 use Net::SNMP;
13 use IO::Socket::INET;
14 use RRDs;
15 use File::Copy;
16 use Data::Dumper;
17
18 $UPSGRAPH::outdir = "";
19 $UPSGRAPH::step = 60;
20 $UPSGRAPH::keep = (370*24*60*60)/$UPSGRAPH::step;
21 $UPSGRAPH::hosts = ();
22
23 do $ARGV[0] or die "can't read config: $!";
24
25 my $outdir = $UPSGRAPH::outdir;
26 my $step = $UPSGRAPH::step;
27 my $keep = $UPSGRAPH::keep;
28 my $hosts = $UPSGRAPH::hosts;
29
30 sub rrd_update(@) {
31 my @args = @_;
32
33 if ($use_rrds == 1) {
34 RRDs::update(@args);
35 $rrd_result = RRDs::error;
36 } else {
37 $rrd_result = system("rrdtool", "update", @args);
38 }
39 }
40
41 sub rrd_graph(@) {
42 my @args = @_;
43 my @rrd_out = ();
44
45 if ($use_rrds == 1) {
46 @rrd_out = RRDs::graph(@args);
47 $rrd_result = RRDs::error;
48 } else {
49 my $rrd_stdout;
50
51 open(RRDFD, '-|', 'rrdtool', 'graph', @args);
52 while(<RRDFD>) {
53 chomp;
54 $rrd_stdout = $_;
55 }
56 close(RRDFD);
57 $rrd_result = $?;
58 if ($rrd_result == 0) {
59 push @rrd_out, 0;
60 push @rrd_out, split(/x/, $rrd_stdout);
61 }
62 }
63
64 return @rrd_out;
65 }
66
67 sub rrdcreate(@) {
68 my $newrrd = shift;
69 my $field = shift;
70 my $vars = shift;
71 my $start = shift;
72
73 my @cmd = ("${newrrd}", "--step=${step}");
74
75 if (defined($start)) {
76 push @cmd, "--start=${start}";
77 }
78
79 push @cmd, "DS:${field}:GAUGE:600:" .
80 $vars->{$field}->{'min'} . ":" .
81 $vars->{$field}->{'max'} . " ";
82
83 push @cmd, "RRA:AVERAGE:0.5:1:${keep}";
84
85 RRDs::create(@cmd);
86 if (RRDs::error) {
87 print "Error while creating: " . RRDs::error . "\n";
88 exit 1;
89 }
90 }
91
92 sub fetch_snmp(@) {
93 my $address = shift;
94 my $community = shift;
95 my $oid = shift;
96
97 (my $session, my $error) = Net::SNMP->session(Hostname => $address,
98 Community => $community);
99
100 if (!$session) {
101 print STDERR "session error: $error";
102 return undef;
103 }
104
105 $session->translate(0);
106
107 my $result = $session->get_request($oid);
108
109 $session->close;
110
111 return undef if (!defined($result));
112
113 $result->{$oid};
114 }
115
116 sub fetch_tcp(@) {
117 my $address = shift;
118 my $port = shift;
119
120 my $sock = IO::Socket::INET->new(PeerAddr => $address,
121 PeerPort => $port,
122 Proto => 'tcp',
123 Timeout => 1);
124
125 return undef if (!$sock);
126
127 chomp(my $value = <$sock>);
128
129 close($sock);
130
131 if (!$value) {
132 return undef;
133 }
134
135 $value=~ s/\s//g;
136
137 $value;
138 }
139
140 if ($> == 0) {
141 if (@ARGV != 2) {
142 print STDERR "Running as root, please provide UID as 2th argument!\n";
143 exit(1);
144 }
145
146 print "Running as root, switching to ".$ARGV[1]."\n";
147 $< = $> = $ARGV[1];
148 }
149
150 foreach my $host (@$hosts) {
151 my $rrdfile = $host->{'rrdfile'};
152
153 foreach my $var (keys(%{$host->{'vars'}})) {
154 $host->{'vars'}->{$var}->{'min'} = 'U' if (!defined($host->{'vars'}->{$var}->{'min'}));
155 $host->{'vars'}->{$var}->{'max'} = 'U' if (!defined($host->{'vars'}->{$var}->{'max'}));
156 }
157
158 if (-e "${rrdfile}") {
159 print "Reading old ${rrdfile} to preserve data...\n";
160
161 my $rrdinfo = RRDs::info("${rrdfile}");
162 if (RRDs::error) {
163 print "Error while getting info: " . RRDs::error . "\n";
164 exit 1;
165 }
166
167 (my $start, my $ostep, my $names, my $data) =
168 RRDs::fetch("${rrdfile}",
169 "-s " . (time() - ($rrdinfo->{'rra[0].rows'} * $rrdinfo->{'step'})),
170 "AVERAGE");
171
172 if (RRDs::error) {
173 print "Error while fetching data: " . RRDs::error . "\n";
174 exit 1;
175 }
176
177 foreach my $field (@$names) {
178 if (! -e "${rrdfile}.${field}") {
179 rrdcreate("${rrdfile}.${field}",
180 "${field}",
181 $host->{'vars'},
182 (${start}-${ostep}));
183 }
184 }
185
186 my $pos = $start;
187 foreach my $line (@$data) {
188 foreach my $field (@$names) {
189 my $val = shift (@$line);
190 $val = 'U' if (!defined($val));
191
192 RRDs::update("${rrdfile}.${field}", "${pos}:${val}");
193 if (RRDs::error) {
194 print "Can't insert data: " . RRDs::error . "\n";
195 exit 1;
196 }
197
198 }
199
200 $pos += $ostep;
201
202 if ((($pos-$start)/$ostep) == $#$data) {
203 last;
204 }
205 }
206
207 rename("${rrdfile}", "${rrdfile}.old") or die "Can't rename old file: $!\n";
208 }
209
210 foreach my $field (@{$host->{'fields'}}) {
211 if (! -e "${rrdfile}.${field}") {
212 print "Creating ${rrdfile}.${field}...\n";
213 rrdcreate("${rrdfile}.${field}",
214 "${field}",
215 $host->{'vars'});
216 }
217
218 my $rrdinfo = RRDs::info("${rrdfile}.${field}");
219 if (RRDs::error) {
220 print "Error while getting info: " . RRDs::error . "\n";
221 exit 1;
222 }
223
224 if (defined($rrdinfo->{"ds[${field}].min"})) {
225 if ($rrdinfo->{"ds[${field}].min"} ne $host->{'vars'}->{$field}->{'min'}) {
226 RRDs::tune("${rrdfile}.${field}","-i",$field.":".$host->{'vars'}->{$field}->{'min'});
227 }
228 } else {
229 if ($host->{'vars'}->{$field}->{'min'} ne 'U') {
230 RRDs::tune("${rrdfile}.${field}","-i",$field.":".$host->{'vars'}->{$field}->{'min'});
231 }
232 }
233
234 if (RRDs::error) {
235 print "Error while setting min: " . RRDs::error . "\n";
236 exit 1;
237 }
238
239 if (defined($rrdinfo->{"ds[${field}].max"})) {
240 if ($rrdinfo->{"ds[${field}].max"} ne $host->{'vars'}->{$field}->{'max'}) {
241 RRDs::tune("${rrdfile}.${field}","-a",$field.":".$host->{'vars'}->{$field}->{'max'});
242 }
243 } else {
244 if ($host->{'vars'}->{$field}->{'max'} ne 'U') {
245 RRDs::tune("${rrdfile}.${field}","-a",$field.":".$host->{'vars'}->{$field}->{'max'});
246 }
247 }
248
249 if (RRDs::error) {
250 print "Error while setting max: " . RRDs::error . "\n";
251 exit 1;
252 }
253
254 if ($rrdinfo->{'rra[0].rows'} != $keep) {
255 print "Resizing ${rrdfile}.${field} from " . $rrdinfo->{'rra[0].rows'} .
256 " to ${keep} samples.\n";
257
258 (my $start, my $ostep, my $names, my $data) =
259 RRDs::fetch("${rrdfile}.${field}",
260 "-s " . (time() - ($rrdinfo->{'rra[0].rows'} * $rrdinfo->{'step'})),
261 "AVERAGE");
262
263 if (RRDs::error) {
264 print "Error while fetching data: " . RRDs::error . "\n";
265 exit 1;
266 }
267
268 rrdcreate("${rrdfile}.${field}.new",
269 "${field}",
270 $host->{'vars'},
271 (${start}-${ostep}));
272
273 print "Preserving data since " . localtime($start) . "\n";
274
275 my $pos = $start;
276 foreach my $line (@$data) {
277 my $vline = "${pos}";
278
279 foreach my $val (@$line) {
280 $val = 'U' if (!defined($val));
281 $vline .= ":${val}";
282 }
283 RRDs::update("${rrdfile}.${field}.new", $vline) or die "Can't insert data\n";
284
285 if (RRDs::error) {
286 print "Error while updating: " . RRDs::error . "\n";
287 exit 1;
288 }
289 $pos += $ostep;
290
291 if ((($pos-$start)/$ostep) == $#$data) {
292 last;
293 }
294 }
295
296 rename("${rrdfile}.${field}", "${rrdfile}.${field}.old") or die "Can't rename old file: $!\n";
297 rename("${rrdfile}.${field}.new", "${rrdfile}.${field}") or die "Can't rename new file: $!\n";
298
299 $rrdinfo = RRDs::info("${rrdfile}.${field}");
300 if (RRDs::error) {
301 print "Error while getting info: " . RRDs::error . "\n";
302 exit 1;
303 }
304
305 if ($rrdinfo->{'rra[0].rows'} != $keep) {
306 print "Failed!\n";
307 exit 1;
308 }
309 }
310 }
311 }
312
313 my $child = fork();
314
315 die "fork failed!" if (!defined($child));
316
317 exit 0 if ($child != 0);
318
319 while(1) {
320 open(HTML, ">${outdir}/index.html.new");
321
322 print HTML '<html><head><meta http-equiv="refresh" content="60"/><meta http-equiv="cache-control" content="no-cache"/><meta http-equiv="pragma" content="no-cache"/><meta http_equiv="expires" content="Sat, 26 Jul 1997 05:00:00 GMT"/><title>Status</title></head>';
323 print HTML '<body bgcolor="#ffffff">';
324
325 foreach my $host (@$hosts) {
326 print HTML "[<a href=\"#".${host}->{'name'}."\">".${host}->{'name'}."</a>]&nbsp;";
327 }
328 print HTML "<br>\n";
329
330 foreach my $host (@$hosts) {
331 print HTML "<br>\n";
332 print HTML "<a name=\"".${host}->{'name'}."\"></a>\n";
333 my $vars = $host->{'vars'};
334 my $rrdfile = $host->{'rrdfile'};
335 my $hostname = $host->{'name'};
336
337 foreach my $var (@{$host->{'fields'}}) {
338 delete $vars->{$var}->{'value'};
339
340 my $result;
341
342 if ((!defined($vars->{$var}->{'proto'})) ||
343 ($vars->{$var}->{'proto'} eq '') ||
344 ($vars->{$var}->{'proto'} eq 'snmp')) {
345 $result = fetch_snmp($host->{'address'}, $host->{'community'}, $vars->{$var}->{'oid'});
346 } elsif ($vars->{$var}->{'proto'} eq 'tcp') {
347 $result = fetch_tcp($host->{'address'}, $vars->{$var}->{'port'});
348 }
349
350 next unless (defined $result);
351
352 $vars->{$var}->{'value'} = $result;
353 if (defined($vars->{$var}->{'factor'})) {
354 $vars->{$var}->{'value'} *= $vars->{$var}->{'factor'};
355 }
356 }
357
358 foreach my $var (@{$host->{'fields'}}) {
359 if (!(defined($vars->{$var}->{'value'}))) {
360 $vars->{$var}->{'value'} = 'U';
361 }
362 rrd_update("${rrdfile}.${var}", "N:" . $vars->{$var}->{'value'});
363 }
364 if ($rrd_result) {
365 print "Error while updating: " . $rrd_result . "\n";
366 }
367
368 foreach my $var (@{$host->{'fields'}}) {
369 my @graphdef = ('-P', "--lazy", "-t", $hostname." - ".$vars->{$var}->{'name'}, "DEF:${var}=${rrdfile}.${var}:${var}:AVERAGE", "LINE1:${var}#FF0000");
370
371 push @graphdef, "VDEF:cur=${var},LAST";
372 push @graphdef, 'GPRINT:cur:Current\\: <span foreground="#FF0000">%.2lf</span>\\r';
373
374 my $mtime;
375 $mtime=(stat("${outdir}/${hostname}.${var}.png.work"))[9];
376
377 (my $averages, my $width, my $height) =
378 rrd_graph("${outdir}/${hostname}.${var}.png.work",
379 "-w", "720", @graphdef);
380
381 pop @graphdef;
382 pop @graphdef;
383
384 if ($rrd_result) {
385 print "Error while graphing: " . $rrd_result . "\n";
386 } else {
387 my $newmtime=(stat("${outdir}/${hostname}.${var}.png.work"))[9];
388 if ((!defined($mtime)) || ($newmtime != $mtime)) {
389 copy("${outdir}/${hostname}.${var}.png.work", "${outdir}/${hostname}.${var}.png.new");
390 rename("${outdir}/${hostname}.${var}.png.new", "${outdir}/${hostname}.${var}.png");
391 }
392 }
393
394 print HTML "<a href=\"${hostname}.${var}.html\"><img src=\"${hostname}.${var}.png\" width=\"${width}\" height=\"${height}\" border=\"0\"></a><br>\n";
395
396 open (HTML2, ">${outdir}/${hostname}.${var}.html.new");
397 print HTML2 '<html><head><meta http-equiv="refresh" content="60"/><meta http-equiv="cache-control" content="no-cache"/><meta http-equiv="pragma" content="no-cache"/><meta http_equiv="expires" content="Sat, 26 Jul 1997 05:00:00 GMT"/><title>' . $vars->{$var}->{'name'} . '</title></head>';
398 print HTML2 '<body bgcolor="#ffffff">';
399
400 push @graphdef, "VDEF:min=${var},MINIMUM";
401 push @graphdef, "GPRINT:min:Minimum\\: %.2lf";
402
403 push @graphdef, "VDEF:avg=${var},AVERAGE";
404 push @graphdef, "GPRINT:avg:Average\\: %.2lf";
405
406 push @graphdef, "VDEF:max=${var},MAXIMUM";
407 push @graphdef, "GPRINT:max:Maximum\\: %.2lf";
408
409 push @graphdef, "VDEF:cur=${var},LAST";
410 push @graphdef, "GPRINT:cur:Current\\: %.2lf";
411
412 $mtime=(stat("${outdir}/${hostname}.${var}.long.png.work"))[9];
413 ($averages, $width, $height) =
414 rrd_graph("${outdir}/${hostname}.${var}.long.png.work",
415 "-w", "1008", @graphdef);
416
417 if ($rrd_result) {
418 print "Error while graphing: " . $rrd_result . "\n";
419 } else {
420 my $newmtime=(stat("${outdir}/${hostname}.${var}.long.png.work"))[9];
421 if ((!defined($mtime)) || ($newmtime != $mtime)) {
422 copy("${outdir}/${hostname}.${var}.long.png.work", "${outdir}/${hostname}.${var}.long.png.new");
423 rename("${outdir}/${hostname}.${var}.long.png.new", "${outdir}/${hostname}.${var}.long.png");
424 }
425 }
426
427 print HTML2 "<img src=\"${hostname}.${var}.long.png\" width=\"${width}\" height=\"${height}\"><br>";
428
429 $mtime=(stat("${outdir}/${hostname}.${var}.week.png.work"))[9];
430 ($averages, $width, $height) =
431 rrd_graph("${outdir}/${hostname}.${var}.week.png.work",
432 "-w", "1008", "-e", "now", "-s", "end-1w", @graphdef);
433
434 if ($rrd_result) {
435 print "Error while graphing: " . $rrd_result . "\n";
436 } else {
437 my $newmtime=(stat("${outdir}/${hostname}.${var}.week.png.work"))[9];
438 if ((!defined($mtime)) || ($newmtime != $mtime)) {
439 copy("${outdir}/${hostname}.${var}.week.png.work", "${outdir}/${hostname}.${var}.week.png.new");
440 rename("${outdir}/${hostname}.${var}.week.png.new", "${outdir}/${hostname}.${var}.week.png");
441 }
442 }
443
444 print HTML2 "<img src=\"${hostname}.${var}.week.png\" width=\"${width}\" height=\"${height}\"><br>";
445
446 $mtime=(stat("${outdir}/${hostname}.${var}.year.png.work"))[9];
447 ($averages, $width, $height) =
448 rrd_graph("${outdir}/${hostname}.${var}.year.png.work",
449 "-w", "1008", "-e", "now", "-s", "end-1y", @graphdef);
450
451 if ($rrd_result) {
452 print "Error while graphing: " . $rrd_result . "\n";
453 } else {
454 my $newmtime=(stat("${outdir}/${hostname}.${var}.year.png.work"))[9];
455 if ((!defined($mtime)) || ($newmtime != $mtime)) {
456 copy("${outdir}/${hostname}.${var}.year.png.work", "${outdir}/${hostname}.${var}.year.png.new");
457 rename("${outdir}/${hostname}.${var}.year.png.new", "${outdir}/${hostname}.${var}.year.png");
458 }
459 }
460
461 print HTML2 "<img src=\"${hostname}.${var}.year.png\" width=\"${width}\" height=\"${height}\"><br>";
462
463 print HTML2 "</body></html>\n";
464 close(HTML2);
465 rename("${outdir}/${hostname}.${var}.html.new", "${outdir}/${hostname}.${var}.html");
466 }
467 }
468
469 print HTML "</body></html>\n";
470 print HTML "<br>Generated on: " . localtime(time());
471 print HTML ' by <a href="http://git.zerfleddert.de/cgi-bin/gitweb.cgi/upsgraph">upsgraph</a>.';
472
473 close(HTML);
474
475 rename("${outdir}/index.html.new", "${outdir}/index.html");
476
477 sleep(${step}/2);
478 }
Impressum, Datenschutz