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.1 by tdb, Sat Mar 9 19:53:24 2002 UTC vs.
Revision 1.5 by tdb, Sun Mar 10 15:42:19 2002 UTC

# Line 1 | Line 1
1   #!/usr/bin/perl -w
2  
3 + # -----------------------------------------------------------
4 + # i-scream graph generation scripts
5 + # http://www.i-scream.org.uk
6 + #
7 + # Generates rrd databases for i-scream data by connecting to
8 + # the i-scream server and collecting data.
9 + #
10 + # $Author$
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 7 | Line 22 | use iscream::XMLParser;
22   use IO::Socket;
23   use RRDs;
24  
25 < if (@ARGV != 2) {
26 <    die "Usage: ihost.pl [i-scream client interface] [TCP port]\n";
27 < }
25 > # Base directory for images
26 > # (a directory will be constructed for each host under this)
27 > my($imgdir) = "/home/tdb/public_html/rrd";
28  
29 < my($addr) = $ARGV[0];
30 < my($cport) = $ARGV[1];
29 > # Location of RRD databases
30 > my($rrddir) = "/u1/i-scream/rrd";
31  
32 < #print `rm -f *.rrd *.png`;
32 > # for reference:
33 > # ch -> hex: $hex = sprintf("%02x", ord($ch));
34 > # hex -> ch: $ch = chr(hex($hex));
35  
36 < my($csock) = new IO::Socket::INET(
37 <    PeerAddr => $addr,
38 <    PeerPort => $cport,
39 <    Proto => 'tcp'
23 <    ) or die "Cannot connect!";
36 > # / converted to a decimal then hex'd
37 > my($hex_slash) = "_2f";
38 > # _ converted to a decimal then hex'd
39 > my($hex_underscore) = "_5f";
40  
41 < if (!defined $csock) {
42 <    print "ERROR: Could not connect to $addr:$cport.\n";
27 <    print "Please check that there is an i-scream server at this address.\n";
28 <    exit(1);
29 < }
41 > # step interval in the rrd databases
42 > my($rrdstep) = 15;
43  
44 < my($response);
44 > # time to wait (in seconds) before retrying a connection
45 > my($retry_wait) = 10;
46  
47 < $response = <$csock>;
48 < if ($response && $response ne "PROTOCOL 1.1\n") {
35 <    print "The i-scream server sent an unexpected protocol id: $response\n";
36 <    close($csock);
37 <    exit(1);
47 > if (@ARGV != 2) {
48 >    die "Usage: watch.pl [i-scream client interface] [TCP port]\n";
49   }
50  
51 < print $csock "cpugrapher\n";
52 < $response = <$csock>;
53 < if ($response && $response ne "OK\n") {
54 <    print "Received unexpected response: $response\n";
51 > # user supplied client interface server and port
52 > my($addr) = $ARGV[0];
53 > my($cport) = $ARGV[1];
54 >
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 "SETHOSTLIST\n";
136 < #$response = <$csock>;
50 < #if ($response && $response ne "OK\n") {
51 < #    print "Received odd response: $response\n";
52 < #    close($csock);
53 < #    exit(1);
54 < #}
135 > # we'll never reach here... unless 1 becomes false for some reason ;)
136 > exit 0;
137  
56 #print $csock "myrtle.ukc.ac.uk\n";
57 #$response = <$csock>;
58 #if ($response && $response ne "OK\n") {
59 #    print "Received odd response: $response\n";
60 #    close($csock);
61 #    exit(1);
62 #}
138  
139 < print $csock "STARTDATA\n";
140 < $response = <$csock>;
141 <
142 < chop $response;
143 < print "Asked to connect to port $response on $addr, connecting...\n";
144 <
70 < my($dport) = $response;
71 <
72 < my($dsock) = new IO::Socket::INET(
73 <    PeerAddr => $addr,
74 <    PeerPort => $dport,
75 <    Proto => 'tcp'
76 <    ) or die "Cannot connect!";
77 <
78 < if (!defined $dsock) {
79 <    print "ERROR: Could not connect to $addr:$dport.\n";
80 <    print "Failure in communications.\n";
81 <    close($csock);
82 <    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 < while(1) {
148 <    $response = <$dsock>;
149 < #print "$response\n";
150 <    my($err, %xmlhash) = &iscream::XMLParser::parse($response);
151 <    if($err) {
152 <        print "SKIPPED (bad xml): $response";
153 <    }
154 <    ## -- mental note, think about ordering checks for optimal speed ;)
155 <    # take a look to see if we have a shutdown packet...
156 <    if($xmlhash{"packet.attributes.type"} eq "data") {
157 <        my($machine) = $xmlhash{"packet.attributes.machine_name"};
158 <        my($date) = $xmlhash{"packet.attributes.date"};
159 <        # make directory for machine
160 <        if(! -d "$machine") {
161 <            # not sure on this umask, but it seems to work?
162 <            mkdir "$machine", 0777;
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 >    while(1) {
161 >        # read data
162 >        $xml = <$dsock>;
163 >        
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 <        # cpu
174 <        my($cpu_idle) = $xmlhash{"packet.cpu.idle"};
175 <        my($cpu_user) = $xmlhash{"packet.cpu.user"};
176 <        my($cpu_kernel) = $xmlhash{"packet.cpu.kernel"};
177 <        my($cpu_swap) = $xmlhash{"packet.cpu.swap"};
178 <        my($cpu_iowait) = $xmlhash{"packet.cpu.iowait"};
179 <        if( ! -f "$machine/cpu.rrd") {
180 <            print "making new rrd for $machine\_cpu\n";
181 <            &makerrd_cpu($machine, $date);
182 <        }
112 <        #my($cmd) = "rrdtool update $machine\_cpu.rrd $date:$cpu_idle:$cpu_user:$cpu_kernel:$cpu_swap:$cpu_iowait";
113 <        RRDs::update ("$machine/cpu.rrd", "$date:$cpu_idle:$cpu_user:$cpu_kernel:$cpu_swap:$cpu_iowait");
114 <        #print "done $machine\n";
115 <        my($err_cpu) = RRDs::error;
116 <        die "Error_cpu: $err_cpu\n" if $err_cpu;
117 <        #print "$cmd\n";
118 <        #print `$cmd`;
119 <        # mem
120 <        my($mem_free) = $xmlhash{"packet.memory.free"};
121 <        my($mem_total) = $xmlhash{"packet.memory.total"};
122 <        if( ! -f "$machine/mem.rrd") {
123 <            print "making new rrd for $machine\_mem\n";
124 <            &makerrd_mem($machine, $date);
125 <        }
126 <        RRDs::update ("$machine/mem.rrd", "$date:$mem_free:$mem_total");
127 <        my($err_mem) = RRDs::error;
128 <        die "Error_mem: $err_mem\n" if $err_mem;
129 <        # load
130 <        my($load_1) = $xmlhash{"packet.load.load1"};
131 <        my($load_5) = $xmlhash{"packet.load.load5"};
132 <        my($load_15) = $xmlhash{"packet.load.load15"};
133 <        if( ! -f "$machine/load.rrd") {
134 <            print "making new rrd for $machine\_load\n";
135 <            &makerrd_load($machine, $date);
136 <        }
137 <        RRDs::update ("$machine/load.rrd", "$date:$load_1:$load_5:$load_15");
138 <        my($err_load) = RRDs::error;
139 <        die "Error_load: $err_load\n" if $err_load;
140 <        # processes
141 <        my($proc_cpu) = $xmlhash{"packet.processes.cpu"};
142 <        my($proc_sleeping) = $xmlhash{"packet.processes.sleeping"};  
143 <        my($proc_stopped) = $xmlhash{"packet.processes.stopped"};
144 <        my($proc_total) = $xmlhash{"packet.processes.total"};  
145 <        my($proc_zombie) = $xmlhash{"packet.processes.zombie"};
146 <        if( ! -f "$machine/proc.rrd") {
147 <            print "making new rrd for $machine\_proc\n";
148 <            &makerrd_proc($machine, $date);
149 <        }
150 <        RRDs::update ("$machine/proc.rrd", "$date:$proc_cpu:$proc_sleeping:$proc_stopped:$proc_total:$proc_zombie");
151 <        my($err_proc) = RRDs::error;
152 <        die "Error_proc: $err_proc\n" if $err_proc;
153 <        # swap
154 <        my($swap_free) = $xmlhash{"packet.swap.free"};
155 <        my($swap_total) = $xmlhash{"packet.swap.total"};
156 <        if( ! -f "$machine/swap.rrd") {
157 <            print "making new rrd for $machine\_swap\n";
158 <            &makerrd_swap($machine, $date);
159 <        }
160 <        RRDs::update ("$machine/swap.rrd", "$date:$swap_free:$swap_total");
161 <        my($err_swap) = RRDs::error;
162 <        die "Error_swap: $err_swap\n" if $err_swap;
163 <        # users
164 <        my($users_count) = $xmlhash{"packet.users.count"};
165 <        if( ! -f "$machine/users.rrd") {
166 <            print "making new rrd for $machine\_users\n";
167 <            &makerrd_users($machine, $date);
168 <        }
169 <        RRDs::update ("$machine/users.rrd", "$date:$users_count");
170 <        my($err_users) = RRDs::error;
171 <        die "Error_users: $err_users\n" if $err_users;
172 <        # disk
173 <        # some definitions
174 <        # ch -> hex: $hex = sprintf("%02x", ord($ch));
175 <        # hex -> ch: $ch = chr(hex($hex));
176 <        # / converted to a decimal then hex'd
177 <        my($hex_slash) = "_2f";
178 <        # _ converted to a decimal then hex'd
179 <        my($hex_underscore) = "_5f";
180 <        my($i) = 0;
181 <        while(defined $xmlhash{"packet.disk.p$i.attributes.mount"}) {
182 <            #my($name) = $xmlhash{"packet.disk.p$i.attributes.name"};
183 <            my($mount) = $xmlhash{"packet.disk.p$i.attributes.mount"};
184 <            #print "$response\n";
185 <            #print "$i: $machine $name\n";
186 <            #$mount =~ s/-/--/g;
187 <            my($encmount) = $mount;
188 <            $encmount =~ s/_/$hex_underscore/g;
189 <            $encmount =~ s/\//$hex_slash/g;
190 <            if( ! -f "$machine/disk-$encmount.rrd" ) {
191 <                print "making new database for $machine\_disk-$encmount\n";
192 <                &makerrd_disk($machine, $date, $encmount);
173 >        
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 <            #my($avail) = $xmlhash{"packet.disk.p$i.attributes.avail"};
185 <            my($kbytes) = $xmlhash{"packet.disk.p$i.attributes.kbytes"};
186 <            my($used) = $xmlhash{"packet.disk.p$i.attributes.used"};
187 <            #print "$machine\_disk-$name.rrd $date:$kbytes:$used\n";
188 <            RRDs::update ("$machine/disk-$encmount.rrd", "$date:$kbytes:$used");
189 <            my($err_disk) = RRDs::error;
190 <            die "Error_disk: $err_disk\n" if $err_disk;
191 <            ++$i;
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, "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 <    elsif($xmlhash{"packet.attributes.type"} eq "queueStat") {
245 <        # make directory
246 <        if(! -d "i-scream-server") {
247 <            # not sure on this umask, but it seems to work?
248 <            mkdir "i-scream-server", 0777;
249 <        }
250 <        # take a look to see if we have a shutdown packet...
251 <        if($xmlhash{"packet.attributes.shutdown"} && $xmlhash{"packet.attributes.shutdown"} eq "true") {
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($cmd) = "rm -f i-scream-server/$hash\_*.rrd /home/tdb/public_html/rrd/i-scream-server/$hash*.png i-scream-server/$hash.def";
254 <            print `$cmd`;
255 <            print "$cmd\n";
256 <            next;
257 <        }
258 <        my($hash) = $xmlhash{"packet.attributes.hashCode"};
220 <        my($date) = $xmlhash{"packet.attributes.date"};
221 <        my($name) = $xmlhash{"packet.attributes.name"};
222 <        my($total) = $xmlhash{"packet.queue.attributes.total"};
223 <        my($i) = 0;
224 <        while(defined $xmlhash{"packet.queue.attributes.queue$i"}) {
225 <            if( ! -f "i-scream-server/$hash\_$i.rrd" ) {
226 <                print "making new database for $hash\_$i\n";
227 <                &makerrd_queue($hash, $i, $date, $name);
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 <            my($size) = $xmlhash{"packet.queue.attributes.queue$i"};
261 <            my($cmd);
262 <            # see if the queue has been removed
263 <            if($size eq "[deleted]") {
264 <                $cmd = "rm -f i-scream-server/$hash\_$i.rrd";
265 <                # are there any other rrd's left? if not, cleanup!
266 <                my($rrdcount) = `ls i-scream-server | grep $hash\_\\*.rrd | wc -l`;
267 <                if($rrdcount == 0) {
268 <                    $cmd = $cmd . " && rm -f i-scream-server/$hash.def /home/tdb/public_html/rrd/i-scream-server/$hash*.png";
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 <                print `$cmd`;
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;
293              }
241            else {
242                RRDs::update ("i-scream-server/$hash\_$i.rrd", "$date:$size:$total");
243                my($err_disk) = RRDs::error;
244                die "Error_disk: $err_disk\n" if $err_disk;
245            }
246            ++$i;
294          }
295 +        else {
296 +            #print STDERR "SKIPPED: valid xml, but not a data or statistics packet\n";
297 +        }
298      }
249    else {
250        #print "SKIPPED: valid xml, but not a data packet\n";
251    }
252 }
253
254 exit 0;
255
256 sub makerrd_cpu() {
257    my($machine, $start) = @_;
258    $start = $start - 15;
259    my($init) = "rrdtool create $machine/cpu.rrd --start $start --step 15";
260    my($ds1) = "DS:idle:GAUGE:600:U:U DS:user:GAUGE:600:U:U";
261    my($ds2) = "DS:kernel:GAUGE:600:U:U DS:swap:GAUGE:600:U:U DS:iowait:GAUGE:600:U:U";
262    #            3h in 15s samples     1d in 2m samples      1w in 15m samples      1m in 1hr samples
263    my($rra1) = "RRA:AVERAGE:0.5:1:720 RRA:AVERAGE:0.5:8:720 RRA:AVERAGE:0.5:60:672 RRA:AVERAGE:0.5:240:744";
264    my($rra2) = "RRA:MAX:0.5:1:720 RRA:MAX:0.5:8:720 RRA:MAX:0.5:60:672 RRA:MAX:0.5:60:744";
265    my($cmd) = "$init $ds1 $ds2 $rra1 $rra2";
266    print `$cmd`;
267    print "$cmd\n";
268    print `chmod 600 $machine/cpu.rrd`;
269 }
270
271 sub makerrd_mem() {
272    my($machine, $start) = @_;
273    $start = $start - 15;
274    my($init) = "rrdtool create $machine/mem.rrd --start $start --step 15";
275    my($ds) = "DS:free:GAUGE:600:U:U DS:total:GAUGE:600:U:U";
276    #            3h in 15s samples     1d in 2m samples      1w in 15m samples      1m in 1hr samples
277    my($rra1) = "RRA:AVERAGE:0.5:1:720 RRA:AVERAGE:0.5:8:720 RRA:AVERAGE:0.5:60:672 RRA:AVERAGE:0.5:240:744";
278    my($rra2) = "RRA:MAX:0.5:1:720 RRA:MAX:0.5:8:720 RRA:MAX:0.5:60:672 RRA:MAX:0.5:60:744";
279    my($cmd) = "$init $ds $rra1 $rra2";
280    print `$cmd`;
281    print "$cmd\n";
282    print `chmod 600 $machine/mem.rrd`;
283 }
284            
285 sub makerrd_load() {
286    my($machine, $start) = @_;
287    $start = $start - 15;
288    my($init) = "rrdtool create $machine/load.rrd --start $start --step 15";
289    my($ds) = "DS:load1:GAUGE:600:U:U DS:load5:GAUGE:600:U:U DS:load15:GAUGE:600:U:U";
290    #            3h in 15s samples     1d in 2m samples      1w in 15m samples      1m in 1hr samples
291    my($rra1) = "RRA:AVERAGE:0.5:1:720 RRA:AVERAGE:0.5:8:720 RRA:AVERAGE:0.5:60:672 RRA:AVERAGE:0.5:240:744";
292    my($rra2) = "RRA:MAX:0.5:1:720 RRA:MAX:0.5:8:720 RRA:MAX:0.5:60:672 RRA:MAX:0.5:60:744";
293    my($cmd) = "$init $ds $rra1 $rra2";
294    print `$cmd`;
295    print "$cmd\n";
296    print `chmod 600 $machine/load.rrd`;
297 }
298
299 sub makerrd_proc() {
300    my($machine, $start) = @_;
301    $start = $start - 15;
302    my($init) = "rrdtool create $machine/proc.rrd --start $start --step 15";
303    my($ds1) = "DS:cpu:GAUGE:600:U:U DS:sleeping:GAUGE:600:U:U";
304    my($ds2) = "DS:stopped:GAUGE:600:U:U DS:total:GAUGE:600:U:U DS:zombie:GAUGE:600:U:U";
305    #            3h in 15s samples     1d in 2m samples      1w in 15m samples      1m in 1hr samples
306    my($rra1) = "RRA:AVERAGE:0.5:1:720 RRA:AVERAGE:0.5:8:720 RRA:AVERAGE:0.5:60:672 RRA:AVERAGE:0.5:240:744";
307    my($rra2) = "RRA:MAX:0.5:1:720 RRA:MAX:0.5:8:720 RRA:MAX:0.5:60:672 RRA:MAX:0.5:60:744";
308    my($cmd) = "$init $ds1 $ds2 $rra1 $rra2";
309    print `$cmd`;
310    print "$cmd\n";
311    print `chmod 600 $machine/proc.rrd`;
312 }
313
314 sub makerrd_swap() {
315    my($machine, $start) = @_;
316    $start = $start - 15;
317    my($init) = "rrdtool create $machine/swap.rrd --start $start --step 15";
318    my($ds) = "DS:free:GAUGE:600:U:U DS:total:GAUGE:600:U:U";  
319    #            3h in 15s samples     1d in 2m samples      1w in 15m samples      1m in 1hr samples
320    my($rra1) = "RRA:AVERAGE:0.5:1:720 RRA:AVERAGE:0.5:8:720 RRA:AVERAGE:0.5:60:672 RRA:AVERAGE:0.5:240:744";
321    my($rra2) = "RRA:MAX:0.5:1:720 RRA:MAX:0.5:8:720 RRA:MAX:0.5:60:672 RRA:MAX:0.5:60:744";
322    my($cmd) = "$init $ds $rra1 $rra2";
323    print `$cmd`;
324    print "$cmd\n";
325    print `chmod 600 $machine/swap.rrd`;
326 }
299      
300 < sub makerrd_users() {
301 <    my($machine, $start) = @_;
330 <    $start = $start - 15;
331 <    my($init) = "rrdtool create $machine/users.rrd --start $start --step 15";
332 <    my($ds) = "DS:count:GAUGE:600:U:U";
333 <    #            3h in 15s samples     1d in 2m samples      1w in 15m samples      1m in 1hr samples
334 <    my($rra1) = "RRA:AVERAGE:0.5:1:720 RRA:AVERAGE:0.5:8:720 RRA:AVERAGE:0.5:60:672 RRA:AVERAGE:0.5:240:744";
335 <    my($rra2) = "RRA:MAX:0.5:1:720 RRA:MAX:0.5:8:720 RRA:MAX:0.5:60:672 RRA:MAX:0.5:60:744";
336 <    my($cmd) = "$init $ds $rra1 $rra2";
337 <    print `$cmd`;
338 <    print "$cmd\n";
339 <    print `chmod 600 $machine/users.rrd`;
300 >    # we'll now return from this sub and reconnect
301 >    print STDERR "Data channel socket gave no data, bailing out...\n";
302   }
303  
304 < sub makerrd_disk() {
305 <    my($machine, $start, $mount) = @_;
306 <    $start = $start - 15;
307 <    my($init) = "rrdtool create $machine/disk-$mount.rrd --start $start --step 15";
308 <    my($ds) = "DS:kbytes:GAUGE:600:U:U DS:used:GAUGE:600:U:U";
309 <    #            3h in 15s samples     1d in 2m samples      1w in 15m samples      1m in 1hr samples
310 <    my($rra1) = "RRA:AVERAGE:0.5:1:720 RRA:AVERAGE:0.5:8:720 RRA:AVERAGE:0.5:60:672 RRA:AVERAGE:0.5:240:744";
311 <    my($rra2) = "RRA:MAX:0.5:1:720 RRA:MAX:0.5:8:720 RRA:MAX:0.5:60:672 RRA:MAX:0.5:60:744";
312 <    my($cmd) = "$init $ds $rra1 $rra2";
313 <    print `$cmd`;
314 <    print "$cmd\n";
315 <    print `chmod 600 $machine/disk-$mount.rrd`;
304 > #
305 > # sub to update an rrd file
306 > #
307 > # $machine   = name of the machine
308 > #              (eg. kernow.ukc.ac.uk)
309 > # $type      = the type of graph for the machine
310 > #              (eg. cpu)
311 > # $date      = the date of the item we want to add
312 > #              (in seconds since the epoch)
313 > # $step      = the interval at which the database steps
314 > #              used when we create a new rrd
315 > # $xmlref    = reference to the xml data packet
316 > # @data      = array containing data items to add
317 > #              (eg. "packet.cpu.user:user:GAUGE")
318 > #
319 > sub updaterrd() {
320 >    my($machine, $type, $date, $step, $xmlref, @data) = @_;
321 >    # get hold of the xmlhash we have a reference to
322 >    my(%xmlhash) = %$xmlref;
323 >    # check if we need to create a new rrd
324 >    if( ! -f "$rrddir/$machine/$type.rrd") {
325 >        my(@createdata);
326 >        # pull the details out of the data we've been given
327 >        foreach my $dataitem (@data) {
328 >            if($dataitem =~ /^\S+:(\S+):(\S+)$/) {
329 >                push @createdata, "$1:$2";
330 >            }
331 >        }
332 >        # call the &makerrd to actually create the rrd
333 >        print "making new rrd for $rrddir/$machine/$type.rrd\n";
334 >        &makerrd($machine, $type, $date, $step, @createdata);
335 >    }
336 >    # get the details out of the data we've been given
337 >    my($updateparams) = "$date";
338 >    foreach my $dataitem (@data) {
339 >        if($dataitem =~ /^(\S+):\S+:\S+$/) {
340 >            # pull the values straight out of the xmlhash
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
349 >    RRDs::update ("$rrddir/$machine/$type.rrd", $updateparams);
350 >    my($err) = RRDs::error;
351 >    print STDERR "Error updating $rrddir/$machine/$type.rrd: $err\n" if $err;
352   }
353  
354 < sub makerrd_queue() {
355 <    my($name, $queuenum, $start, $comment) = @_;
356 <    $start = $start - 15;
357 <    my($init) = "rrdtool create i-scream-server/$name\_$queuenum.rrd --start $start --step 15";
358 <    my($ds) = "DS:size:GAUGE:600:U:U DS:total:COUNTER:600:U:U";
359 <    #            3h in 15s samples     1d in 2m samples      1w in 15m samples      1m in 1hr samples
360 <    my($rra1) = "RRA:AVERAGE:0.5:1:720 RRA:AVERAGE:0.5:8:720 RRA:AVERAGE:0.5:60:672 RRA:AVERAGE:0.5:240:744";
361 <    my($rra2) = "RRA:MAX:0.5:1:720 RRA:MAX:0.5:8:720 RRA:MAX:0.5:60:672 RRA:MAX:0.5:60:744";
362 <    my($cmd) = "$init $ds $rra1 $rra2";
363 <    print `$cmd`;
364 <    print "$cmd\n";
365 <    print `echo "$comment" > i-scream-server/$name.def`;
366 <    print `chmod 600 i-scream-server/$name\_$queuenum.rrd i-scream-server/$name.def`;
367 < }
354 > #
355 > # sub to create a new rrd file
356 > #
357 > # $machine = name of the machine
358 > #            (eg. kernow.ukc.ac.uk)
359 > # $type    = the type of graph for the machine
360 > #            (eg. cpu)
361 > # $start   = the date of the first item we want to add
362 > #            (in seconds since the epoch)
363 > # $step    = the interval at which the database steps
364 > # @data    = the data items we want to put in the rrd
365 > #            in the form: $dsname:dstype
366 > #            (eg. "size:GAUGE")
367 > #
368 > sub makerrd() {
369 >    my($machine, $type, $start, $step, @data) = @_;
370 >    # check if directory exists for rrd
371 >    if(! -d "$rrddir/$machine") {
372 >        # not sure on this umask, but it seems to work?
373 >        mkdir "$rrddir/$machine", 0777;
374 >    }
375 >    my(@rrdcmd);
376 >    # we'll want to add our first data item at $start,
377 >    # so we start our rrd $step before that.
378 >    $start -= $step;
379 >    push @rrdcmd, "$rrddir/$machine/$type.rrd";
380 >    push @rrdcmd, "--start=$start";
381 >    push @rrdcmd, "--step=$step";
382 >    foreach my $dataitem (@data) {
383 >        # dataitem should be: "dsname:dstype"
384 >        if($dataitem =~ /^(\S+):(\S+)$/) {
385 >            push @rrdcmd, "DS:$1:$2:600:U:U";
386 >        }
387 >    }
388 >    push @rrdcmd, (
389 >        # 3h in 15s samples
390 >        "RRA:AVERAGE:0.5:1:720",
391 >        "RRA:MAX:0.5:1:720",
392 >        # 1d in 2m samples
393 >        "RRA:AVERAGE:0.5:8:720",
394 >        "RRA:MAX:0.5:8:720",
395 >        # 1w in 15m samples
396 >        "RRA:AVERAGE:0.5:60:672",
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",
401 >    );
402 >    RRDs::create (@rrdcmd);
403 >    my($err) = RRDs::error;
404 >    print STDERR "Error creating rrd for $rrddir/$machine/$type: $err\n" if $err;
405 > }

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines