#!/usr/bin/perl use lib "/opt/vyatta/share/perl5/"; use VyattaConfig; use VyattaQosPolicy; use strict; use Getopt::Long; my $qosNode = 'qos-policy'; my $debug = $ENV{'QOS_DEBUG'}; my @updateInterface = (); my @deleteInterface = (); my @updatePolicy = (); my $deletePolicy = undef; my $listName = undef; my @validateName = (); GetOptions( "list-policy" => \$listName, "validate-name=s{2}" => \@validateName, "update-interface=s{3}" => \@updateInterface, "delete-interface=s{2}" => \@deleteInterface, "update-policy=s{2}" => \@updatePolicy, "delete-policy=s" => \$deletePolicy, ); ## list defined qos policy names sub list_inuse { my $config = new VyattaConfig; my @nodes = (); foreach my $policy ($config->listNodes($qosNode) ) { foreach my $name ($config->listNodes("$qosNode $policy") ) { push @nodes, $name; } } print join( ' ', @nodes ), "\n"; } ## check if name is okay sub validate_name { my ($policy, $name) = @_; my $config = new VyattaConfig; ($name =~ '^\w[\w_-]*$') or die "Invalid policy name $name\n"; foreach my $p ($config->listNodes($qosNode) ) { if ($p ne $policy) { foreach my $n ($config->listNodes("$qosNode $policy") ) { if ($n eq $name) { die "Name $name is already in use by $p\n"; } } } } } ## delete_interface('eth0', 'out') # remove all filters and qdisc's sub delete_interface { my ($interface, $direction ) = @_; if ($direction eq "out" ) { # delete old qdisc - will give error if no policy in place qx(sudo tc qdisc del dev "$interface" root 2>/dev/null); } } ## update_interface('eth0', 'out', 'my-shaper') # update policy to interface sub update_interface { my ($interface, $direction, $name ) = @_; my $config = new VyattaConfig; ( $direction eq "out" ) or die "Only out direction supported"; foreach my $policy ( $config->listNodes($qosNode) ) { if ( $config->exists("$qosNode $policy $name") ) { $config->setLevel("$qosNode $policy $name"); my $policy = VyattaQosPolicy->config( $config, $policy ); defined $policy or die "undefined policy"; # When doing debugging just echo the commands my $out; if (defined $debug) { open $out, '>-' or die "can't open stdout: $!"; } else { open $out, "|-" or exec qw/sudo tc -batch -/ or die "Tc setup failed: $!\n"; } $policy->commands($out, $interface); if (! close $out && ! defined $debug) { delete_interface($interface, $direction); # replay commands to stdout open $out, '>-'; $policy->commands($out, $interface); close $out; die "Conversion of configuration to tc command error\n"; } exit 0; } } die "Unknown $qosNode $name\n"; } sub delete_policy { my ( $name ) = @_; my $config = new VyattaConfig; $config->setLevel("interfaces ethernet"); foreach my $interface ( $config->listNodes() ) { foreach my $direction ($config->listNodes("$interface qos-policy")) { if ($config->returnValue("$interface qos-policy $direction") eq $name) { # can't delete active policy die "Qos policy $name still in use on ethernet $interface $direction\n"; } } } } sub update_policy { my ($shaper, $name) = @_; my $config = new VyattaConfig; $config->setLevel("interfaces ethernet"); foreach my $interface ( $config->listNodes()) { foreach my $direction ($config->listNodes("$interface qos-policy")) { if ($config->returnValue("$interface qos-policy $direction") eq $name) { delete_interface($interface, $direction); update_interface($interface, $direction, $name); } } } } if ( defined $listName ) { list_inuse(); exit 0; } if ( $#validateName == 1) { validate_name(@validateName); exit 0; } if ( $#deleteInterface == 1 ) { delete_interface(@deleteInterface); exit 0; } if ( $#updateInterface == 2 ) { update_interface(@updateInterface); exit 0; } if ( defined $deletePolicy ) { delete_policy($deletePolicy); exit 0; } if ( $#updatePolicy == 1) { update_policy(@updatePolicy); exit 0; } print <