#! /usr/bin/perl

# truncate firewall [name, modify, ipv6-name, ipv6-modify] rulesets and their
# references to 28 characters when upgrading to mendocino. See bug 6292

use strict;
use warnings;

use lib "/opt/vyatta/share/perl5/";
use XorpConfigParser;
use File::Copy;

my $orig_cfg = shift;
exit 1 unless $orig_cfg;

my $xcp = new XorpConfigParser();
$xcp->parse($orig_cfg);

my $fw = $xcp->get_node( ['firewall'] );
exit 0 unless $fw;    # firewall not configured

# Enable/disable debug output.
my $DEBUG = undef;

sub dprintf {
  my ($args) = @_;
  if ( defined $DEBUG ) {
    printf( STDERR $args );
  }
}

# number of max chars for each type in this hash is 28 + length of type + ' '
my %fw_types_chars_hash = (
  'name'        => '33',
  'ipv6-name'   => '38',
  'modify'      => '35',
  'ipv6-modify' => '40'
);

# truncate all firewall ruleset definitions to a max of 28 chars
dprintf("\n\n***********************************************************\n");
dprintf("attempt to truncate FW ruleset definitions\n");
my $fw_children = $fw->{'children'};
foreach my $fw_type ( keys %fw_types_chars_hash ) {
  dprintf("\nattempt to truncate FW '$fw_type' ruleset definitions\n");
  my @fw_rulesets;
  foreach my $child (@$fw_children) {

    # Find fw type entries
    next unless ( $child->{'name'} =~ /^$fw_type / );
    push @fw_rulesets, $child;
  }
  foreach my $fw_ruleset (@fw_rulesets) {
    dprintf(
      "ruleset name BEFORE truncation under FW : $fw_ruleset->{'name'}\n");
    if ( length( $fw_ruleset->{'name'} ) > $fw_types_chars_hash{$fw_type} ) {
      dprintf("TRUNCATE : $fw_ruleset->{'name'}\n");
      my $truncated_fw =
        substr( $fw_ruleset->{'name'}, 0, $fw_types_chars_hash{$fw_type} );
      $fw_ruleset->{'name'} = $truncated_fw;
    }
    dprintf("ruleset name AFTER truncation under FW : $fw_ruleset->{'name'}\n");
  }
}

# truncate custom ruleset usage under content-inspection to 28 chars
dprintf("\n\n***********************************************************\n");
dprintf("attempt to truncate custom ruleset usage under C-I\n");
my $ci_tf = $xcp->get_node( [ 'content-inspection', 'traffic-filter' ] );
if ( defined $ci_tf ) {
  my $ci_tf_children = $ci_tf->{'children'};
  foreach my $child (@$ci_tf_children) {
    if ( $child->{'name'} =~ /^custom / ) {
      dprintf("ruleset name BEFORE truncation under C-I : $child->{'name'}\n");

      # truncate custom ruleset name to a max of 28 chars
      if ( length( $child->{'name'} ) > 35 ) {    # extra 7 chars for 'custom '
        dprintf("TRUNCATE : $child->{'name'}\n");
        my $truncated_ci_tf = substr( $child->{'name'}, 0, 35 );
        $child->{'name'} = $truncated_ci_tf;
      }
      dprintf("ruleset name AFTER truncation under C-I : $child->{'name'}\n");
    }
  }
}

# truncate firewall ruleset usage under all interfaces to 28 chars
my @fw_dirs = ( 'in', 'out', 'local' );

# function to trim ruleset name given interface's firewall path
sub truncate_intf_fw {
  my @intf_FW_path = @_;
  my $first_dir    = 'true';

  dprintf("'@intf_FW_path'\n");
  foreach my $dir (@fw_dirs) {
    pop(@intf_FW_path) if $first_dir eq 'false';
    push( @intf_FW_path, $dir );
    $first_dir = 'false';
    dprintf("'@intf_FW_path'\n");
    my $FW_dir         = $xcp->get_node( \@intf_FW_path );
    my $childrenFW_dir = $FW_dir->{'children'};
    if ( defined($childrenFW_dir) ) {
      foreach my $fw_type ( keys %fw_types_chars_hash ) {
        foreach my $child (@$childrenFW_dir) {
          next unless ( $child->{'name'} =~ /^$fw_type / );
          dprintf("ruleset name BEFORE truncation : $child->{'name'}\n");
          if ( length( $child->{'name'} ) > $fw_types_chars_hash{$fw_type} ) {
            dprintf("TRUNCATE : $child->{'name'}\n");
            my $truncated_fw =
              substr( $child->{'name'}, 0, $fw_types_chars_hash{$fw_type} );
            $child->{'name'} = $truncated_fw;
          }
          dprintf("ruleset name AFTER truncation : $child->{'name'}\n");
        }
      }
    }
  }

}

dprintf("\n\n***********************************************************\n");
dprintf("attempt to truncate fw ruleset usage under INTERFACES\n");
my $intf_node = $xcp->get_node( ['interfaces'] );
my $intf_children = $intf_node->{'children'};
if ( defined($intf_children) ) {
  foreach my $intf_type (@$intf_children) {
    dprintf("\ninterfaces $intf_type->{'name'}\n");
    my $intf_type_children = $intf_type->{'children'};
    foreach my $intf_type_child (@$intf_type_children) {

      if ( $intf_type_child->{'name'} =~ /^firewall/ )
      {    # firewall directly under intf type
            # takes care of these cases :
            #  'ethernet/node.tag'
            #  'input/node.tag'
            #  'pseudo-ethernet/node.tag'
            #  'tunnel/node.tag'
            #  'bonding/node.tag'
            #  'bridge/node.tag'
            #  'openvpn/node.tag'
            #  'wireless/node.tag'
            #  'wirelessmodem/node.tag'
        truncate_intf_fw( 'interfaces', $intf_type->{'name'}, 'firewall' );
      }    # end of 'firewall directly under intf type'

      if ( $intf_type_child->{'name'} =~ /^vif /
        || $intf_type_child->{'name'} =~ /^pppoe / )
      {    # firewall under intf vif or intf pppoe type
            # takes care of these cases :
            #  'bonding/node.tag/vif/node.tag'
            #  'ethernet/node.tag/vif/node.tag'
            #  'wireless/node.tag/vif/node.tag'
            #  'multilink/node.tag/vif/node.tag'
            #  'ethernet/node.tag/pppoe/node.tag'
        dprintf(
          "\ninterfaces $intf_type->{'name'} $intf_type_child->{'name'}\n");
        my $intf_vif_children = $intf_type_child->{'children'};

        foreach my $intf_vif_child (@$intf_vif_children) {
          if ( $intf_vif_child->{'name'} =~ /^firewall/ ) {
            truncate_intf_fw( 'interfaces', $intf_type->{'name'},
              $intf_type_child->{'name'}, 'firewall' );
          }
          if ( $intf_vif_child->{'name'} =~ /^pppoe / )
          {    # firewall under intf eth vif pppoe type
                # takes care of these cases :
                #  'ethernet/node.tag/vif/node.tag/pppoe/node.tag'
            dprintf(
"\ninterfaces $intf_type->{'name'} $intf_type_child->{'name'} $intf_vif_child->{'name'}\n"
            );
            my $intf_vif_pppoe_children = $intf_vif_child->{'children'};
            foreach my $intf_vif_pppoe_child (@$intf_vif_pppoe_children) {
              if ( $intf_vif_pppoe_child->{'name'} =~ /^firewall/ ) {
                truncate_intf_fw(
                  'interfaces', $intf_type->{'name'},
                  $intf_type_child->{'name'},
                  $intf_vif_child->{'name'}, 'firewall'
                );
              }
            }
          }    # end of 'firewall under intf eth vif pppoe type'
        }
      }    # end of 'firewall under intf vif or intf pppoe type'

      if ( $intf_type_child->{'name'} =~ /^pvc / )
      {    # firewall under intf adsl pvc type
            # takes care of these cases :
            #  'adsl/node.tag/pvc/node.tag/pppoa/node.tag'
            #  'adsl/node.tag/pvc/node.tag/pppoe/node.tag'
            #  'adsl/node.tag/pvc/node.tag/bridged-ethernet'
            #  'adsl/node.tag/pvc/node.tag/classical-ipoa'
        dprintf(
          "\ninterfaces $intf_type->{'name'} $intf_type_child->{'name'}\n");
        my $intf_pvc_children = $intf_type_child->{'children'};

        foreach my $intf_pvc_child (@$intf_pvc_children) {
          if ( $intf_pvc_child->{'name'} =~ /^pppoe /
            || $intf_pvc_child->{'name'} =~ /^pppoa /
            || $intf_pvc_child->{'name'} =~ /^bridged-ethernet/
            || $intf_pvc_child->{'name'} =~ /^classical-ipoa/ )
          {
            dprintf(
"\ninterfaces $intf_type->{'name'} $intf_type_child->{'name'} $intf_pvc_child->{'name'}\n"
            );
            my $intf_pvc_ppp_children = $intf_pvc_child->{'children'};
            foreach my $intf_pvc_ppp_child (@$intf_pvc_ppp_children) {
              if ( $intf_pvc_ppp_child->{'name'} =~ /^firewall/ ) {
                truncate_intf_fw(
                  'interfaces', $intf_type->{'name'},
                  $intf_type_child->{'name'},
                  $intf_pvc_child->{'name'}, 'firewall'
                );
              }
            }
          }
        }
      }    # end of 'firewall under intf adsl pvc type'

      if ( $intf_type_child->{'name'} =~ /^cisco-hdlc/
        || $intf_type_child->{'name'} =~ /^frame-relay/
        || $intf_type_child->{'name'} =~ /^ppp/ )
      {    # firewall under intf serial type
            # takes care of these cases :
            #  'serial/node.tag/cisco-hdlc/vif/node.tag'
            #  'serial/node.tag/frame-relay/vif/node.tag'
            #  'serial/node.tag/ppp/vif/node.tag'
        my $intf_serial_children = $intf_type_child->{'children'};

        foreach my $intf_serial_child (@$intf_serial_children) {
          if ( $intf_serial_child->{'name'} =~ /^vif / ) {
            my $intf_serial_vif_children = $intf_serial_child->{'children'};
            foreach my $intf_serial_vif_child (@$intf_serial_vif_children) {
              if ( $intf_serial_vif_child->{'name'} =~ /^firewall/ ) {
                truncate_intf_fw(
                  'interfaces', $intf_type->{'name'},
                  $intf_type_child->{'name'},
                  $intf_serial_child->{'name'}, 'firewall'
                );
              }
            }
          }
        }
      }    # end of 'firewall under intf serial type'

    }
  }
}

my $tmpname = "/tmp/vyatta_migrate_fw.$$";
open( my $tmp, '>', $tmpname )
  or die "Can't open: $tmpname: $!";

select $tmp;
$xcp->output(0);
select STDOUT;
close $tmp;

move( $tmpname, $orig_cfg )
  or die "Move $tmpname to $orig_cfg failed: $!";

