#! /usr/bin/perl
#
# Copyright (c) 2018-2019, AT&T Intellectual Property.
# All rights reserved.
#
# Copyright (c) 2010-2014, Brocade Communications Systems, Inc.
# All rights reserved.
#
# SPDX-License-Identifier: GPL-2.0-only

use strict;
use warnings;
use Readonly;

use lib '/opt/vyatta/share/perl5/';

use Vyatta::Config;
use Vyatta::Configd;
use Vyatta::Bridge qw(get_bridge_ports mstpd_start mstpd_restart is_mstpd_running is_switch
  is_stp_enabled is_mstp_cfgd get_stp_cfg is_stp_cfgd);
use Vyatta::SpanningTreeBridge;
use Vyatta::SpanningTreePort;
use Getopt::Long;

our $VERSION = 1.00;

my $BRCTL   = '/sbin/brctl';
my $BRIDGE  = '/sbin/bridge';
my $MSTPCTL = '/sbin/mstpctl';

# kernel STP priority is 0-65535, RSTP priority is 0-15
# i.e. kernel pri = RSTP pri x 4096
Readonly my $BRIDGE_PRIORITY_UNITS => 4096;

Readonly my $mstpcfgdir  => "/run/mstpd/";
Readonly my $mstpcfgfile => "$mstpcfgdir/mstpd.conf";
Readonly my $DEBUG       => 0;

if ($DEBUG) {
    return unless eval 'use Data::Dumper; 1';
}

#
# main
#

my ( $action, $opt_bridge, $opt_port, $opt_val );

sub usage {
    printf("Usage for vyatta-bridge-stp\n");
    printf("  --action={create|delete} --bridge=<bridge> \n");
    printf("  --action=update_bridge --bridge=<bridge>\n");
    printf("  --action=update_port --bridge=<bridge> --port=<port>\n");
    printf("  --action=update_mstp --bridge=<bridge> --val=<version>\n");
    exit(1);
}

GetOptions(
    'action=s' => \$action,
    'bridge=s' => \$opt_bridge,
    'port=s'   => \$opt_port,
    'val=s'    => \$opt_val,
) or usage();

# If the bridge isn't defined, try to get from running system
if (defined $opt_port && !defined $opt_bridge) {
	$opt_bridge = readlink("/sys/class/net/$opt_port/brport/bridge");
	$opt_bridge =~ s/..\/..\/// if defined $opt_bridge;
}

printf "vyatta-bridge-stp(%s, %s) action: $action\n",
  defined($opt_bridge) ? $opt_bridge : "-",
  defined($opt_port)   ? $opt_port   : "-"
  if $DEBUG;

if ( $action eq 'create' ) {
    enable_spanning_tree($opt_bridge);
    exit(0);
}
if ( $action eq 'delete' ) {
    disable_spanning_tree($opt_bridge);
    generate_mstp_configuration();
    exit(0);
}

my $mstp_restart_required = 0;

if ( $action eq 'update_port' ) {
    my $port = Vyatta::SpanningTreePort->new( $opt_bridge, $opt_port, $DEBUG );
    exit(0) unless $port->{exists};

    update_bridge_port( $port, 0 );
} else {
    my $bridge = Vyatta::SpanningTreeBridge->new( $opt_bridge, $DEBUG );
    exit(0) unless $bridge->{exists};

    if ( $action eq 'update_bridge' ) {
        update_bridge($bridge);
    } elsif ( $action eq 'update_mstp' ) {
        mstp_update( $bridge, $opt_val );
    }
}

generate_mstp_configuration();

if ($mstp_restart_required) {
    #
    # If STP is not configured it can only mean that we're about to
    # turn off spanning-tree (invoke disable_spanning_tree()). Rather
    # than restart the daemon, only to have it terminate almost
    # immediately, simply ignore this particular restart (MSTP
    # update).
    #
    if ( is_stp_cfgd($opt_bridge, 1) ) {
        print("Restarting mstp daemon\n");
        mstpd_restart();
    }
}

exit 0;

#
# subroutines
#

sub collect_stp_configuration {
    my ( $client, $type ) = @_;

    my $names   = $client->get("interfaces $type");
    my @stplist = ();
    my $db      = $Vyatta::Configd::Client::AUTO;
    my $path;
    foreach my $name ( @{$names} ) {
        $path = "interfaces $type $name spanning-tree";
        next if ( !$client->node_exists( $db, $path ) );

        my $tree = $client->tree_get_hash( $path );
        my %inst;

        $inst{'name'} = $name;
        $inst{'stp'}  = $tree->{'spanning-tree'};

        my @stpports;
        foreach my $port ( get_bridge_ports($name) ) {
            my %pinst;
            my $intf   = Vyatta::Interface->new($port);
            my $iftype = $intf->{'type'};
            $path = "interfaces $iftype $port $type-group";
            next if ( !$client->node_exists( $db, $path ) );

            my $ptree = $client->tree_get_hash( $path );
            $pinst{'port'}   = $port;
            $pinst{'params'} = $ptree->{"$type-group"};
            push( @stpports, \%pinst );
        }

        $inst{'ports'} = \@stpports;
        push( @stplist, \%inst );
    }

    return @stplist;
}

sub generate_mstp_configuration {
    my $client = Vyatta::Configd::Client->new();

    my @stplist = ();
    push( @stplist, collect_stp_configuration( $client, "switch" ) );
    push( @stplist, collect_stp_configuration( $client, "bridge" ) );
    my $json   = JSON::XS->new->utf8->pretty(1);
    my $output = $json->encode( \@stplist );

    mkdir("$mstpcfgdir", 0755) unless (-d "$mstpcfgdir");
    open( my $newcfg, '>', "$mstpcfgfile" )
      or die "Cannot open configuration file: $mstpcfgfile: $!";

    print $newcfg $output;
    close $newcfg;
}

sub enable_spanning_tree {
    my ($bridge_name) = @_;
    my $rv = 0;

    # Is mstpd installed and feature-enabled?
    $rv = userspace_stp_op( $bridge_name, 'on' );
    if ( $rv != 0 ) {
        return $rv;
    }

    my $bridge = Vyatta::SpanningTreeBridge->new( $bridge_name, $DEBUG );
    update_bridge($bridge) if $bridge->{exists};
    update_all_bridge_ports($bridge_name);
    return;
}

sub disable_spanning_tree {
    my ($bridge) = @_;
    my $rv = 0;

    $rv = userspace_stp_op( $bridge, 'off' );
    return $rv;
}

# Turn kernel Spanning Tree on/off
#
sub kernel_stp_op {
    my ( $bridge, $onoff ) = @_;
    my $rv = 0;

    if ( $onoff eq 'on' ) {
        $rv = system("$BRCTL stp $bridge on");
    } elsif ( $onoff eq 'off' ) {
        $rv = system("$BRCTL stp $bridge off");
    }
    return $rv;
}

# Turn user-space Spanning Tree (mstpd) on/off
#
sub userspace_stp_op {
    my ( $bridge, $onoff ) = @_;

    if ( $onoff eq 'on' ) {
        mstpd_start();
        if ( !is_mstpd_running() ) {
            die "Failed to start mstpd process\n";
        }
    }

    # Kernel stp cfg calls /sbin/bridge-stp, which calls
    # "/sbin/mstpctl addbridge <bridge>" if the mstpd process is running.
    return kernel_stp_op( $bridge, $onoff );
}

sub update_bridge {
    my ($bridge) = @_;

    print "Bridge Update: \n" . Dumper($bridge) if $DEBUG;

    my $cfg = get_stp_cfg( $bridge->{'bridge_name'} );

    #
    # Need to ensure 2*(forwarding-delay-1) >= max-age - the YANG
    # constraint ensures that the condition holds. But mstpd only gets
    # to see 1 value at a time. In order to not upset mstpd, figure
    # out which attribute to set first. Check the constraint using the
    # YANG value of one of the attributes and the current mstpd value
    # of the other attribute.
    #
    my $age    = $cfg->returnValue('max-age');
    my $fwddly = $cfg->returnValue('forwarding-delay');
    if ( 2 * ( $bridge->{'brfwddly'} - 1 ) >= $age ) {
        $bridge->set_max_age($age) == 0      or exit 1;
        $bridge->set_fwd_delay($fwddly) == 0 or exit 1;
    } else {
        $bridge->set_fwd_delay($fwddly) == 0 or exit 1;
        $bridge->set_max_age($age) == 0      or exit 1;
    }

    $bridge->set_hello( $cfg->returnValue('hello-time') ) == 0  or exit 1;
    $bridge->set_priority( $cfg->returnValue('priority') ) == 0 or exit 1;
    $bridge->set_tx_hold_count( $cfg->returnValue('tx-hold-count') ) == 0
      or exit 1;
    my $version = $cfg->returnValue('version');
    mstp_update( $bridge, $version );
    $bridge->set_spanning_tree_version($version) == 0 or exit 1;
}

