#!/usr/perl/5.005/bin/perl
use strict;
$|++;

use Getopt::Long;
use Data::Dumper;
use SNMP;

my @allowed_types = qw( permit permit-bidirectional );
my @mib_dirs = qw(
        /root/publicmibs/Cabletron
        /root/publicmibs/PublicDomain
);

my @mibs = qw( CTRON-IP-ROUTER-MIB );
$SNMP::save_descriptions = 0;

my $rules_file = '';
my $aclload = 1;
my @switch_list_files = ();
my @switches = ();
my $verbose = 0;
my $community = '';
my $on = 1;
my $help = 0;
my $nuke = 0;
my $show = 0;

GetOptions (
        'aclload!' => \$aclload,
        'community|n=s' => \$community,
        'display+' => \$show,
        'erase' => \$nuke,
        'help' => \$help,
        'list=s' => \@switch_list_files,
        'on!' => \$on,
        'off' => sub { $aclload = 0; $on = 0 },
        'rules=s' => \$rules_file,
        'switch=s' => \@switches,
        'verbose+' => \$verbose,
) or die Usage();

@switch_list_files = split(/,/, join(',', @switch_list_files));
@switches = split(/,/, join(',', @switches));

foreach my $file (@switch_list_files) {
        if (open F, "<$file") {
                while (<F>) {
                        chomp;
                        push @switches, (split /\s/, $_, 2)[0];
                }
                close F;
        } else {
                die "no readum $file: $!\n";
        }
}

my @acl = ( undef, '0.0.0.0', '0.0.0.0', undef, '255.255.255.255', 'all', 0 );

if (!defined $switches[0] && $show) {
        my $rules;
        $rules = acl_load($rules_file);
        show_rules($rules,$show);
        exit;
}

die "i'll need a community please.\n" if $community eq '';
die "i need some switches to work with.\n" unless (@switches > 0);

print $#switches+1, " switches.\n" if ($verbose >0);

sub Usage { "Try 'perldoc $0'\n" }

# ok, got community string and some switches, what to do....
my $rules = [];

$rules = acl_load($rules_file) if $aclload;

SNMP::initMib;                        # load defaults first!
SNMP::addMibDirs( @mib_dirs );
SNMP::loadModules( @mibs );

my ($o_id,$o_if,$o_v,$o_t) = (0..3);     # handy dandy extra typing
my %oid = (
        sysdscr => ['sysDescr', 0, undef, 'OCTETSTR'],
        ifcount => ['ifNumber', 0, undef, 'INTEGER'],
        ifdescr => ['ifDescr', undef, undef, 'OCTETSTR'],
        ifaclid => ['nwIpFwdIfAclIdentifier', undef, undef, 'INTEGER'],
        ifaclst => ['nwIpFwdIfAclStatus', undef, undef, 'INTEGER'],
        aclvent => ['nwIpAclValidEntries', 0, undef, 'INTEGER'],
        aclperm => ['nwIpAclPermission', undef, undef, 'INTEGER'],
        acldsta => ['nwIpAclDestAddress', undef, undef, 'IPADDR'],
        acldstm => ['nwIpAclDestMask', undef, undef, 'IPADDR'],
        aclsrca => ['nwIpAclSrcAddress', undef, undef, 'IPADDR'],
        aclsrcm => ['nwIpAclSrcMask', undef, undef, 'IPADDR'],
        aclprot => ['nwIpAclProtocol', undef, undef, 'INTEGER'],
        aclport => ['nwIpAclPortNumber', undef, undef, 'INTEGER'],
);

# map them to full numeric oid's so you can set them.

$oid{$_}->[$o_id] = $SNMP::MIB{$oid{$_}->[$o_id]}{objectID} for keys %oid;

# this sets us up as ACL #1  don't know if there can be more...
$oid{$_}->[$o_id] .= '.1' for (qw( aclperm acldsta acldstm aclsrca aclsrcm aclpr
ot aclport));
# print "$_ $oid{$_}->[$o_id]\n" for keys %oid;

# ACL immutables 
my @acl_tail = (
        [ 'permit-bidirectional', '0.0.0.0', '0.0.0.0', 
          '127.0.0.0', '255.0.0.0', 'all', 0 ],
        [ 'deny-bidirectional', '0.0.0.0', '0.0.0.0', 
          '0.0.0.0', '0.0.0.0', 'all', 0 ],
);
my @acl_null = ( 'invalid', '0.0.0.0', '0.0.0.0',
        '0.0.0.0', '0.0.0.0', 'all', 0
); 


