Initial commit

Signed-off-by: Florian Pritz <bluewind@xinu.at>

1 files changed, 364 insertions, 0 deletions

diff --git a/qos.pl b/qos.pl
new file mode 100755
index 0000000..c874159
--- /dev/null
+++ b/qos.pl
@@ -0,0 +1,364 @@
+#!/usr/bin/perl -T
+use warnings;
+use strict;
+
+use v5.10;
+use autodie;
+use Data::Dumper;
+use File::Slurp;
+use List::Util qw(reduce);
+use POSIX;
+use Time::HiRes qw(sleep time);
+use Term::ANSIColor qw(colored);
+
+=head1 NAME
+
+qos.pl - Show some network QoS statistics
+
+=head1 SYNOPSIS
+
+qos.pl [interval [history_size]]
+
+ Options:
+   interval:      Set the sampling interval in seconds
+   history_size:  Set the number of samples to produce averages with
+
+=head1 DESCRIPTION
+
+Use with hfsc_shaper.sh.
+
+This programm will output QoS metrics. If an interval is set, it will output
+the metrics roughly once per interval. If a history size N is set, it will
+display the average traffic per second using N samples.
+
+The output can be adjusted in the source code of this script.
+
+=cut
+
+my $device = "extern0";
+my %classes = (
+	"1:2" => "interactive",
+	"1:3" => "voip",
+	"1:4" => "browsing",
+	"1:5" => "default",
+	"1:6" => "mid-low",
+	"1:7" => "low/data",
+);
+my %bandwidth = (
+	"up" => 5500,
+	"down" => 97280,
+);
+$bandwidth{"1:2"} = 6*$bandwidth{up}/10;
+$bandwidth{"1:3"} = 5*$bandwidth{up}/10;
+$bandwidth{"1:4"} = 1*$bandwidth{up}/10;
+$bandwidth{"1:5"} = 1*$bandwidth{up}/10;
+$bandwidth{"1:6"} = 1*$bandwidth{up}/10;
+$bandwidth{"1:7"} = 1*$bandwidth{up}/20;
+
+my %bwthresh = (
+	warn => 60,
+	crit => 80,
+);
+my %bwcolors = (
+	ok => "green",
+	warn => "rgb531",
+	crit => "red",
+);
+
+my $colored_rates = 1;
+my $show_debug_info = 0;
+
+my @display_rows = (
+	[qw(time space interface-name)],
+	#[qw(1:2 1:5 space total-up-tc)],
+	#[qw(1:3 1:6 space total-up)],
+	#[qw(1:4 1:7 space total-down)],
+	[qw(1:2 1:5)],
+	[qw(1:3 1:6)],
+	[qw(1:4 1:7)],
+	[],
+	[qw(total-up-tc total-up total-down)],
+);
+
+sub untaint {
+	my $data = shift;
+	my $regex = shift;
+
+	$data =~ m/^($regex)$/ or die "Failed to untaint: $data";
+	return $1;
+}
+
+sub format_bytes {
+	my $bytes = shift;
+	my $is_rate = shift;
+	my $boundry = 2048;
+	my $format;
+	my $unit;
+
+	my @suffix = qw(B KiB MiB GiB TiB);
+
+	for (@suffix) {
+		$unit = $_;
+		last if (abs($bytes) < $boundry);
+		$bytes /= 1024;
+	}
+
+	if ($unit eq "B") {
+		$format = "%.0f";
+	} else {
+		$format = "%.2f";
+	}
+
+	if ($is_rate) {
+		return sprintf $format." %-5s", $bytes, $unit."/s";
+	} else {
+		return sprintf $format." %-3s", $bytes, $unit;
+	}
+}
+
+sub format_rate_color {
+	my $bytes = shift;
+	my $direction = shift;
+	my $format;
+	my $relrate = 0;
+	my $color = $bwcolors{ok};
+	my $formatted_bytes = format_bytes($bytes, 1);
+
+	if ($colored_rates) {
+		$relrate = $bytes/128 * 100.00 / $bandwidth{$direction};
+		if ($relrate >= $bwthresh{crit}) {
+			$color = $bwcolors{crit};
+		} elsif ($relrate >= $bwthresh{warn}) {
+			$color = $bwcolors{warn};
+		} else {
+			$color = $bwcolors{ok};
+		}
+	}
+
+	return colored( sprintf("%13s", $formatted_bytes), $color);
+}
+
+sub parse_tc_output {
+	my $output = shift;
+	my $timestamp = shift;
+	my $history_values = shift;
+	my $history_size_limit = shift;
+
+	my $class = undef;
+	my %results = ();
+
+	for (split /^/, $output) {
+		if (m/^class [a-z]+ (?<class>[^ ]+)/) {
+			$class = $+{class};
+		}
+
+		if ($class && defined($classes{$class})) {
+			if (m/ Sent (?<sent>[0-9]+) bytes/) {
+				$results{$class} = $+{sent};
+
+				if ($history_size_limit > 0) {
+					# keep history of previous values
+					if (!defined($history_values->{$class})) {
+						$history_values->{$class} = [];
+						push @{$history_values->{$class}}, {
+							value => $+{sent},
+							value_diff => 0,
+							time_diff => 0,
+							time => $timestamp,
+						};
+					} else {
+						my $last_time = $history_values->{$class}[-1]{time};
+						my $last_value = $history_values->{$class}[-1]{value};
+						push @{$history_values->{$class}}, {
+							value => $+{sent},
+							value_diff => $+{sent} - $last_value,
+							time_diff => $timestamp - $last_time,
+							time => $timestamp,
+						};
+					}
+
+					# limit history size
+					if (0+@{$history_values->{$class}} > $history_size_limit) {
+						splice @{$history_values->{$class}}, 0, 1;
+					}
+				}
+			}
+		}
+
+		if (m/^$/) {
+			$class = undef;
+		}
+	}
+
+	return \%results;
+}
+
+sub get_interface_speed {
+	my $interface = shift;
+	my $history_size_limit = shift;
+
+	state $speed_history = {};
+
+	my $tx_bytes = read_file("/sys/class/net/$interface/statistics/tx_bytes");
+	my $rx_bytes = read_file("/sys/class/net/$interface/statistics/rx_bytes");
+	my $timestamp = time;
+
+	if (!defined($speed_history->{$interface})) {
+		$speed_history->{$interface} = [];
+		push @{$speed_history->{$interface}}, {
+			rx_value => $rx_bytes,
+			tx_value => $tx_bytes,
+			rx_diff => 0,
+			tx_diff => 0,
+			time => $timestamp,
+			time_diff => 0,
+		};
+	} else {
+		my $last_time = $speed_history->{$interface}[-1]{time};
+		my $last_rx = $speed_history->{$interface}[-1]{rx_value};
+		my $last_tx = $speed_history->{$interface}[-1]{tx_value};
+		push @{$speed_history->{$interface}}, {
+			rx_value => $rx_bytes,
+			tx_value => $tx_bytes,
+			rx_diff => $rx_bytes - $last_rx,
+			tx_diff => $tx_bytes - $last_tx,
+			time => $timestamp,
+			time_diff => $timestamp - $last_time,
+		};
+	}
+
+	# limit history size
+	if (0+@{$speed_history->{$interface}} > $history_size_limit) {
+		splice @{$speed_history->{$interface}}, 0, 1;
+	}
+
+	my $total_time = reduce {$a + $b->{time_diff}} 0, @{$speed_history->{$interface}};
+	my $total_rx = reduce {$a + $b->{rx_diff}} 0, @{$speed_history->{$interface}};
+	my $total_tx = reduce {$a + $b->{tx_diff}} 0, @{$speed_history->{$interface}};
+
+	my $rx_speed = 0;
+	my $tx_speed = 0;
+
+	$rx_speed = $total_rx/$total_time if $total_time != 0;
+	$tx_speed = $total_tx/$total_time if $total_time != 0;
+
+	return ($rx_speed, $tx_speed);
+}
+
+sub print_output_table {
+	my $results = shift;
+	my $history_values = shift;
+	my $history_size_limit = shift;
+	my $starttime = shift;
+	my $after_tc = shift;
+	my $interval = shift;
+	my $first_run = shift;
+
+	my $output_buffer = "";
+
+	my $global_speed = 0;
+	my ($rx_speed, $tx_speed);
+
+	if ($history_size_limit > 0) {
+		($rx_speed, $tx_speed) = get_interface_speed($device, $history_size_limit);
+	}
+
+	for my $class_id (keys %classes) {
+		if ($history_values->{$class_id}) {
+			my $total_time = reduce {$a + $b->{time_diff}} 0, @{$history_values->{$class_id}};
+			my $total_value = reduce {$a + $b->{value_diff}} 0, @{$history_values->{$class_id}};
+			my $speed = 0;
+
+			$speed = $total_value / $total_time if $total_time != 0;
+			$global_speed += $speed;
+		}
+	}
+
+	for my $row (@display_rows) {
+		for my $col (@{$row}) {
+			if ($col =~ /^total-.*/) {
+				if ($history_size_limit > 0) {
+					if ($col eq "total-up") {
+						$output_buffer .= sprintf "%s up (tc)", format_rate_color($global_speed, "up");
+					} elsif ($col eq "total-up-tc") {
+						$output_buffer .= sprintf "%s up (interface)", format_rate_color($tx_speed, "up");
+					} elsif ($col eq "total-down") {
+						$output_buffer .= sprintf "%s down (interface)", format_rate_color($rx_speed, "down");
+					}
+				}
+			} elsif ($col eq "space") {
+				$output_buffer .= " "x4;
+			} elsif ($col eq "spaaaaaace") {
+				if ($interval) {
+					$output_buffer .= " "x81;
+				} else {
+					$output_buffer .= " "x14;
+				}
+			} elsif ($col eq "interface-name") {
+				$output_buffer .= $device;
+			} elsif ($col eq "time") {
+				$output_buffer .= POSIX::strftime("%Y-%m-%d %H:%M:%S ", localtime);
+			} else {
+				my $class_id = $col;
+				if ($history_values->{$class_id}) {
+					my $total_time = reduce {$a + $b->{time_diff}} 0, @{$history_values->{$class_id}};
+					my $total_value = reduce {$a + $b->{value_diff}} 0, @{$history_values->{$class_id}};
+					my $speed = 0;
+
+					$speed = $total_value / $total_time if $total_time != 0;
+
+					$output_buffer .= sprintf "%14s (%s): %11s %s", $classes{$class_id}, $class_id, format_bytes($results->{$class_id}), format_rate_color($speed, $class_id);
+				} else {
+					$output_buffer .= sprintf "%14s (%s): %11s", $classes{$class_id}, $class_id, format_bytes($results->{$class_id});
+				}
+			}
+		}
+		$output_buffer .= "\n";
+	}
+
+	my $runtime = time - $starttime;
+	my $runtime_tc = $after_tc - $starttime;
+	printf "WARNING: processing took %0.4fs, skipping sleep. Consider raising interval!\n", $runtime if $runtime > $interval and $interval > 0;
+
+	$output_buffer = sprintf "Runtime for this iteration: %0.4fs (tc: %0.4fs = %0.2f%%)\n%s", $runtime, $runtime_tc, $runtime_tc / $runtime * 100, $output_buffer if $show_debug_info;
+	if (!$first_run) {
+		my $newline_count = (split /^/, $output_buffer);
+		# move cursor to start of previous table and clear screen
+		printf "[%dF", $newline_count;
+	}
+	print $output_buffer;
+}
+
+sub main {
+	my $interval = 0;
+	my %history_values = ();
+	my $history_size_limit = 0;
+	my $first_run = 1;
+
+	if (0+@ARGV >= 1) {
+		$interval = $ARGV[0];
+	}
+
+	if (0+@ARGV >= 2) {
+		$history_size_limit = $ARGV[1];
+	}
+
+	$ENV{PATH} = untaint($ENV{PATH}, qr(.*));
+
+	while (1) {
+		my $starttime = time;
+		my $stats = `tc -s class show dev $device`;
+		my $after_tc = time;
+
+		my $results = parse_tc_output($stats, $after_tc, \%history_values, $history_size_limit);
+
+		print_output_table($results, \%history_values, $history_size_limit, $starttime, $after_tc, $interval, $first_run);
+
+		$first_run = 0;
+		last unless $interval > 0;
+		my $runtime = time - $starttime;
+		sleep($interval - $runtime) unless $runtime > $interval;
+	}
+}
+
+main();