sub mstp_delete {
    my ($bridge) = @_;
    my $mstp     = $bridge->{'mstp'};
    my $rv       = 0;
    my $restart  = 0;

    if ( keys( %{$mstp} ) ) {
        foreach my $mstid ( split( ',', $mstp->{'mstilist'} ) ) {
            next if $mstid == 0;

            if ( $bridge->mstp_msti_delete($mstid) != 0 ) {
                $restart++;
            }
        }

        $rv = $bridge->mstp_region_delete();
    }

    return ( $rv, $restart != 0 );
}

sub msti_update {
    my ( $bridge, $mstp, $mstid ) = @_;
    my $rv = 0;

    $rv = $bridge->mstp_msti_create($mstid);

    if ( !$rv ) {
        $rv =
          $bridge->mstp_msti_set_priority( $mstid,
            $mstp->returnValue("instance $mstid priority") );
    }

    if ( !$rv ) {
        my @vlans = $mstp->returnValues("instance $mstid vlan");
        $rv = $bridge->mstp_msti_set_vlans( $mstid, \@vlans );
    }

    return $rv;
}

sub mstp_update_bridge {
    my ( $bridge, $currvers, $newvers ) = @_;
    my $rv      = 0;
    my $restart = 0;

    if ( !is_switch( $bridge->{'bridge_name'} ) && ( $newvers eq 'mstp' ) ) {
        print
          "Warning: No VLANs on bridge interfaces, operating in RSTP mode\n";
        return ( $rv, $restart != 0 );
    }

    my $mstp = get_stp_cfg( $bridge->{'bridge_name'} );

    #
    # Has spanning-tree been turned off or are we leaving MSTP mode?
    #
    if ( !$mstp->exists() ||
         ( ( $newvers ne 'mstp' ) && ( $currvers eq 'mstp' ) ) ) {
        return mstp_delete($bridge);
    }

    $mstp->setLevel( $mstp->setLevel() . " mstp" );

    $rv = $bridge->mstp_region_update(
        $mstp->returnValue("region name"),
        $mstp->returnValue("region revision")
    );

    #
    # Delete any "old" MSTI. Removal of an MSTI nearly always fails
    # (the daemon doesn't do deletes), in which case we have to reload
    # the daemon.
    #
    my $oldmstis = $bridge->{'mstp'}->{'mstilist'};
    if ($oldmstis) {
        foreach my $mstid ( split( ',', $oldmstis ) ) {
            next if $mstid == 0;

            if ( !$mstp->exists("instance $mstid") ) {
                if ( $bridge->mstp_msti_delete($mstid) != 0 ) {
                    $restart++;
                }
            }
        }
    }

    if ( $restart == 0 ) {
        foreach my $mstid ( $mstp->listNodes('instance') ) {
            $rv += msti_update( $bridge, $mstp, $mstid );
        }
    }

    return ( $rv, $restart != 0 );
}

sub mstp_update {
    my ( $bridge, $new_version ) = @_;
    my $rv           = 0;
    my $curr_version = $bridge->{'version'};

    $new_version = 'rstp' unless defined($new_version);

    if ( ( $curr_version eq 'mstp' ) || ( $new_version eq 'mstp' ) ) {
        print "MSTP Bridge ($curr_version -> $new_version): \n"
          . Dumper($bridge) if $DEBUG;

        ( $rv, $mstp_restart_required ) =
          mstp_update_bridge( $bridge, $curr_version, $new_version );
    }

    return $rv;
}

#
# Spanning Tree ports
#

sub mstp_update_bridge_port {
    my ( $port, $cfg, $bridge_group ) = @_;

    return 0 if ( !is_mstp_cfgd( $port->{'bridge_name'}, 1 ) );

    my $path = sprintf( "%s %s mstp", $cfg->setLevel(), $bridge_group );
    my $mstp = Vyatta::Config->new($path);
    my $rv   = 0;

    foreach my $mstid ( $mstp->listNodes("instance") ) {
        $rv =
          $port->mstp_msti_set_priority( $mstid,
            $mstp->returnValue("instance $mstid priority") );
        $rv +=
          $port->mstp_msti_set_path_cost( $mstid,
            $mstp->returnValue("instance $mstid cost") );
        return $rv if ( $rv != 0 );
    }

    return 0;
}

