path: root/qos.pl

#!/usr/bin/perl -T
use warnings;
use strict;

use v5.10;
use autodie;
use File::Slurp;
use List::Util qw(reduce);
use POSIX;
use Time::HiRes qw(sleep time);

=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 $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 $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 %s";
	} else {
		$format = "%.2f %s";
	}

	return sprintf $format, $bytes, $unit;
}

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 "%11s/s up (tc)", format_bytes($global_speed);
					} elsif ($col eq "total-up-tc") {
						$output_buffer .= sprintf "%11s/s up (interface)", format_bytes($tx_speed);
					} elsif ($col eq "total-down") {
						$output_buffer .= sprintf "%11s/s down (interface)", format_bytes($rx_speed);
					}
				}
			} 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 %11s/s", $classes{$class_id}, $class_id, format_bytes($results->{$class_id}), format_bytes($speed);
				} 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();