ViewVC Help
View File | Revision Log | Show Annotations | Revision Graph | Root Listing
root/i-scream/projects/cms/source/reports/rrdgraphing/watch.pl
(Generate patch)

Comparing projects/cms/source/reports/rrdgraphing/watch.pl (file contents):
Revision 1.2 by tdb, Sat May 18 18:15:59 2002 UTC vs.
Revision 1.5 by tdb, Mon Oct 21 13:02:58 2002 UTC

# Line 2 | Line 2
2  
3   #
4   # i-scream central monitoring system
5 + # http://www.i-scream.org.uk
6   # Copyright (C) 2000-2002 i-scream
7   #
8   # This program is free software; you can redistribute it and/or
# Line 30 | Line 31
31   # $Id$
32   #------------------------------------------------------------
33  
34 < ## TODO
34 < # ought to think about cleaning up when we restart?
35 < #  -- old queue data etc
34 > my($version) = '$Id$';
35  
36   $| = 1;
37  
38   use strict;
39 < use iscream::XMLParser;
39 > use Getopt::Std;
40   use IO::Socket;
41 + use iscream::XMLParser;
42   use RRDs;
43  
44 < # Base directory for images
45 < # (a directory will be constructed for each host under this)
46 < my($imgdir) = "/home/pkg/iscream/public_html/graphs";
44 > # define variables that will be read from the config
45 > # nb. keep this insync with the config file!
46 > use vars qw{
47 >    $imgdir $rrddir                    
48 >    $maxrrdage $maximgage $deleterrds $deleteimgs
49 >    $hex_slash $hex_underscore  
50 >    $rrdstep $retry_wait
51 >    $verbose $quiet
52 > };
53  
54 < # Location of RRD databases
55 < my($rrddir) = "/u1/i-scream/databases";
54 > # default locate of the config file
55 > my($configfile) = "rrdgraphing.conf";
56  
57 < # for reference:
58 < # ch -> hex: $hex = sprintf("%02x", ord($ch));
59 < # hex -> ch: $ch = chr(hex($hex));
57 > # check for command line arguments
58 > my(%opts);
59 > my($ret) = getopts('hvqVc:', \%opts);
60  
61 < # / converted to a decimal then hex'd
62 < my($hex_slash) = "_2f";
57 < # _ converted to a decimal then hex'd
58 < my($hex_underscore) = "_5f";
61 > # if invalid argument given, $ret will not be 1
62 > &usage() if $ret != 1;
63  
64 < # step interval in the rrd databases
61 < my($rrdstep) = 15;
64 > # first process the arguments which might mean we exit now
65  
66 < # time to wait (in seconds) before retrying a connection
67 < my($retry_wait) = 10;
66 > # -h is usage
67 > if($opts{h}) {
68 >    &usage();
69 > }
70 > # -V is version
71 > if($opts{V}) {
72 >    print "watch.pl version: $version\n";
73 >    exit(1);
74 > }
75  
76 + # Then try getting the config
77 +
78 + # -c specifies the config file location
79 + if($opts{c}) {
80 +    $configfile = $opts{c};
81 + }
82 + # suck in the config
83 + &log("reading config from $configfile\n");
84 + do $configfile;
85 +
86 + # Then any options we might want to override the config with
87 +
88 + # -v is verbose
89 + if($opts{v}) {
90 +    $verbose = $opts{v};
91 + }
92 + # -q is verbose
93 + if($opts{q}) {
94 +    $quiet = $opts{q};
95 +    # if we're meant to be quiet, we can hardly be verbose!
96 + #    $verbose = 0;
97 + }
98 +
99 + # Finally check for required arguments
100 +
101 + # check we still have two arguments left
102   if (@ARGV != 2) {
103 <    die "Usage: watch.pl [i-scream client interface] [TCP port]\n";
103 >    &usage();
104   }
105  
106   # user supplied client interface server and port
107   my($addr) = $ARGV[0];
108   my($cport) = $ARGV[1];
109  
110 +
111 + # Main program loop
112   while(1) {
113      
114 <    print "Connecting control channel to port $cport on $addr...\n";
114 >    &log("Connecting control channel to port $cport on $addr...\n");
115      
116      # attempt to connect the control channel
117      my($csock) = new IO::Socket::INET(
# Line 84 | Line 122 | while(1) {
122      
123      # if socket isn't defined connection failed
124      if (!defined $csock) {
125 <        print STDERR "ERROR: Could not connect control channel to $addr:$cport.\n";
126 <        print STDERR "Please check that there is an i-scream server at this address.\n";
125 >        &error("ERROR: Could not connect control channel to $addr:$cport.\n");
126 >        &error("Please check that there is an i-scream server at this address.\n");
127          &wait_then_retry();
128          next;
129      }
# Line 95 | Line 133 | while(1) {
133      # client interface should send it's protocol ID
134      # we know about "PROTOCOL 1.1", and will only accept the same
135      $response = <$csock>;
136 +    &log("CLI sent: $response");
137      if ($response && $response ne "PROTOCOL 1.1\n") {
138 <        print STDERR "The i-scream server sent an unexpected protocol ID: $response\n";
138 >        &error("The i-scream server sent an unexpected protocol ID: $response\n");
139          close($csock);
140          &wait_then_retry();
141          next;
# Line 104 | Line 143 | while(1) {
143      
144      # send our identifier to the client interface
145      print $csock "rrdgraphing\n";
146 +    &log("we sent: rrdgraphing\n");
147      $response = <$csock>;
148 +    &log("CLI sent: $response");
149      if ($response && $response ne "OK\n") {
150 <        print STDERR "Received unexpected response: $response\n";
150 >        &error("Received unexpected response: $response\n");
151          close($csock);
152          &wait_then_retry();
153          next;
# Line 114 | Line 155 | while(1) {
155      
156      # tell the client interface we'd like to start the data channel
157      print $csock "STARTDATA\n";
158 <    
158 >    &log("we sent: STARTDATA\n");
159 >
160      # the response should be the socket to connect the data channel to
161      $response = <$csock>;
162 +    &log("CLI sent: $response");
163      chomp $response;
164      
165      my($dport) = $response;
166 <    print "Connecting data channel to port $dport on $addr...\n";
166 >    &log("Connecting data channel to port $dport on $addr...\n");
167      
168      # attempt to connect the data channel
169      my($dsock) = new IO::Socket::INET(
# Line 131 | Line 174 | while(1) {
174      
175      # if socket isn't defined connection failed
176      if (!defined $dsock) {
177 <        print STDERR "ERROR: Could not connect data channel to $addr:$dport.\n";
178 <        print STDERR "Failure in communications.\n";
177 >        &error("ERROR: Could not connect data channel to $addr:$dport.\n");
178 >        &error("Failure in communications.\n");
179          close($csock);
180          &wait_then_retry();
181          next;
# Line 159 | Line 202 | exit 0;
202   # wait for a while before retrying
203   #
204   sub wait_then_retry() {
205 <    print STDERR "Will retry connection to i-scream server in $retry_wait seconds.\n\n";
205 >    &error("Will retry connection to i-scream server in $retry_wait seconds.\n\n");
206      sleep $retry_wait;
207   }
208  
# Line 186 | Line 229 | sub processdata() {
229          # attempt to parse the data
230          my($err, %xmlhash) = &iscream::XMLParser::parse($xml);
231          if($err) {
232 <            print STDERR "Skipped, XML did not parse: $xml";
232 >            &error("Skipped, XML did not parse: $xml");
233              next;
234          }
235          
# Line 199 | Line 242 | sub processdata() {
242              if(! -d "$rrddir/$machine") {
243                  # not sure on this umask, but it seems to work?
244                  mkdir "$rrddir/$machine", 0777;
245 +                &log("created directory $rrddir/$machine\n");
246              }
247              
248              my(@data);
# Line 244 | Line 288 | sub processdata() {
288              @data = ( "packet.users.count:count:GAUGE",
289                       );
290              &updaterrd($machine, "users", $date, $rrdstep, \%xmlhash, @data);
291 <            
291 >
292 >            # paging
293 >            @data = ( "packet.pages.swapins:swapins:GAUGE",
294 >                      "packet.pages.swapouts:swapouts:GAUGE",
295 >                     );
296 >            &updaterrd($machine, "paging", $date, $rrdstep, \%xmlhash, @data);
297 >
298              # disk
299              my($i) = 0;
300              while(defined $xmlhash{"packet.disk.p$i.attributes.mount"}) {
# Line 253 | Line 303 | sub processdata() {
303                  $mount =~ s/\//$hex_slash/g;
304                  @data = ( "packet.disk.p$i.attributes.kbytes:kbytes:GAUGE",
305                            "packet.disk.p$i.attributes.used:used:GAUGE",
306 +                          "packet.disk.p$i.attributes.totalinodes:totalinodes:GAUGE",
307 +                          "packet.disk.p$i.attributes.freeinodes:freeinodes:GAUGE",
308                           );
309                  &updaterrd($machine, "disk-$mount", $date, $rrdstep, \%xmlhash, @data);
310                  ++$i;
# Line 267 | Line 319 | sub processdata() {
319              if(! -d "$rrddir/$machine") {
320                  # not sure on this umask, but it seems to work?
321                  mkdir "$rrddir/$machine", 0777;
322 +                &log("created directory $rrddir/$machine\n");
323              }
324              my($hash) = $xmlhash{"packet.attributes.hashCode"};
325              my($date) = $xmlhash{"packet.attributes.date"};
# Line 274 | Line 327 | sub processdata() {
327              # take a look to see if we have a shutdown packet...
328              if($xmlhash{"packet.attributes.shutdown"} && $xmlhash{"packet.attributes.shutdown"} eq "true") {
329                  unlink <$rrddir/$machine/$hash\_*.rrd>, "$rrddir/$machine/$hash.def", <$imgdir/$machine/$hash*.png>;
330 +                &log("deleted $rrddir/$machine/$hash\_*.rrd $rrddir/$machine/$hash.def $imgdir/$machine/$hash*.png\n");
331                  next;
332              }
333              # look through to see how many internal queues we have
# Line 283 | Line 337 | sub processdata() {
337                  if($xmlhash{"packet.queue.attributes.queue$i"} eq "[deleted]") {
338                      # delete the queues rrd
339                      unlink "$rrddir/$machine/$hash\_$i.rrd";
340 +                    &log("deleted $rrddir/$machine/$hash\_$i.rrd\n");
341                      # are there any other rrd's left on this queue? if not, cleanup.
342                      # get a list of any that may be still there..
343                      opendir(DIR, "$rrddir/$machine");
# Line 293 | Line 348 | sub processdata() {
348                      if($rrdcount == 0) {
349                          # clean up the def file and any images
350                          unlink "$rrddir/$machine/$hash.def", <$imgdir/$machine/$hash*.png>;
351 +                        &log("deleted $rrddir/$machine/$hash.def $imgdir/$machine/$hash*.png\n");
352                      }
353                      ++$i;
354                      next;
# Line 303 | Line 359 | sub processdata() {
359                      open(DEF, ">$rrddir/$machine/$hash.def");
360                      print DEF $name;
361                      close DEF;
362 +                    &log("created $rrddir/$machine/$hash.def\n");
363                  }
364                  my(@data) = ( "packet.queue.attributes.queue$i:size:GAUGE",
365                                "packet.queue.attributes.total:total:COUNTER",
# Line 312 | Line 369 | sub processdata() {
369              }
370          }
371          else {
372 <            #print STDERR "SKIPPED: valid xml, but not a data or statistics packet\n";
372 >            #&error("SKIPPED: valid xml, but not a data or statistics packet\n");
373          }
374      }
375      
376      # we'll now return from this sub and reconnect
377 <    print STDERR "Data channel socket gave no data, bailing out...\n";
377 >    &error("Data channel socket gave no data, bailing out...\n");
378   }
379  
380   #
# Line 349 | Line 406 | sub updaterrd() {
406              }
407          }
408          # call the &makerrd to actually create the rrd
409 <        print "making new rrd for $rrddir/$machine/$type.rrd\n";
409 >        &log("making new rrd for $rrddir/$machine/$type.rrd\n");
410          &makerrd($machine, $type, $date, $step, @createdata);
411      }
412      # get the details out of the data we've been given
# Line 366 | Line 423 | sub updaterrd() {
423      }
424      # perform the update
425      RRDs::update ("$rrddir/$machine/$type.rrd", $updateparams);
426 +    &log("updating $rrddir/$machine/$type.rrd\n");
427      my($err) = RRDs::error;
428 <    print STDERR "Error updating $rrddir/$machine/$type.rrd: $err\n" if $err;
428 >    &error("Error updating $rrddir/$machine/$type.rrd: $err\n") if $err;
429   }
430  
431   #
# Line 390 | Line 448 | sub makerrd() {
448      if(! -d "$rrddir/$machine") {
449          # not sure on this umask, but it seems to work?
450          mkdir "$rrddir/$machine", 0777;
451 +        &log("created directory $rrddir/$machine\n");
452      }
453      my(@rrdcmd);
454      # we'll want to add our first data item at $start,
# Line 423 | Line 482 | sub makerrd() {
482      );
483      RRDs::create (@rrdcmd);
484      my($err) = RRDs::error;
485 <    print STDERR "Error creating rrd for $rrddir/$machine/$type: $err\n" if $err;
485 >    &error("Error creating rrd for $rrddir/$machine/$type: $err\n") if $err;
486 > }
487 >
488 > # prints out usage information then exits
489 > sub usage() {
490 >    print "Usage: watch.pl [options] i-scream_client_interface port\n";
491 >    print "Options\n";
492 >    print "  -c config        Specifies the configuration file\n";
493 >    print "                    default: rrdgraphing.conf\n";
494 >    print "  -v               Be verbose about what's happening\n";
495 >    print "  -q               Be quiet, even supress errors\n";
496 >    print "  -V               Print version number\n";
497 >    print "  -h               Prints this help page\n";
498 >    exit(1);
499 > }
500 >
501 > # prints a log message if verbose is turned on
502 > sub log() {
503 >    my($msg) = @_;
504 >    print $msg if $verbose;
505 > }
506 >
507 > # prints an error message unless quiet is turned on
508 > sub error() {
509 >    my($msg) = @_;
510 >    print STDERR $msg unless $quiet;
511   }

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines