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

Comparing experimental/reports/graphing/watch.pl (file contents):
Revision 1.2 by tdb, Sun Mar 10 00:26:24 2002 UTC vs.
Revision 1.7 by tdb, Sun Aug 1 10:39:49 2004 UTC

# Line 2 | Line 2
2  
3   # -----------------------------------------------------------
4   # i-scream graph generation scripts
5 < # http://www.i-scream.org.uk
5 > # http://www.i-scream.org
6   #
7   # Generates rrd databases for i-scream data by connecting to
8   # the i-scream server and collecting data.
# Line 11 | Line 11
11   # $Id$
12   #------------------------------------------------------------
13  
14 + ## TODO
15 + # ought to think about cleaning up when we restart?
16 + #  -- old queue data etc
17 +
18   $| = 1;
19  
20   use strict;
# Line 34 | Line 38 | my($hex_slash) = "_2f";
38   # _ converted to a decimal then hex'd
39   my($hex_underscore) = "_5f";
40  
41 + # step interval in the rrd databases
42 + my($rrdstep) = 15;
43 +
44 + # time to wait (in seconds) before retrying a connection
45 + my($retry_wait) = 10;
46 +
47   if (@ARGV != 2) {
48 <    die "Usage: ihost.pl [i-scream client interface] [TCP port]\n";
48 >    die "Usage: watch.pl [i-scream client interface] [TCP port]\n";
49   }
50  
51 + # user supplied client interface server and port
52   my($addr) = $ARGV[0];
53   my($cport) = $ARGV[1];
54  
55 < my($csock) = new IO::Socket::INET(
56 <    PeerAddr => $addr,
57 <    PeerPort => $cport,
58 <    Proto => 'tcp'
59 <    ) or die "Cannot connect!";
60 <
61 < if (!defined $csock) {
62 <    print "ERROR: Could not connect to $addr:$cport.\n";
63 <    print "Please check that there is an i-scream server at this address.\n";
64 <    exit(1);
65 < }
66 <
67 < my($response);
68 <
69 < $response = <$csock>;
70 < if ($response && $response ne "PROTOCOL 1.1\n") {
71 <    print "The i-scream server sent an unexpected protocol id: $response\n";
55 > while(1) {
56 >    
57 >    print "Connecting control channel to port $cport on $addr...\n";
58 >    
59 >    # attempt to connect the control channel
60 >    my($csock) = new IO::Socket::INET(
61 >        PeerAddr => $addr,
62 >        PeerPort => $cport,
63 >        Proto => 'tcp'
64 >        );
65 >    
66 >    # if socket isn't defined connection failed
67 >    if (!defined $csock) {
68 >        print STDERR "ERROR: Could not connect control channel to $addr:$cport.\n";
69 >        print STDERR "Please check that there is an i-scream server at this address.\n";
70 >        &wait_then_retry();
71 >        next;
72 >    }
73 >    
74 >    my($response);
75 >    
76 >    # client interface should send it's protocol ID
77 >    # we know about "PROTOCOL 1.1", and will only accept the same
78 >    $response = <$csock>;
79 >    if ($response && $response ne "PROTOCOL 1.1\n") {
80 >        print STDERR "The i-scream server sent an unexpected protocol ID: $response\n";
81 >        close($csock);
82 >        &wait_then_retry();
83 >        next;
84 >    }
85 >    
86 >    # send our identifier to the client interface
87 >    print $csock "rrdgraphing\n";
88 >    $response = <$csock>;
89 >    if ($response && $response ne "OK\n") {
90 >        print STDERR "Received unexpected response: $response\n";
91 >        close($csock);
92 >        &wait_then_retry();
93 >        next;
94 >    }
95 >    
96 >    # tell the client interface we'd like to start the data channel
97 >    print $csock "STARTDATA\n";
98 >    
99 >    # the response should be the socket to connect the data channel to
100 >    $response = <$csock>;
101 >    chomp $response;
102 >    
103 >    my($dport) = $response;
104 >    print "Connecting data channel to port $dport on $addr...\n";
105 >    
106 >    # attempt to connect the data channel
107 >    my($dsock) = new IO::Socket::INET(
108 >        PeerAddr => $addr,
109 >        PeerPort => $dport,
110 >        Proto => 'tcp'
111 >        ) or die "arse?";
112 >    
113 >    # if socket isn't defined connection failed
114 >    if (!defined $dsock) {
115 >        print STDERR "ERROR: Could not connect data channel to $addr:$dport.\n";
116 >        print STDERR "Failure in communications.\n";
117 >        close($csock);
118 >        &wait_then_retry();
119 >        next;
120 >    }
121 >    
122 >    # the data channel should now be sending us data!
123 >    
124 >    # call sub to process data being received over the data channel
125 >    &processdata($dsock);
126 >    
127 >    # data processing has stopped, close sockets
128      close($csock);
129 <    exit(1);
129 >    close($dsock);
130 >    
131 >    # wait before retrying
132 >    &wait_then_retry();
133   }
134  
135 < print $csock "cpugrapher\n";
136 < $response = <$csock>;
67 < if ($response && $response ne "OK\n") {
68 <    print "Received unexpected response: $response\n";
69 <    close($csock);
70 <    exit(1);
71 < }
135 > # we'll never reach here... unless 1 becomes false for some reason ;)
136 > exit 0;
137  
73 print $csock "STARTDATA\n";
74 $response = <$csock>;
138  
139 < chop $response;
140 < print "Asked to connect to port $response on $addr, connecting...\n";
141 <
142 < my($dport) = $response;
143 <
144 < my($dsock) = new IO::Socket::INET(
82 <    PeerAddr => $addr,
83 <    PeerPort => $dport,
84 <    Proto => 'tcp'
85 <    ) or die "Cannot connect!";
86 <
87 < if (!defined $dsock) {
88 <    print "ERROR: Could not connect to $addr:$dport.\n";
89 <    print "Failure in communications.\n";
90 <    close($csock);
91 <    exit(1);
139 > #
140 > # wait for a while before retrying
141 > #
142 > sub wait_then_retry() {
143 >    print STDERR "Will retry connection to i-scream server in $retry_wait seconds.\n\n";
144 >    sleep $retry_wait;
145   }
146  
147 < ## below here has been "improved"
148 < ## above is still a mess ;)
149 <
150 < while(1) {
151 <    # read data
152 <    $response = <$dsock>;
147 > #
148 > # Given the socket of the data channel will process all
149 > # the incoming XML data, creating and updating the appropriate
150 > # database files.
151 > #
152 > # $dsock = socket connected to the data channel
153 > #
154 > sub processdata() {
155 >    # the socket connected to the data channel
156 >    my($dsock) = @_;
157 >    # save us recreating this variable each time we loop
158 >    my($xml);
159      
160 <    # attemp to parse the data
161 <    my($err, %xmlhash) = &iscream::XMLParser::parse($response);
162 <    if($err) {
104 <        print STDERR "Skipped, XML did not parse: $response";
105 <        next;
106 <    }
107 <    
108 <    # standard data packet
109 <    if($xmlhash{"packet.attributes.type"} eq "data") {
110 <        my($machine) = $xmlhash{"packet.attributes.machine_name"};
111 <        my($date) = $xmlhash{"packet.attributes.date"};
160 >    while(1) {
161 >        # read data
162 >        $xml = <$dsock>;
163          
164 <        # make directory for machine
165 <        if(! -d "$rrddir/$machine") {
166 <            # not sure on this umask, but it seems to work?
167 <            mkdir "$rrddir/$machine", 0777;
164 >        # something odd has happened
165 >        last if not defined $xml;
166 >        
167 >        # attempt to parse the data
168 >        my($err, %xmlhash) = &iscream::XMLParser::parse($xml);
169 >        if($err) {
170 >            print STDERR "Skipped, XML did not parse: $xml";
171 >            next;
172          }
173          
174 <        my(@data);
175 <        
176 <        # cpu
177 <        @data = ( "packet.cpu.idle:idle:GAUGE",
178 <                  "packet.cpu.user:user:GAUGE",
179 <                  "packet.cpu.kernel:kernel:GAUGE",
180 <                  "packet.cpu.swap:swap:GAUGE",
181 <                  "packet.cpu.iowait:iowait:GAUGE",
182 <                 );
183 <        &updaterrd($machine, "cpu", $date, 15, \%xmlhash, @data);
184 <              
185 <        # mem
186 <        @data = ( "packet.memory.free:free:GAUGE",
187 <                  "packet.memory.total:total:GAUGE",
188 <                 );
189 <        &updaterrd($machine, "mem", $date, 15, \%xmlhash, @data);
190 <                
191 <        # load
192 <        @data = ( "packet.load.load1:load1:GAUGE",
138 <                  "packet.load.load5:load5:GAUGE",
139 <                  "packet.load.load15:load15:GAUGE",
140 <                 );
141 <        &updaterrd($machine, "load", $date, 15, \%xmlhash, @data);
142 <        
143 <        # processes
144 <        @data = ( "packet.processes.cpu:cpu:GAUGE",
145 <                  "packet.processes.sleeping:sleeping:GAUGE",
146 <                  "packet.processes.stopped:stopped:GAUGE",
147 <                  "packet.processes.total:total:GAUGE",
148 <                  "packet.processes.zombie:zombie:GAUGE",
149 <                 );
150 <        &updaterrd($machine, "proc", $date, 15, \%xmlhash, @data);
151 <        
152 <        # swap
153 <        @data = ( "packet.swap.free:free:GAUGE",
154 <                  "packet.swap.total:total:GAUGE",
155 <                 );
156 <        &updaterrd($machine, "swap", $date, 15, \%xmlhash, @data);
157 <        
158 <        # users
159 <        @data = ( "packet.users.count:count:GAUGE",
160 <                 );
161 <        &updaterrd($machine, "users", $date, 15, \%xmlhash, @data);
162 <        
163 <        # disk
164 <        my($i) = 0;
165 <        while(defined $xmlhash{"packet.disk.p$i.attributes.mount"}) {
166 <            my($mount) = $xmlhash{"packet.disk.p$i.attributes.mount"};
167 <            $mount =~ s/_/$hex_underscore/g;
168 <            $mount =~ s/\//$hex_slash/g;
169 <            @data = ( "packet.disk.p$i.attributes.kbytes:kbytes:GAUGE",
170 <                      "packet.disk.p$i.attributes.used:used:GAUGE",
174 >        # standard data packet
175 >        if($xmlhash{"packet.attributes.type"} eq "data") {
176 >            my($machine) = $xmlhash{"packet.attributes.machine_name"};
177 >            my($date) = $xmlhash{"packet.attributes.date"};
178 >            
179 >            # make directory for machine
180 >            if(! -d "$rrddir/$machine") {
181 >                # not sure on this umask, but it seems to work?
182 >                mkdir "$rrddir/$machine", 0777;
183 >            }
184 >            
185 >            my(@data);
186 >            
187 >            # cpu
188 >            @data = ( "packet.cpu.idle:idle:GAUGE",
189 >                      "packet.cpu.user:user:GAUGE",
190 >                      "packet.cpu.kernel:kernel:GAUGE",
191 >                      "packet.cpu.swap:swap:GAUGE",
192 >                      "packet.cpu.iowait:iowait:GAUGE",
193                       );
194 <            &updaterrd($machine, "disk-$mount", $date, 15, \%xmlhash, @data);
195 <            ++$i;
194 >            &updaterrd($machine, "cpu", $date, $rrdstep, \%xmlhash, @data);
195 >                  
196 >            # mem
197 >            @data = ( "packet.memory.free:free:GAUGE",
198 >                      "packet.memory.total:total:GAUGE",
199 >                     );
200 >            &updaterrd($machine, "mem", $date, $rrdstep, \%xmlhash, @data);
201 >                    
202 >            # load
203 >            @data = ( "packet.load.load1:load1:GAUGE",
204 >                      "packet.load.load5:load5:GAUGE",
205 >                      "packet.load.load15:load15:GAUGE",
206 >                     );
207 >            &updaterrd($machine, "load", $date, $rrdstep, \%xmlhash, @data);
208 >            
209 >            # processes
210 >            @data = ( "packet.processes.cpu:cpu:GAUGE",
211 >                      "packet.processes.sleeping:sleeping:GAUGE",
212 >                      "packet.processes.stopped:stopped:GAUGE",
213 >                      "packet.processes.total:total:GAUGE",
214 >                      "packet.processes.zombie:zombie:GAUGE",
215 >                     );
216 >            &updaterrd($machine, "proc", $date, $rrdstep, \%xmlhash, @data);
217 >            
218 >            # swap
219 >            @data = ( "packet.swap.free:free:GAUGE",
220 >                      "packet.swap.total:total:GAUGE",
221 >                     );
222 >            &updaterrd($machine, "swap", $date, $rrdstep, \%xmlhash, @data);
223 >            
224 >            # users
225 >            @data = ( "packet.users.count:count:GAUGE",
226 >                     );
227 >            &updaterrd($machine, "users", $date, $rrdstep, \%xmlhash, @data);
228 >            
229 >            # disk
230 >            my($i) = 0;
231 >            while(defined $xmlhash{"packet.disk.p$i.attributes.mount"}) {
232 >                my($mount) = $xmlhash{"packet.disk.p$i.attributes.mount"};
233 >                $mount =~ s/_/$hex_underscore/g;
234 >                $mount =~ s/\//$hex_slash/g;
235 >                @data = ( "packet.disk.p$i.attributes.kbytes:kbytes:GAUGE",
236 >                          "packet.disk.p$i.attributes.used:used:GAUGE",
237 >                         );
238 >                &updaterrd($machine, "disk-$mount", $date, $rrdstep, \%xmlhash, @data);
239 >                ++$i;
240 >            }
241          }
242 <    }
243 <    
244 <    # queue statistics packet
245 <    elsif($xmlhash{"packet.attributes.type"} eq "queueStat") {
246 <        # psuedo machine for internal server stuff
247 <        my($machine) = "i-scream-server";
248 <        # make directory
249 <        if(! -d "$rrddir/$machine") {
250 <            # not sure on this umask, but it seems to work?
251 <            mkdir "$rrddir/$machine", 0777;
252 <        }
253 <        my($hash) = $xmlhash{"packet.attributes.hashCode"};
254 <        my($date) = $xmlhash{"packet.attributes.date"};
255 <        my($name) = $xmlhash{"packet.attributes.name"};
256 <        # take a look to see if we have a shutdown packet...
257 <        if($xmlhash{"packet.attributes.shutdown"} && $xmlhash{"packet.attributes.shutdown"} eq "true") {
258 <            unlink <$rrddir/$machine/$hash\_*.rrd>, "$rrddir/$machine/$hash.def", <$imgdir/$machine/$hash*.png>;
259 <            next;
260 <        }
261 <        # look through to see how many internal queues we have
262 <        my($i) = 0;
263 <        while(defined $xmlhash{"packet.queue.attributes.queue$i"}) {
264 <            # see if the queue has been removed
265 <            if($xmlhash{"packet.queue.attributes.queue$i"} eq "[deleted]") {
266 <                # delete the queues rrd
267 <                unlink "$rrddir/$machine/$hash\_$i.rrd";
268 <                # are there any other rrd's left on this queue? if not, cleanup.
269 <                # get a list of any that may be still there..
270 <                opendir(DIR, "$rrddir/$machine");
271 <                my(@rrdcountfiles) = grep { -f "$rrddir/$machine/$_" && /^$hash\_\d+.rrd$/ } readdir(DIR);
272 <                closedir DIR;
273 <                # count them (+1 because an empty array is size -1)
274 <                my($rrdcount) = $#rrdcountfiles + 1;
275 <                if($rrdcount == 0) {
276 <                    # clean up the def file and any images
277 <                    unlink "$rrddir/$machine/$hash.def", <$imgdir/$machine/$hash*.png>;
242 >        
243 >        # queue statistics packet
244 >        elsif($xmlhash{"packet.attributes.type"} eq "queueStat") {
245 >            # psuedo machine for internal server stuff
246 >            my($machine) = "i-scream-server";
247 >            # make directory
248 >            if(! -d "$rrddir/$machine") {
249 >                # not sure on this umask, but it seems to work?
250 >                mkdir "$rrddir/$machine", 0777;
251 >            }
252 >            my($hash) = $xmlhash{"packet.attributes.hashCode"};
253 >            my($date) = $xmlhash{"packet.attributes.date"};
254 >            my($name) = $xmlhash{"packet.attributes.name"};
255 >            # take a look to see if we have a shutdown packet...
256 >            if($xmlhash{"packet.attributes.shutdown"} && $xmlhash{"packet.attributes.shutdown"} eq "true") {
257 >                unlink <$rrddir/$machine/$hash\_*.rrd>, "$rrddir/$machine/$hash.def", <$imgdir/$machine/$hash*.png>;
258 >                next;
259 >            }
260 >            # look through to see how many internal queues we have
261 >            my($i) = 0;
262 >            while(defined $xmlhash{"packet.queue.attributes.queue$i"}) {
263 >                # see if the queue has been removed
264 >                if($xmlhash{"packet.queue.attributes.queue$i"} eq "[deleted]") {
265 >                    # delete the queues rrd
266 >                    unlink "$rrddir/$machine/$hash\_$i.rrd";
267 >                    # are there any other rrd's left on this queue? if not, cleanup.
268 >                    # get a list of any that may be still there..
269 >                    opendir(DIR, "$rrddir/$machine");
270 >                    my(@rrdcountfiles) = grep { -f "$rrddir/$machine/$_" && /^$hash\_\d+.rrd$/ } readdir(DIR);
271 >                    closedir DIR;
272 >                    # count them (+1 because an empty array is size -1)
273 >                    my($rrdcount) = $#rrdcountfiles + 1;
274 >                    if($rrdcount == 0) {
275 >                        # clean up the def file and any images
276 >                        unlink "$rrddir/$machine/$hash.def", <$imgdir/$machine/$hash*.png>;
277 >                    }
278 >                    ++$i;
279 >                    next;
280                  }
281 +                # the &updaterrd will also do this check, but we want
282 +                # to write our def file out first
283 +                if( ! -f "$rrddir/$machine/$hash\_$i.rrd" ) {
284 +                    open(DEF, ">$rrddir/$machine/$hash.def");
285 +                    print DEF $name;
286 +                    close DEF;
287 +                }
288 +                my(@data) = ( "packet.queue.attributes.queue$i:size:GAUGE",
289 +                              "packet.queue.attributes.total:total:COUNTER",
290 +                             );
291 +                &updaterrd($machine, "$hash\_$i", $date, $rrdstep, \%xmlhash, @data);
292                  ++$i;
213                next;
293              }
215            # the &updaterrd will also do this check, but we want
216            # to write our def file out first
217            if( ! -f "$rrddir/$machine/$hash\_$i.rrd" ) {
218                open(DEF, ">$rrddir/$machine/$hash.def");
219                print DEF $name;
220                close DEF;
221            }
222            my(@data) = ( "packet.queue.attributes.queue$i:size:GAUGE",
223                          "packet.queue.attributes.total:total:GAUGE",
224                         );
225            &updaterrd($machine, "$hash\_$i", $date, 15, \%xmlhash, @data);
226            ++$i;
294          }
295 +        else {
296 +            #print STDERR "SKIPPED: valid xml, but not a data or statistics packet\n";
297 +        }
298      }
299 <    else {
300 <        #print "SKIPPED: valid xml, but not a data or statistics packet\n";
301 <    }
299 >    
300 >    # we'll now return from this sub and reconnect
301 >    print STDERR "Data channel socket gave no data, bailing out...\n";
302   }
303  
234 # we'll never reach here... unless 1 becomes false for some reason ;)
235 exit 0;
236
237
304   #
305   # sub to update an rrd file
306   #
# Line 272 | Line 338 | sub updaterrd() {
338      foreach my $dataitem (@data) {
339          if($dataitem =~ /^(\S+):\S+:\S+$/) {
340              # pull the values straight out of the xmlhash
341 <            $updateparams .= ":$xmlhash{$1}";
341 >            my($value) = $xmlhash{$1};
342 >            # if it's undefined we'll set it to 0
343 >            # this probably shouldn't happen, but it'd be best to handle it "nicely" :)
344 >            $value = "0" if not defined $value;
345 >            $updateparams .= ":$value";
346          }
347      }
348      # perform the update
# Line 327 | Line 397 | sub makerrd() {
397          "RRA:MAX:0.5:60:672",
398          # 1m in 1hr samples
399          "RRA:AVERAGE:0.5:240:744",
400 <        "RRA:MAX:0.5:60:744",
400 >        "RRA:MAX:0.5:240:744",
401 >        # 1y in 12hr samples
402 >        "RRA:AVERAGE:0.5:2880:730",
403 >        "RRA:MAX:0.5:2880:730",
404      );
405      RRDs::create (@rrdcmd);
406      my($err) = RRDs::error;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines