QoS-Update - Komplette grafische Ueberarbeitung
[people/pmueller/ipfire-2.x.git] / config / qos / parse-func.pl
CommitLineData
a7fb5630
MT
1#!/usr/bin/perl
2
3##########################################
4##
5## NAME
6##
7## DESCRIPTION
8##
9## Which is part of the ADSL-optimizer.
10##
11## USAGE / FUNCTIONS
12##
13##
14##
15##
16##
17## REQUIRES
18##
19##
20## AUTHOR
21## Jesper Dangaard Brouer <hawk@diku.dk>, d.15/4-2004
22##
23## CHANGELOG
24## 2004-04-15: Initial version.
25## 2005-04-18: Remove some warnings.
26##
27## $Id: parse-func.pl,v 1.15 2005/04/18 12:37:17 hawk Exp $
28##########################################
29
30#use Data::Dumper;
31
32#our %classes_data;
33#our %classes_info;
34#our $tc_command="/sbin/tc";
35
36my @input_htb = (<<"END_OF_HERE_HTB" =~ m/^\s*(.+)/gm);
37class tbf 4220:1 parent 4220:
38class htb 1:1 root rate 400Kbit ceil 400Kbit burst 2111b cburst 2111b
39 Sent 12369084336 bytes 80967118 pkts (dropped 0, overlimits 0)
40 rate 45020bps 258pps
41 lended: 23353805 borrowed: 0 giants: 0
42 tokens: 30210 ctokens: 30210
43
44class htb 1:10 parent 1:1 prio 0 rate 80Kbit ceil 320Kbit burst 1701b cburst 2008b
45 Sent 80640087 bytes 247988 pkts (dropped 0, overlimits 0)
46 backlog 42p
47 lended: 230876 borrowed: 17112 giants: 0
48 tokens: 127200 ctokens: 37940
49
50class htb 1:20 parent 1:1 leaf 4220: prio 1 rate 100Kbit ceil 200Kbit burst 1727b cburst 1855b
51 Sent 2495181573 bytes 44034303 pkts (dropped 5837, overlimits 0)
52 lended: 43825585 borrowed: 208718 giants: 0
53 tokens: 103424 ctokens: 55808
54
55class htb 1:30 parent 1:1 leaf 4230: prio 3 rate 80Kbit ceil 400Kbit burst 1701b cburst 2111b
56 Sent 2060213567 bytes 5465574 pkts (dropped 121, overlimits 0)
57 rate 16851bps 35pps
58 lended: 4556992 borrowed: 908582 giants: 0
59 tokens: -25364 ctokens: 32897
60
61class htb 1:50 parent 1:1 leaf 4250: prio 5 rate 40Kbit ceil 120Kbit burst 1650b cburst 1752b
62 Sent 6071486687 bytes 24448436 pkts (dropped 8086739, overlimits 0)
63 rate 15801bps 85pps backlog 126p
64 lended: 8324530 borrowed: 16123780 giants: 0
65 tokens: -202717 ctokens: -172499
66
67class htb 1:666 parent 1:1 leaf 666: prio 7 rate 4Kbit ceil 40Kbit burst 1604b cburst 1650b
68 Sent 2148626078 bytes 6771069 pkts (dropped 2078536, overlimits 0)
69 rate 5221bps 17pps backlog 125p
70 lended: 675330 borrowed: 6095613 giants: 0
71 tokens: -1149121 ctokens: -293386
72
73END_OF_HERE_HTB
74
75
76my @input_hfsc = (<<"END_OF_HERE_HFSC" =~ m/^\s*(.+)/gm);
77class hfsc 1: root
78 Sent 0 bytes 0 pkts (dropped 0, overlimits 0)
79 period 0 level 2
80
81class hfsc 1:1 parent 1: ls m1 0bps d 0us m2 250Kbit ul m1 0bps d 0us m2 250Kbit
82 Sent 0 bytes 0 pkts (dropped 0, overlimits 0)
83 period 6 work 131770097 bytes level 1
84
85class hfsc 1:10 parent 1:1 rt m1 250Kbit d 30.0ms m2 50Kbit ls m1 250Kbit d 50.0ms m2 50Kbit
86 Sent 1300885 bytes 7052 pkts (dropped 0, overlimits 0)
87 period 6502 work 1300885 bytes rtwork 1245495 bytes level 0
88
89class hfsc 1:20 parent 1: rt m1 0bps d 64.0ms m2 75Kbit ls m1 0bps d 0us m2 250Kbit
90 Sent 19144279 bytes 325503 pkts (dropped 46, overlimits 0)
91 backlog 3p
92 period 20242 work 19143778 bytes level 0
93
94class hfsc 1:30 parent 1:1 leaf 4230: ls m1 0bps d 150.0ms m2 50Kbit
95 Sent 45139930 bytes 74200 pkts (dropped 1664, overlimits 0)
96 backlog 24p
97 period 140 work 44885232 bytes level 0
98
99class hfsc 1:50 parent 1:1 leaf 4250: ls m1 0bps d 235.7ms m2 72Kbit
100 Sent 73910198 bytes 301294 pkts (dropped 104807, overlimits 0)
101 backlog 62p
102 period 115 work 64625490 bytes level 0
103
104class hfsc 1:666 parent 1:1 leaf 666: ls m1 0bps d 1.0s m2 2Kbit
105 Sent 2217104 bytes 17018 pkts (dropped 74526, overlimits 0)
106 backlog 22p
107 period 1 work 1814712 bytes level 0
108
109END_OF_HERE_HFSC
110
111sub parse_class($) {
112 my $device = "$_[0]";
113 my $return_val = 1;
114
115 my $timestamp = time;
116 my @tc_output = `$tc_command -statistics class show dev $device`;
117# my @tc_output = @input_hfsc;
118# my @tc_output = @input_htb;
119 my $result = $?;
120 if ( $result != 0 ) {
121 print "Error executing $tc_command\n";
122 return $result;
123 }
124
125 $classes_data{last_update}{$device} = $timestamp;
126 $classes_info{last_update}{$device} = $timestamp;
127
128 #for my $line (@tc_output) {
129 for my $i (0 .. $#tc_output) {
130
131 my $line=$tc_output[$i];
132 # Parsing HTB:
133 # ------------
f1df2c41 134 if ( $line =~ m/class htb (\d+):(\d+)( root| parent )?(\d+:\d+)?( leaf )?(\d+)?:?( prio )?(\d+)? rate (.*) ceil (.*) burst (.*) cburst (.*)/ ) {
a7fb5630
MT
135 my $type = "htb";
136 my $major = $1;
137 my $minor = $2;
138 my $class = "${major}-${minor}";
139 #my $hash = "${class}_${device}";
140 my $parent= $4;
141 my $leaf = $6;
142 my $prio = $8;
143 my $rate = $9;
144 my $ceil = $10;
145 my $burst = $11;
146 my $cburst= $12;
147
148# print "class: $class\n"."parent: $parent\n"."leaf: $leaf\n"."prio: $prio\n";
149# print "rate: $rate\n"."ceil: $ceil\n"."burst: $burst\n"."cburst: $cburst\n";
150
151 my ($bytes, $pkts, $dropped, $overlimits);
152 if ($tc_output[$i + 1] =~ m/Sent (\d+) bytes (\d+) pkts \(dropped (\d+), overlimits (\d+)\)/ ) {
153 $bytes = $1;
154 $pkts = $2;
155 $dropped = $3;
156 $overlimits = $4;
157# print "bytes: $bytes\n"."pkts: $pkts\n";
158# print "dropped: $dropped\n"."overlimits: $overlimits\n";
159 } else {
363fb6af
MT
160# print "$timestamp: ERROR(+1) - Unable to parse (class ${class}_$device): ";
161# print "\"$tc_output[$i + 1]\"\n";
a7fb5630
MT
162 $return_val="";
163 next;
164 }
165
166 # Problem:
167 # Sometimes the "rate" line is not shown (when a rate cannot be calculated)
168 # And sometimes only "backlog"...
169 # Use $next_index to specify the next line to parse
170 #
171 my $next_index = 3;
172 my ($backlog);
173 if ($tc_output[$i + 2] =~ m/((rate (\d+\w+) )|backlog )(\d+)?(pps )?(backlog )?(\d+)?p?/ ) {
174 $backlog = $7;
175 #print "backlog: $backlog\n";
176 } else {
177# Too verbose:
178# print "$timestamp: WARNING \"rate\" line missing";
179# print " very inactive class ${class}_$device).\n";
180 $next_index = 2;
181 }
182
183 my ($lended, $borrowed, $giants);
184 if ($tc_output[$i + $next_index] =~ m/lended: (\d+) borrowed: (\d+) giants: (\d+)/ ) {
185 $lended = $1;
186 $borrowed = $2;
187 $giants = $3;
188 #print "lended: $lended\n"."borrowed: $borrowed\n"."giants: $giants\n";
189 } else {
190 print "$timestamp: ERROR(+$next_index) - Unable to parse (class ${class}_$device): ";
191 print "\"$tc_output[$i + $next_index]\"\n";
192 $return_val="";
193 next;
194 }
195
196 # Update the hash tables
197 my $hash="${class}_$device";
198
199 # Tests if previous data have been updated to file
200 if ( (exists $classes_data{$hash}{last_update}) &&
201 (exists $classes_data{$hash}{file_update})) {
202 if ( $classes_data{$hash}{last_update} >
203 $classes_data{$hash}{file_update} ){
204 print "Warning: old data from $hash has not been updated to file!\n";
205 }
206 }
207
208 # Update the statistics data
209 # (need a function call for error checking)
210 $classes_data{$hash}{last_update} = $timestamp;
211 update_counter( $hash, $timestamp, "bytes" , $bytes);
212 #(yes I know its bad/redundant, but it makes in easier elsewhere)
213 update_counter( $hash, $timestamp, "bits" , $bytes*8);
214 update_counter( $hash, $timestamp, "pkts" , $pkts);
215 update_counter( $hash, $timestamp, "dropped" , $dropped);
216 update_counter( $hash, $timestamp, "overlimits", $overlimits);
217 update_counter( $hash, $timestamp, "lended" , $lended);
218 update_counter( $hash, $timestamp, "borrowed" , $borrowed);
219 update_counter( $hash, $timestamp, "giants" , $giants);
220 # Not a counter value...
221 $classes_data{$hash}{backlog} = $backlog;
222
223 # Update the info data
224 # (remember to update the "type" first)
225 update_info( $hash, $timestamp, "type" , $type);
226 update_info( $hash, $timestamp, "parent", $parent);
227 update_info( $hash, $timestamp, "leaf" , $leaf);
228 update_info( $hash, $timestamp, "prio" , $prio);
229 update_info( $hash, $timestamp, "rate" , $rate);
230 update_info( $hash, $timestamp, "ceil" , $ceil);
231 update_info( $hash, $timestamp, "burst" , $burst);
232 update_info( $hash, $timestamp, "cburst", $cburst);
233
234 #print "\n";
235 }
236
237 # Parsing HFSC:
238 # -------------
239 if ( $line =~ m/class hfsc (\d+):(\d+)( root| parent )?(\d+:\d?)?( leaf )?(\d+)?:?( rt m1 (\d+\w+?) d (\d+.?\d?\w+) m2 (\d+\w+?))?( ls m1 (\d+\w+?) d (\d+.?\d?\w+) m2 (\d+\w+?))?( ul m1 (\d+\w+?) d (\d+.?\d?\w+) m2 (\d+\w+?))? / ){
240
241 my $type = "hfsc";
242 my $major = $1;
243 my $minor = $2;
244 my $class = "${major}-${minor}";
245 #my $hash = "${class}_${device}";
246 my $parent= $4;
247 my $leaf = $6;
248
249 my $realtime_m1; if (defined $8 && $8 ne '0bps') {$realtime_m1 = $8;}
250 my $realtime_d; if (defined $9 && $9 ne '0us' ) {$realtime_d = $9;}
251 my $realtime_m2 = $10;
252
253 my $linkshare_m1; if (defined $12 && $12 ne '0bps') { $linkshare_m1 = $12;}
254 my $linkshare_d ; if (defined $13 && $13 ne '0us' ) { $linkshare_d = $13;}
255 my $linkshare_m2 = $14;
256
257 my $upperlimit_m1; if (defined $16 && $16 ne '0bps') { $upperlimit_m1 = $16;}
258 my $upperlimit_d ; if (defined $17 && $17 ne '0us' ) { $upperlimit_d = $17;}
259 my $upperlimit_m2 = $18;
260
261 #print "\nType: $type\n";
262 my ($bytes, $pkts, $dropped, $overlimits);
263 if ($tc_output[$i + 1] =~ m/Sent (\d+) bytes (\d+) pkts \(dropped (\d+), overlimits (\d+)\)/ ) {
264 $bytes = $1;
265 $pkts = $2;
266 $dropped = $3;
267 $overlimits = $4;
268 #print "bytes: $bytes\n"."pkts: $pkts\n";
269 #print "dropped: $dropped\n"."overlimits: $overlimits\n";
270 } else {
271 print "$timestamp: ERROR(+1) - Unable to parse (class ${class}_$device): ";
272 print "\"$tc_output[$i + 1]\"\n";
273 $return_val="";
274 next;
275 }
276
277 # Sometimes the "backlog" line is not shown (when there is no backlog...)
278 # Use $next_index to specify the next line to parse
279 #
280 my $next_index = 3;
281 my ($backlog);
282 if ($tc_output[$i + 2] =~ m/backlog (\d+)?p?/ ) {
283 $backlog = $1;
284 #print "backlog: $backlog\n";
285 } else {
286 $next_index = 2;
287 }
288
289 my ($period, $work, $rtwork, $level);
290 if ($tc_output[$i + $next_index] =~ m/period (\d+) (work (\d+) bytes )?(rtwork (\d+) bytes )?level (\d+)/ ) {
291 $period = $1;
292 $work = $3;
293 $rtwork = $5;
294 $level = $6
295 } else {
296 print "$timestamp: ERROR(+$next_index) - Unable to parse (class ${class}_$device): ";
297 print "\"$tc_output[$i + $next_index]\"\n";
298 $return_val="";
299 next;
300 }
301
302
303 # Update the hash tables
304 my $hash="${class}_$device";
305
306 # Tests if previous data have been updated to file
307 if ( (exists $classes_data{$hash}{last_update}) &&
308 (exists $classes_data{$hash}{file_update})) {
309 if ( $classes_data{$hash}{last_update} >
310 $classes_data{$hash}{file_update} ){
311 print "Warning: old data from $hash has not been updated to file!\n";
312 }
313 }
314
315 # HFSC - Update the statistics data
316 # (need a function call for error checking)
317 $classes_data{$hash}{last_update} = $timestamp;
318 update_counter( $hash, $timestamp, "bytes" , $bytes);
319 #(yes I know its bad/redundant, but it makes in easier elsewhere)
320 update_counter( $hash, $timestamp, "bits" , $bytes*8);
321 update_counter( $hash, $timestamp, "pkts" , $pkts);
322 update_counter( $hash, $timestamp, "dropped" , $dropped);
323 update_counter( $hash, $timestamp, "overlimits", $overlimits);
324 # Not a counter value...
325 $classes_data{$hash}{backlog} = $backlog;
326 #
327 # Extra HFSC counters
328 $classes_data{$hash}{hfsc_period} = $period;
329 update_counter( $hash, $timestamp, "hfsc_work" , $work);
330 update_counter( $hash, $timestamp, "hfsc_rtwork" , $rtwork);
331
332
333 # HFSC - Update the info data
334 # (remember to update the "type" first)
335 update_info( $hash, $timestamp, "type" , $type);
336 update_info( $hash, $timestamp, "parent", $parent);
337 update_info( $hash, $timestamp, "leaf" , $leaf);
338 #
339 # Extra HFSC information
340 update_info( $hash, $timestamp, "level" , $level);
341 update_info( $hash, $timestamp, "realtime_m1", $realtime_m1);
342 update_info( $hash, $timestamp, "realtime_d" , $realtime_d);
343 update_info( $hash, $timestamp, "realtime_m2", $realtime_m2);
344
345 update_info( $hash, $timestamp, "linkshare_m1", $linkshare_m1);
346 update_info( $hash, $timestamp, "linkshare_d" , $linkshare_d);
347 update_info( $hash, $timestamp, "linkshare_m2", $linkshare_m2);
348
349 update_info( $hash, $timestamp, "upperlimit_m1", $upperlimit_m1);
350 update_info( $hash, $timestamp, "upperlimit_d" , $upperlimit_d);
351 update_info( $hash, $timestamp, "upperlimit_m2", $upperlimit_m2);
352
353
354 }
355
356 # Parsing XXX:
357 # ------------
358 if ( $line =~ m/class XXX/ ) {
359 print "Matching class XXX\n";
360 }
361
362 }
363 return $return_val;
364}
365
366# The main purpose of this function is to detect counter resets
367# and avoid parsing them on to RRDtool which interprets them
368# as counter overflows, thus updating with a very large number.
369sub update_counter ($$$$) {
370 my $class_hash = "$_[0]";
371 my $timestamp = "$_[1]";
372 my $data_key = "$_[2]";
373 my $new_value;
374 if ( defined $_[3]) {
375 $new_value = "$_[3]";
376 }
377 #
378 my $max_allowed_wrap_increase = 100000000;
379 my $old_value;
380 if (exists $classes_data{$class_hash}{$data_key}) {
381 $old_value = $classes_data{$class_hash}{$data_key};
382 #print "old_value: $old_value\n";
383 }
384
385# # If the new and old value is not defined, nothing is done
386# if ((not defined $new_value) && (not defined $old_value)) {
387# return "";
388# }
389
390 # Argh... the tc program outputs in unsigned long long (64 bit).
391 # but perls integers should be 32 bit, but some how perl
392 # manages to store numbers larger than 32 bit numbers.
393 my $MAX_VALUE=0xFFFFFFFF;
394
395 if ((defined $new_value) && (defined $old_value)) {
396 my $delta = $new_value - $old_value;
397 if ( $delta < 0 ) {
398 # Counter wrap around...
399 my $real_delta = $delta + $MAX_VALUE + 1;
400 if ($real_delta < 0) {
401 print "($class_hash:$data_key): Perl-Magic using numbers bigger than 32bit ";
402 print "new:$new_value - old:$old_value = delta:$delta, real_delta:$real_delta.\n";
403 }
404 print time . " ($class_hash:$data_key) Info: Counter wrap around (real delta:$real_delta)\n";
405 if ( ($real_delta > $max_allowed_wrap_increase) ||
406 ($real_delta < 0)) {
407 # Properly a counter reset and not a wrap around
408 # A counter reset normally a result of a reload of the classes
409 $classes_data{$class_hash}{$data_key} = undef;
410 $classes_info{$class_hash}{counter_reset} = $timestamp;
411 $classes_info{$class_hash}{last_update} = $timestamp;
412 print time . "Warning: Real_delta too big, assuming Counter reset";
413 print "($class_hash:$data_key)\n";
414 return "Counter reset";
415 }
416 }
417 }
418
419 $classes_data{$class_hash}{$data_key} = $new_value;
420 return 1;
421}
422
423sub update_info ($$$$) {
424 my $class_hash = "$_[0]";
425 my $timestamp = "$_[1]";
426 my $info_key = "$_[2]";
427 my $new_value;
428 if ( defined $_[3]) {
429 $new_value = "$_[3]";
430 }
431 my $old_value;
432 if (exists $classes_info{$class_hash}{$info_key}) {
433 $old_value = $classes_info{$class_hash}{$info_key};
434 #print "old_value: $old_value\n";
435 }
436
437 # If the new and old value is not defined, nothing is done
438 if ((not defined $new_value) && (not defined $old_value)) {
439 return "";
440 }
441
442 # An update is needed
443 # - if the old_value is not defined and new_value is defined
444 # - if the new_value is not defined and old_value is defined
445 # - if the old_value differs from the new,
446 #
447 if ( ((not defined $old_value) and (defined $new_value)) ||
448 ((not defined $new_value) and (defined $old_value)) ||
449 ("$old_value" ne "$new_value")) {
450
451 # Special case: If the "type" changes the hash should be cleared
452 if ( "$info_key" eq "type") {
453 #print "Type has changed clearing hash \n";
454 for my $key ( keys %{ $classes_info{$class_hash} } ) {
455 delete( $classes_info{$class_hash}{$key});
456 print " Deleting key: $key from: $class_hash \n";
457 }
458 }
459
460 if (defined $new_value) {
461 $classes_info{$class_hash}{$info_key} = $new_value;
462 } else {
463 #print "New value undef -> Deleting key: $info_key from: $class_hash\n";
464 delete($classes_info{$class_hash}{$info_key});
465 }
466
467 # Mark the class for an info-file update
468 $classes_info{$class_hash}{last_update} = $timestamp;
469
470 # Update list/array of "changed" keys
471 push @{ $classes_info{$class_hash}{changed} }, $info_key;
472
473 # Print debug info
474 #print "Update class:$class_hash $info_key=";
475 #if (defined $new_value) {print "$new_value"};
476 #print "\n";
477 return 1;
478 }
479 return "";
480}
481
482# test
483#parse_class(eth1);
484
485#print Dumper(%classes_data);
486#print Dumper(%classes_info);
487
488return 1;