#
#  here we go
#


foreach my $sw (@switches) {
        print "switch: $sw\n" if ($verbose >0);
        my $s = { sw => $sw }; # acl_ifs => [ if, ... ], acl_len => #
        if(probe($s)) {
                print Data::Dumper->Dump([$s],['s']) if ($verbose >1);
        } else { 
                print Data::Dumper->Dump([$s],['s']) if ($verbose >1);
                warn "err: $sw $s->{err}\n"; next;
        }
        print "probed: $sw\n rev $s->{rev}\n ifs $s->{ifcnt} aif @{$s->{aclifs}} ave $s->{aclve} ifsd ",join("/",@{$s->{aclifsd}}),"\n" if ($verbose >0);
        unless (acl_off($s)) {
                warn "err: $sw $s->{err}\n"; next;
        }
        print "acl disabled $sw\n" if ($verbose >0);
        #acl_nuke($s) if $nuke;
        if ($aclload) {
                unless (acl_apply($s,1,($s->{aclve}-2))) { # 1..34 100..101 =36
                        warn "err: $sw $s->{err}\n"; next;
                }
                print "acl set $sw\n" if ($verbose >0);
        } else {
                print "acl untouched $sw\n" if ($verbose >0);
        }
        if ($on) {
                unless (acl_on($s)) {
                        warn "err: $sw $s->{err}\n"; next;
                }
                print "acl enabled $sw\n" if ($verbose >0);
        } else {
                print "acl not enabled $sw\n" if ($verbose >0);
        }

        print Data::Dumper->Dump([$s],['s']) if ($verbose >1);
}
print "done.\n" if ($verbose >0);
exit;

sub show_rules {
        my ($rules,$show) = @_;
        print "#",scalar @$rules," rules\n";
        if ($show > 1) {
                print "#type dst dstmsk src srcmsk proto port\n";
                print "#-------------------------------------\n";
                for my $r (@$rules) {
                        print "@$r\n";
                }
        } else {
                print "#type src srcmsk\n";
                print "#---------------\n";
                for my $r (@$rules) {
                        print join(' ',@$r[0,3,4]),"\n";
                }
        }
}

sub acl_load { # print "acl_load not implemented\n"; }
        my $rules = shift;
        my @lines;
        if ($rules eq '') {
                @lines = <DATA>;
        } else {
                open(D, $rules) or die "open: $!\n";
                @lines = <D>;
                close(D);
        }
        my @line = grep !/(?:^#|^__DATA__|^\s+$)/, @lines;  # ugh, DATA hack
        chomp @line;
        print "lines:\n",join "\n", @line, '' if ($verbose >1);
        my @rules;
        for my $i (0..$#line) {
                my ($t,$h,$m) = split /\s+/, $line[$i];
                my $l = $i+1;
                unless (scalar grep /$t/, @allowed_types) {
                        die "Bad rule type $t, expecting (".
                        (join "|", @allowed_types).
                        "):\nline $l: $line[$i]\n"; 
                }
                unless ($h =~ /^\d+\.\d+\.\d+\.\d+$/) {
                        die "Bad host $h, expecting (128.125.xxx.yyy):".
                        "\nline $l: $line[$i]\n" ;
                }
                if ($m and $m !~ /^255\.255\.255\.\d+$/) {
                        die "Bad netmask $m, expecting (255.255.255.xxx):".
                        "\nline $l: $line[$i]\n" ;
                }
                my @r = (@acl);
                $r[0] = $t;
                $r[3] = $h;
                $r[4] = $m if $m;
                push @rules, \@r;
        }
        print scalar @rules," rules\n" if ($verbose >0);
        print Data::Dumper->Dump([\@rules],['rules']) if ($verbose >1);
        return \@rules;
}

sub probe { # print "probe: not implemented\n"; }
        my $s = shift;
        $s->{err} = undef;
        my $ss = new SNMP::Session (
                DestHost => $s->{sw},
                Community => $community,
                UseEnums => 1,
                Retries => 5,
        );
        unless ($ss) {
                $s->{err} = 'no session';
                return undef;
        }
        my ($d,$n,$na) = $ss->get(new SNMP::VarList(
                $oid{sysdscr},$oid{ifcount} ,$oid{aclvent},
        ));
        unless (defined $d and defined $n and defined $na) {
                $s->{err} = 'no probe';
                return undef;
        }
        $s->{ss} = $ss;
        $s->{rev} = $d;
        $s->{ifcnt} = $n;
        $s->{aclve} = $na;
        unless ($d =~ / Rev 04\.08\.22 / ) {
                $s->{err} = 'unsupported revision';
                return undef;
        }
        my @if;
        my @id;
        my @vb = @{$oid{ifdescr}};
#
# needs optimization, could do 1 query vs 10
#
        for (reverse(0..9)) {
                $vb[$o_if] = $n-$_;
                my $d = $ss->get(new SNMP::VarList(\@vb));
                unless (defined $d) {
                        $s->{err} = "no ifDescr.".($n-$_);
                        return undef;
                }
                if ($d =~ /Virtual SMB|Host Data Port/) {
                        push @if, $n-$_;
                        push @id, $d;
                }
        }
        if (!defined $if[0]) {
                $s->{err} = 'no acl-able interfaces';
                return undef;
        }
        $s->{aclifs} = \@if;
        $s->{aclifsd} = \@id;
        return $s;
}

sub acl_nuke { print "acl_nuke: not implemented\n"; }

sub acl_apply { # print "acl_apply: not implemented\n"; }
        my $s = shift;
        $s->{err} = undef;
        my $at = shift;
        my $to = shift;
        my @sets;
        print Data::Dumper->Dump([$rules],['pure_rules']) if ($verbose >1);
        my @flds = qw(
                aclperm acldsta acldstm aclsrca aclsrcm aclprot aclport
        );
        my @vl;
        my $ss = $s->{ss};
        unless ($ss) {
                warn "no ss\n";
                $s->{err} = "no ss";
                return undef;
        }
        for my $b (@flds) {
                my @vb = @{$oid{$b}};
                push @vl, \@vb;
        }
        for my $e (@$rules) {
                for (0..$#flds) {
                        $vl[$_]->[$o_if] = $at;
                        $vl[$_]->[$o_v ] = $e->[$_];
                }
                #push @sets, [ map { [ @$_ ] } @vl ];
                unless ($ss->set(new SNMP::VarList(@vl)) > -1) {
                        $s->{err} = "no acl_apply rule $at";
                        return undef;
                }
                $at++;
        }
        for my $i ($at..$to) {
                for (0..$#flds) {
                        $vl[$_]->[$o_if] = $i;
                        $vl[$_]->[$o_v ] = $acl_null[$_];
                }
                #push @sets, [ map { [ @$_ ] } @vl ];
                unless ($ss->set(new SNMP::VarList(@vl)) > -1) {
                        $s->{err} = "no acl_apply invalid $i";
                        return undef;
                }

        }
        for my $i (0..1) {
                for (0..$#flds) {
                        $vl[$_]->[$o_if] = $i+100;
                        $vl[$_]->[$o_v ] = $acl_tail[$i]->[$_];
                }
                #push @sets, [ map { [ @$_ ] } @vl ];
                unless ($ss->set(new SNMP::VarList(@vl)) > -1) {
                        $s->{err} = "no acl_apply tail ".($i+100);
                        return undef;
                }
        }
=begin alt
        foreach my $set (@sets) {
                print Data::Dumper->Dump([$set],['sets']) if ($verbose >0);
                unless ( 1 ) { #$s->{ss}->set(new SNMP::VarList(@$set)) > -1) {
                        $s->{err} = 'no acl_apply';
                        return undef;
                }
        }
=cut
        print Data::Dumper->Dump([\@sets],['sets']) if ($verbose >1);
        return $s;
}

sub acl_state { # print "acl_state: not implemented\n"; }
        my $s = shift;
        my $on = shift;
        $s->{err} = undef;
        my $ifr = $s->{aclifs};
        my (@vs,@vi,@vl);
        my ($st,$id) = $on ? ('enabled',1) : ('disabled',0);
        for (@$ifr) {
                my @vbs = @{$oid{ifaclst}};
                my @vbi = @{$oid{ifaclid}};
                $vbs[$o_if] = $_;
                $vbs[$o_v] = $st;
                $vbi[$o_if] = $_;
                $vbi[$o_v] = $id;
                push @vs, \@vbs;
                push @vi, \@vbi;
        }
        @vl = $on ? (@vi,@vs) : (@vs,@vi);
        print Data::Dumper->Dump([\@vl],['vl']) if ($verbose >1);
        unless ($s->{ss}->set(new SNMP::VarList(@vl)) > -1) {
                $s->{err} = 'no acl_state change';
                return undef;
        }
        return $s;
}

sub acl_on { # print "acl_on: not implemented\n"; }
        my $s = shift;
        $s->{err} = undef;
        return $s if defined acl_state($s,1);
        return undef;
}

sub acl_off { # print "acl_off: not implemented\n"; }
        my $s = shift;
        $s->{err} = undef;
        return $s if defined acl_state($s,0);
        return undef;
}

###########################################
###########################################
###########################################

=head1 NAME

acltool - Manage ACL's on Martini SFS 2.0.29+ switches.

=head1 SYNOPSIS

acltool [options]

 Options:
   -help              brief help message
   -man               full documentation

   -display           show the acl rules.
   -rules <file>      load acl rules from file.
   -verbose           increase verbosity.

   -n <comm>          set the SNMP community string. 
   -community <comm>  (required for anything below)

   -switch <switch>   do this switch.
   -list <file>       load switches from file.

   -(no)acl           load acl rules onto switch. (default is -acl)
   -(no)on            activate acl on switch.     (default is -on) 
   -off               implies -noacl and -noon

 Switches may be abbreviated to shortest uniq.  acltool *always*
 disables the acl on the switch, it would be insane to modify an
 active acl.

 -s ucc-6000-1,ucc-6000-2,ucc-6000-3 -l wph-switches.txt,koh-switches.txt
 Will work.

=head1 OPTIONS

=over 8

=item B<-help>

Print a brief help message and exits.

=item B<-man>

Prints the manual page and exits.

=item B<-display>

Displays the ACL rules.  If rules are specified with the B<-rules> flag
they will be shown.  Otherwise the default builtin rules will be shown.

Repeat the flag (.. -d -d ..) for a different output format.

=item B<-rules>

Loads the ACL rules from a file.  Format of the file is best explained
by looking at the very end of the B<acltool> script itself.

$ less `which acltool`

=item B<-verbose>

Increase the verbosity of the program.  Default is to show nothing
on success.  May be repeated multiple times for increased verbosity.

=item B<-community>

Set the SNMP r/w community string.  Required if you want to do more
than display rules.

=item B<-n>

A familiar abbreviation for the B<-community> flag.

=item B<-switches>

Do these switches.  May be repeated like this:

-s switch1 -s switch2 -s switch3,switch4 ...

Both B<-list> and B<-switch> may be used/intermixed/repeated.

=item B<-list>

Loads the switches to do from a file.  May be repeated like B<-switch>.
Both B<-list> and B<-switch> may be used/intermixed/repeated.

=item B<-acl>

Load the ACL onto the switch.  This is the default.  Can be disabled
with B<-noacl>.

Primary use would be to reactivate the ACL on a switch without reloading
the rules.

 $ acltool -n *** -s ucc-6000-1 -off
 # acl is off 
 $ acltool -n *** -s ucc-6000-1 -noacl
 # acl is back on

=item B<-on>

Enable the ACL on the switch.  This is the default.  Can be disabled
with B<-noon>.

Primary use would be to load the ACL on a switch without activating it.

 $ acltool -n **** -s ucc-6000-1 -noon
 # acl loaded but disabled

=item B<-off>

Disable the ACL on the switch.  This is an alias for B<-noacl> B<-noon>.

 $ acltool -n **** -s ucc-6000-1 -off
 # acl disabled

=back

=head1 DESCRIPTION

B<acltool> helps manage the ACL on SFS 2.0.29+ switches.

=cut

__END__
#
# RULES START HERE

# Lines starting with '#' are comments.
# Blank lines are ignored.
# Format: rule ip [netmask]

# (single hosts, 255.255.255.255 netmask default)
permit 192.168.14.128
permit 192.168.14.129
permit 192.168.14.130
permit 192.168.14.179
permit 192.168.14.185
permit 192.168.13.149
permit 192.168.13.150
permit 192.168.13.166
permit 192.168.13.176
permit 192.168.13.183
permit 192.168.13.184
permit 192.168.222.131
permit 192.168.222.149
permit 192.168.222.156
permit 192.168.222.166
permit 192.168.222.171
permit 192.168.222.176
permit 192.168.222.183
permit 192.168.222.184
permit 192.168.222.50
permit 192.168.29.111
permit 192.168.29.126
permit 192.168.29.33
permit 192.168.29.73
permit 192.168.7.149
permit 192.168.7.150
permit 192.168.7.166
permit 192.168.7.176
permit 192.168.7.183
permit 192.168.7.25
permit 128.9.160.149

# (networks)
# special dsl with netmask
permit 192.168.85.0 255.255.255.224

# (trap hosts)
permit-bidirectional 192.168.222.166
permit-bidirectional 192.168.222.183
permit-bidirectional 192.168.222.50
# end