# Update bridge port parameters when Spanning Tree is enabled on a bridge
#
sub update_all_bridge_ports {
    my ($bridge) = @_;

    foreach my $name ( get_bridge_ports($bridge) ) {
	my $port = Vyatta::SpanningTreePort->new($bridge, $name);
        update_bridge_port( $port, 1 );
    }
    return;
}

# update_bridge_port
#
# Called either:
#   1. For all ports, when Spanning Tree is enabled on a bridge, or
#   2. For one port, when that port is first added to a bridge-group
#      or switch-group.
#
sub update_bridge_port {
    my ( $port, $new ) = @_;
    my $val;
    my $state;

    # Get port information from configuration
    my $intf = Vyatta::Interface->new($port->{'port_name'});
    if ( !$intf ) {
        printf "Unknown interface type " . $port->{'port_name'} . "\n";
        return;
    }

    print "Bridge Port Update: \n" . Dumper($port) if $DEBUG;

    return unless is_stp_cfgd($port->{'bridge_name'}, 1);

    my $cfg = Vyatta::Config->new();
    $cfg->setLevel( $intf->path() );

    my $bridge_group = is_switch($port->{'bridge_name'}) ? 'switch-group' : 'bridge-group';

    mstp_update_bridge_port( $port, $cfg, $bridge_group );

    $val = $cfg->returnValue("$bridge_group cost");
    # Allow bridge to calculate path cost if its a new port and the value
    # is 'auto'
    if ( $new == 0 or ( defined($val) and $val ne 'auto' ) ) {
        set_port_path_cost( $port, $val ) == 0 or exit 1;
    }

    $val = $cfg->returnValue("$bridge_group priority");
    set_port_priority( $port, $val ) == 0 or exit 1;

    $state = $cfg->exists("$bridge_group root-block");
    set_port_root_block( $port, $state ) == 0 or exit 1;

    $state = $cfg->exists("$bridge_group bpdu-guard");
    set_port_bpdu_guard( $port, $state ) == 0 or exit 1;

    $state = $cfg->exists("$bridge_group pvst-guard");
    $port->set_pvst_guard($state) == 0 or exit 1;

    $state = $cfg->exists("$bridge_group bpdu-filter");
    set_port_bpdu_filter( $port, $state ) == 0 or exit 1;

    $state = $cfg->exists("$bridge_group pvst-filter");
    $port->set_pvst_filter($state) == 0 or exit 1;

    $state = $cfg->exists("$bridge_group admin-edge");
    set_port_admin_edge( $port, $state ) == 0 or exit 1;

    $state = $cfg->exists("$bridge_group auto-edge");
    set_port_auto_edge( $port, $state ) == 0 or exit 1;

    $state = $cfg->exists("$bridge_group restrict-tcn");
    set_port_restrict_tcn( $port, $state ) == 0 or exit 1;

    $state = $cfg->exists("$bridge_group network-port");
    set_port_network_port( $port, $state ) == 0 or exit 1;

    my $p2p = 'auto';
    if ( $cfg->exists("$bridge_group point-to-point on") ) {
        $p2p = 'yes';
    } elsif ( $cfg->exists("$bridge_group point-to-point off") ) {
        $p2p = 'no';
    }
    set_port_p2p_detection( $port, $p2p ) == 0 or exit 1;
    return;
}

sub set_port_priority {
    my ( $port, $prio ) = @_;

    return $port->set_priority($prio);
}

#  Only called for a new port if the cfg is something other than 'auto'.
#
sub set_port_path_cost {
    my ( $port, $cost ) = @_;

    return $port->set_path_cost($cost);
}

# "root block" in old STP terms is "restricted root role" in RSTP terms
sub set_port_root_block {
    my ( $port, $state ) = @_;

    return $port->set_root_block($state);
}

sub set_port_bpdu_guard {
    my ( $port, $state ) = @_;

    return $port->set_bpdu_guard($state);
}

sub set_port_admin_edge {
    my ( $port, $state ) = @_;

    return $port->set_admin_edge($state);
}

sub set_port_auto_edge {
    my ( $port, $state ) = @_;

    return $port->set_auto_edge($state);
}

sub set_port_restrict_tcn {
    my ( $port, $state ) = @_;

    return $port->set_restrict_tcn($state);
}

sub set_port_network_port {
    my ( $port, $state ) = @_;

    return $port->set_network_port($state);
}

sub set_port_p2p_detection {
    my ( $port, $state ) = @_;

    return $port->set_p2p_detection($state);
}

sub set_port_bpdu_filter {
    my ( $port, $state ) = @_;

    return $port->set_bpdu_filter($state);
}
