#!/usr/local/bin/perl -w
#
# Copyright (c) 2001-2013, 2015 by cisco Systems, Inc.
# All rights reserved.
#

use strict;
no warnings;
use CGI qw(:standard);

#
# The goal of this program is to parse a BGP message and display it in
# a readable format.
#
  
# Move the history to
# http://wwwin-routing.cisco.com/cgi-bin/bgp_decode/version.pl

#
# Declare misc variables
#
my @string;
my $char       = "";
my $output     = "";
my $length     = "";
my $state      = 0;
my $input_mode = -1;
my @message;
my @original_message;
my $avail_message_size = 0;
my $cgi_page  = new CGI;
my $script    = $ENV{'SCRIPT_NAME'};
my $hex_input = "";
my $debug = 1;


#
# The info has been loaded into...
#
sub readForm {
 
    my @input = split(/\n/, $hex_input);

    my $line;
    foreach $line (@input) {
        chomp($line);

        #
        # clean up ROUTEM debug output
        #
        # ROUTEM: ff ff ff ff  ff ff ff ff  ff ff ff ff  ff ff ff ff
        #
        if ($line =~ /ROUTEM:\s*(\w.*\w)\s*$/) {
            $line = $1;

        #
        # clean up IOX debug output
        #
        # RP/0/0/CPU0:Apr  5 09:46:23.462 : bgp[122]: [iowt]: ffff ffff ffff ffff ffff ffff ffff ffff
        #
        } elsif ($line =~ /\[.*\]: (.*?)\s*$/) {
            $line = $1;
        }
     
        if ($input_mode == -1) {
            if ($line =~ /^\w\w\w\w\w\w\w\w:\s+([0-9A-Fa-f]+) ([0-9A-Fa-f]*) ([0-9A-Fa-f]*) ([0-9A-Fa-f]*) /) {
                $input_mode = 0;
            } elsif ($line =~ /^\w\w\w\w:\s+(.*)\s+\|/ ||  $line =~ /^\w\w\w\w:\s+(.*)/) {
                $input_mode = 1;
            } elsif ($line =~ /^\s*\w\w\w\w\w\w\w\w \w\w\w\w\w\w\w\w \w\w\w\w\w\w\w\w \w\w\w\w\w\w\w\w\s*$/ ||
                     $line =~ /^\w\w \w\w \w\w \w\w  \w\w \w\w \w\w \w\w  \w\w \w\w \w\w \w\w  \w\w \w\w \w\w \w\w\s*$/ ||
                     $line =~ /^[\s|\w]+$/) {
                $input_mode = 2;
            }
        }
    
        # Mode 0
        if ($input_mode == 0) {
            if ($line =~ /^\s*\w+:\s+([0-9A-Fa-f]+) ([0-9A-Fa-f]*) ([0-9A-Fa-f]*) ([0-9A-Fa-f]*) /) {;
                my $tmp_string = $1 . $2 . $3 . $4;
                $tmp_string = remove_Xtra_spaces($tmp_string);
                my @tmp_array = split(//, $tmp_string);
                foreach $char (@tmp_array) {
                    if ($char ne "") {
                        push @string, uc($char);
                    }
                }
    
            } elsif ($line =~ /IP:/) {
                <STDIN>;
                <STDIN>;
                <STDIN>;
            }
    
        # Mode 1
        } elsif ($input_mode == 1) {
    
            if ($line =~ /^\w+:\s+(.*)\s+\|/) {;
                my $tmp_string = $1;
                $tmp_string = remove_Xtra_spaces($tmp_string);
                my @tmp_array = split(//, $tmp_string);
                foreach $char (@tmp_array) {
                    if ($char ne "") {
                        push @string, uc($char);
                    }
                }
    
            } elsif ($line =~ /^\w+:\s+(.*)/) {
                my $tmp_string = $1;
                $tmp_string = remove_Xtra_spaces($tmp_string);
                my @tmp_array = split(//, $tmp_string);
                foreach $char (@tmp_array) {
                    if ($char ne "") {
                        push @string, uc($char);
                    }
                }
            }
    
        # Mode 2 - plain hex
        } elsif ($input_mode == 2) {
            $line = remove_Xtra_spaces($line);
            if ($line !~ /^\s*$/ && $line !~ /\#/ && $line !~ /timestamp/) {
                my @tmp_array = split(//, $line);
                foreach $char (@tmp_array) {
                    if ($char ne "") {
                        push @string, uc($char);
                    }
                }
            }
        }
    } # End of foreach $line (@input) 

    #
    # Parse the messages out of @string until everything is gone
    #
    my $message_cnt = 0;
    while ($#string > 1) {
    
        #
        # Pull the first message out of the string
        #
        $message_cnt++;
        my $str_cnt = 0;
        my $bgp_message_start_point = -100;
        my $bgp_message_end_point = -100;
        for ($str_cnt = 0;
             $str_cnt <= $#string && ($bgp_message_start_point == -100 || $bgp_message_end_point == -100);
             $str_cnt++) {
            if ($str_cnt + 31 <= $#string &&
                $string[$str_cnt] eq "F" &&
                $string[$str_cnt + 1] eq "F" &&
                $string[$str_cnt + 2] eq "F" &&
                $string[$str_cnt + 3] eq "F" &&
                $string[$str_cnt + 4] eq "F" &&
                $string[$str_cnt + 5] eq "F" &&
                $string[$str_cnt + 6] eq "F" &&
                $string[$str_cnt + 7] eq "F" &&
                $string[$str_cnt + 8] eq "F" &&
                $string[$str_cnt + 9] eq "F" &&
                $string[$str_cnt + 10] eq "F" &&
                $string[$str_cnt + 11] eq "F" &&
                $string[$str_cnt + 12] eq "F" &&
                $string[$str_cnt + 13] eq "F" &&
                $string[$str_cnt + 14] eq "F" &&
                $string[$str_cnt + 15] eq "F" &&
                $string[$str_cnt + 16] eq "F" &&
                $string[$str_cnt + 17] eq "F" &&
                $string[$str_cnt + 18] eq "F" &&
                $string[$str_cnt + 19] eq "F" &&
                $string[$str_cnt + 20] eq "F" &&
                $string[$str_cnt + 21] eq "F" &&
                $string[$str_cnt + 22] eq "F" &&
                $string[$str_cnt + 23] eq "F" &&
                $string[$str_cnt + 24] eq "F" &&
                $string[$str_cnt + 25] eq "F" &&
                $string[$str_cnt + 26] eq "F" &&
                $string[$str_cnt + 27] eq "F" &&
                $string[$str_cnt + 28] eq "F" &&
                $string[$str_cnt + 29] eq "F" &&
                $string[$str_cnt + 30] eq "F" &&
                $string[$str_cnt + 31] eq "F" &&
                #
                # The first byte of the length field has to be either 0 or 1
                #
                ($string[$str_cnt + 32] eq "0" ||
                 $string[$str_cnt + 32] eq "1")) {
    
                $bgp_message_start_point = $str_cnt;
                my $pre_length = $string[$str_cnt + 32] . $string[$str_cnt + 33] . $string[$str_cnt + 34] . $string[$str_cnt + 35];
                $pre_length = hex2dec($pre_length);
                $bgp_message_end_point = $bgp_message_start_point + ($pre_length * 2) - 1;
            }
        }
    
        if ($bgp_message_end_point == -100) {
            print "==================================================\n";
            print "Error: not a BGP message\n";
            exit(0);
        }
    
        #
        # Need to do a couple of things to extract the first message from @string
        # - if there is only one message in @string then set bgp_message_end_point accordingly
        # - copy all of the @string spots that we need
        # - once we have them copied remove those spots from @string (shift)
        #
        $bgp_message_end_point = $#string if ($bgp_message_end_point == -1 || $bgp_message_end_point == -100);
    
        for (my $i = $bgp_message_start_point, my $j = 0;
             $i <= $bgp_message_end_point && $i <= $#string;
             $i++, $j++) {
            $message[$j] = $string[$i];
            $original_message[$j] = $string[$i];
        }

        for (my $i = 0; $i <= $bgp_message_end_point; $i++) {
            shift @string;  # need to double check this
        }
    
        $avail_message_size = (4 * ($#message + 1))/8;
        ####print "\n<h2>Message \#$message_cnt - $avail_message_size bytes</h2>\n";
        #print "==================================================\n";
        ####print "<div class='message'>\n";
        ####for (my $i = 0; $i <= $#message; $i++) {
        ####    print "$message[$i]";
        ####    print " " if (eval($i + 1)%2 == 0);
        ####    print " " if (eval($i + 1)%8 == 0);
        ####    print "\n" if (eval($i + 1)%32 == 0);
        ####}
        ####print "</div>\n";
    
        parse_bgp_message();
        undef @message;
        undef @original_message;
        $avail_message_size = 0;
    
    } # End of while ($#string)
    
  
} # End of readForm()

# *******************************************
# void main()
# *******************************************


my $file = "/pkg/bin/results.txt";

$hex_input = do {
   local $/ = undef;
   open my $fh, "<", $file
     or die "Count not open $file: $!";
   <$fh>;
};

####$hex_input = "FFFFFFFF FFFFFFFF FFFFFFFF FFFFFFff 00 13 04";
#$hex_input = $ARGV[0];
readForm();



# *******************************************
# End of program
# *******************************************

#
# parse_bgp_message
# - parse the header of the BGP message
# - determine what type of message this is and call the appropriate function
#
sub parse_bgp_message {
    my $state = 0;

    my $marker = get_message_chars(32);
    ####print "<div class='marker'>\n";
    print "\n  BGP MARKER:\t0x$marker\n";

    $length = get_message_chars(4);
    print "  BGP LEN:\t0x$length\t- ";
    $length = hex2dec($length);
    print  "$length bytes\n";

    if ($length < 19 || $length > 4096) {
        print "  ERROR: Length must be at least 19 but not greater than 4096\n";
  
        exit(0);
    }

    if ($avail_message_size < $length) {
        print "  ERROR: The BGP header says the message has $length bytes but \n  only $avail_message_size bytes were available\n";
    }

    my $type = get_message_chars(2);
    print "  BGP TYPE:\t0x$type\t- ";
    $type = hex2dec($type);

    if ($type == 1) {
        print "OPEN\n\n";
        parse_open();
    } elsif ($type == 2) {
        print "UPDATE\n\n";
        parse_update($length);
    } elsif ($type == 3) {
        print "NOTIFICATION\n\n";
        parse_notification();
    } elsif ($type == 4) {
        print "KEEPALIVE\n\n";
        parse_keepalive();
    # RFC 2918
    } elsif ($type == 5) {
        print "ROUTE REFRESH\n\n";
        parse_route_refresh();
    } elsif ($type == 128) {
        print "OLD ROUTE REFRESH\n\n";
        parse_route_refresh();
    } else {
        print "  ERROR: $type is an unknown BGP message type\n";
        exit(0);
    }

  
    return 0;
}

#
# parse_open
# - parses an OPEN message
#
sub parse_open {
    ####print "<div class='open'>\n";
    print "\nOPEN\n";

    my $version = print_hex_and_dec(2, "VERSION:\t", 1 , "");
    my $AS        = print_hex_and_dec(4, "AS:\t\t", 1, "");
    my $hold_time = print_hex_and_dec(4, "HOLD TIME:\t", 1, "");
    my $router_id = print_hex_and_ipv4(0, 0, 8, "ROUTER ID:\t", 1, "");

    my $opt_parameters_length = print_hex_and_dec(2, "OPTIONAL PARAMETERS LENGTH:\t", 1, "bytes");
    while ($opt_parameters_length > 0) {
        $opt_parameters_length -= 2;
        print "\n";
        my $tlv_type = hex2dec(get_message_chars(2));
        my $tlv_length = hex2dec(get_message_chars(2));

        print "Opt Length:\t$opt_parameters_length\n";
        $opt_parameters_length -= $tlv_length;

        # RFC 1771
        if ($tlv_type == 1) {
            print "Authentication Optional Parameter - DECODE NOT SUPPORTED\n";

        # RFC 2842
        } elsif ($tlv_type == 2) {
            print "Param Type:\t$tlv_type - Optional Parameter\n";
            print "Param Length:\t$tlv_length\n";

            while ($tlv_length > 0) {

                $tlv_length -= 2;
                my $cap_type = print_hex_and_dec(2, "Cap Type:\t", 1, "");

                if ($cap_type == 1) {
                    print "\t\t<b>Multi Protocol Capability</b>\n";
                } elsif ($cap_type == 2) {
                    print "\t\t<b>Route Refresh Capability (new)</b>\n";                 # RFC 2918
                } elsif ($cap_type == 128) {
                    print "\t\t<b>Route Refresh Capability (old)</b>\n";                 # RFC 2918
                } elsif ($cap_type == 60) {
                    print "\t\t<b>Dampening Protocol Capability</b>\n";                # RFC 2858
                } elsif ($cap_type == 65) {
                    print "\t\t<b>4-byte AS Capability</b>\n";
                } elsif ($cap_type == 64) {
                    print "\t\t<b>Graceful Restart Capability</b>\n";
                } elsif ($cap_type == 70) {
                    print "\t\t<b>Enhanced Route Refresh Capability</b>\n";                 # draft-keyur-bgp-enhanced-route-refresh-02
                } elsif ($cap_type == 131) {
                    print "\t\t<b>Multi-Session Capability</b>\n";
                } else {
                    print "\t\t<b>Unknown Capability</b>\n";
                }

                my $cap_length = print_hex_and_dec(2, "Cap Length:\t", 1, "bytes");
                $tlv_length -= $cap_length;

                if ($cap_type == 1) {
                    my $afi = print_hex_and_dec(4, "\tAFI:\t", 1, "");
                    my $resv_bits = print_hex_and_dec(2, "\tReserved Bits:\t", 1, "");
                    my $safi = print_hex_and_dec(2, "\tSAFI:\t", 1, "");
                } elsif ($cap_type == 2) {
                    # print "Route Refresh Capability (new)\n";                 # RFC 2918
                } elsif ($cap_type == 128) {
                    # print "Route Refresh Capability (old)\n";                 # RFC 2918
                } elsif ($cap_type == 60) {

                    while ($cap_length > 0) {
                        my $afi = print_hex_and_dec(4, "\tAFI:\t", 1, "");
                        my $resv_bits = print_hex_and_dec(2, "\tReserved Bits:\t", 1, "");
                        my $safi = print_hex_and_dec(2, "\tSAFI:\t", 1, "");
                        my $result = print_hex_and_dec(2, "\tValue:\t", 1, "");
                        print "\n";
                        $cap_length -= 5;
                    }
                    print "\n";

                } elsif ($cap_type == 64) {
                    # print "Graceful Restart Capability\n";                    # RFC 4724
                    my $restart_flag = print_hex_and_dec(4, "Restart flag:\t\t", 0, "");

                    $cap_length -= 2;

                    while ($cap_length > 0) {
                        my $afi = print_hex_and_dec(4, "\tAFI:\t", 1, "");
                        my $safi = print_hex_and_dec(2, "\tSAFI:\t", 1, "");
                        my $flags = print_hex_and_dec(2, "\tFlags:\t", 1, "");
                        print "\n";
                        $cap_length -= 4;
                    }
                    print "\n";

                } elsif ($cap_type == 65) {
                    my $as_xx = get_message_chars(4);
                    my $as_yy = get_message_chars(4);
                    print "AS Number:\t" . hex2dec($as_xx) . "." . hex2dec($as_yy) . " (0x$as_xx.0x$as_yy)\n";

                } else {
                    print_hex_and_dec($cap_length * 2, "Cap Value:\t", 1, "");
                }
            }
        }

    } # End of while optional_paramenters_length > 0
    get_message_chars($#message);
    print "</div>\n";
    return 1;

}

#
# parse_update
# - parses an UPDATE message
# - calls parse_withdraw_nlri, parse_attributes, and parse_advertise_nlri to cut down
#    on the size of this function
#
sub parse_update {
    (my $length) = @_;

    ##print "\n  UPDATE\n\n";

    my $unfeasible_routes = print_hex_and_dec(4, "  UNFEASIBLE ROUTES LEN:  ", 1, "bytes");
    parse_withdraw_nlri(0, 0, $unfeasible_routes);

    my $total_attr_length = print_hex_and_dec(4, "  TOTAL PATH ATTR LEN:    ", 1, "bytes");
    parse_attributes($total_attr_length);

    ####print "<div class='nlri'>\n";
    print "\n  NLRI:\n\n";
    print "    NLRI LENGTH:  UPDATE LEN - 23 - PATH ATTR LEN - UNFEASIBLE ROUTES LEN\n";
    print "    NLRI LENGTH:  $length - 23 - $total_attr_length - $unfeasible_routes\n";
    my $nlri_length = $length - 23 - $total_attr_length - $unfeasible_routes;
    print "    NLRI LENGTH:  $nlri_length bytes\n";

    parse_advertise_nlri(0, 0, $nlri_length);

    if ($#message > -1) {
         print "WARNING:  The following part of the packet was \"extra\" that we didn't decode:\n";
         for (my $i = 0; $i < $#message; $i++) {
             print "$message[$i]";
         }
         print "\n\n";
    }

    return 1;
}

#
# parse_notification
# - parse a NOTIFICATION message
# - will display the error code, subcode, and the data portion of the message
#
sub parse_notification {
    ####print "<div class='notification'>\n";
    print "\nNOTIFICATION\n";
    my $error_code = print_hex_and_dec(2, "ERROR CODE:\t", 1, "");
    my $error_subcode = print_hex_and_dec(2, "ERROR SUB CODE:\t", 1, "");
    print "DATA:\t\t0x" . get_message_chars($#message) . "\n";
    print "</div>\n";

    return 1;
}


#
# parse_keepalive
# - parses a KEEPALIVE message
# - not much to parse here :)
#
sub parse_keepalive {
    ####print "<div class='keepalive'>\n";
    ####print "<h2>KEEPALIVE</h2>\n";
    get_message_chars($#message);
    ####print "</div>\n";
    return 1;
}

#
# parse_route_refresh
# - parses a ROUTE REFRESH message
#
sub parse_route_refresh {
    ####print "<div class='route_refresh'>\n";
    print "\nROUTE REFRESH\n";
    my $afi = print_hex_and_dec(4, "\t\tAFI:\t\t", 1, "");
    my $resv_bits = print_hex_and_dec(2, "\t\tReserved Bits:\t", 1, "");
    my $safi = print_hex_and_dec(2, "\t\tSAFI:\t\t", 1, "");
    ####print "</div>\n";
    return 1;
}


#
# parse_withdraw_nlri
# - parse all of the withdrawn NLRI in a BGP UPDATE
#
sub parse_withdraw_nlri {
    (my $afi, my $safi, my $bytes) = @_;

    while ($bytes > 0) {
        $bytes--;
        my $withdraw_length_hex = get_message_chars(2);
        my $withdraw_length  = hex2dec($withdraw_length_hex);
        my $mask = $withdraw_length;
        if ($withdraw_length%8 != 0) {
            $withdraw_length += (8 - $withdraw_length%8);
        }

        my $withdraw_content = get_message_chars(($withdraw_length/8) * 2); # WITHDRAWS are in bits
        print "  WITHDRAWN route:\t0x$withdraw_content\/0x$withdraw_length_hex\t- " . hex2Address($afi, $safi, $withdraw_content, 0, 0) . "/$mask\n";
        $bytes -= ($withdraw_length/8);
    }

    return 1;
}


#
# parse_advertise_nlri
# - parse all of the advertised NLRI in a BGP UPDATE
#
sub parse_advertise_nlri {
    (my $afi, my $safi, my $bytes) = @_;

    while ($bytes > 0) {
        $bytes--;
        #my $net_length = print_hex_and_dec(2, "NLRI PREFIX LENGTH:\t", 1, "bits");

        my $net_length_hex = get_message_chars(2);
        my $net_length = hex2dec($net_length_hex);
        my $mask = $net_length;
        if ($net_length%8 != 0) {
            $net_length += (8 - $net_length%8);
        }

        my $prefix_hex = get_message_chars(($net_length/8) * 2);
        print "    NLRI PREFIX:  0x$prefix_hex\/0x$net_length_hex\t- " . hex2Address($afi, $safi, $prefix_hex, 0, 0) . "/$mask\n";
        $bytes -= ($net_length/8);
    }

    print "\n";

    return 1;
}


sub attrtype_string {
   (my $attr_type) = @_;
   my $attr_name = "[UNKNOWN ATTRIBUTE]";

   if ($attr_type == 1) {
       $attr_name = "ORIGIN";
  

   } elsif ($attr_type == 2) {
       $attr_name = "AS_PATH";
    

   } elsif ($attr_type == 3) {
       $attr_name = "NEXT_HOP";
      

   } elsif ($attr_type == 4) {
       $attr_name = "MED";
      

   } elsif ($attr_type == 5) {
       $attr_name = "LOCAL_PREF";
   

   } elsif ($attr_type == 6) {
       $attr_name = "ATOMIC_AGGREGATE";


   } elsif ($attr_type == 7) {
       $attr_name = "AGGREGATOR";
   


   } elsif ($attr_type == 8) {
       $attr_name = "COMMUNITY";

   } elsif ($attr_type == 9) {
       $attr_name = "ORIGINATOR_ID";
   } elsif ($attr_type == 10) {
       $attr_name = "CLUSTER_LIST";

   } elsif ($attr_type == 11) {
       $attr_name = "DPA";
   } elsif ($attr_type == 12) {
       $attr_name = "ADVERTISOR";

   } elsif ($attr_type == 13) {
       $attr_name = "CLUSTER_ID";

   } elsif ($attr_type == 14) {
       $attr_name = "MP_REACH_NLRI";

   } elsif ($attr_type == 15) {
       $attr_name = "MP_UNREACH_NLRI";

   } elsif ($attr_type == 16) {
       $attr_name = "EXTENDED_COMMUNITY";

   } elsif ($attr_type == 17) {
       $attr_name = "NEW_AS_PATH";


   } elsif ($attr_type == 18) {
       $attr_name = "NEW_AGGREGATOR";

   } elsif ($attr_type == 22) {
       $attr_name = "PMSI_TUNNEL";

   } elsif ($attr_type == 23) {
       $attr_name = "OLD_PE_ID";

   } elsif ($attr_type == 27) {
       $attr_name = "PE_DISTINGUISHER_LABELS";

   } 

   return $attr_name;

}

#
# parse_attributes
# - parse the attributes of a BGP UPDATE
# - initial part handles all of the attribute flags
# - later on we'll call the appropriate functions to parse the individual attributes
#
sub parse_attributes {
    (my $bytes) = @_;

    while ($bytes > 0) {
        ####print "<div class='attribute'>\n";

        my $attr_type_tmp = hex2dec(substr(peek_message_chars(4), -2));
        my $attr_type_str = attrtype_string($attr_type_tmp);

        # Once the page loads jquery will replace this with the attribute name
        # See the <script> in the header
        # 
        print "\n  $attr_type_str:\n";
   
        ####print "<span class='attr_guts'></span>\n";

        # Print the "Attr Flags" in hex and binary
        $bytes--;
        my $attr_flag = get_message_chars(2); ##print_hex(2, "    ATTRIBUTE FLAG:\t", 0, "");
        my $attr_guts = "0x";
        $attr_guts .= $attr_flag;
        $attr_flag = hex2bin($attr_flag, 1);
        print "\n    ATTRIBUTE FLAG:\t$attr_flag "; ###
        $attr_flag =~ /(\d)(\d)(\d)(\d)(\d)(\d)(\d)(\d)/;

        print ("(");

        if ($1 == 0) {
            ####print "\tBit 0, the Optional bit, is 0 so this is a well-known attribute\n";
            print "WELL-KNOWN, ";
        } else {
            ####print "\tBit 0, the Optional bit, is 1 so this is an optional attribute\n";
            print "OPTIONAL, ";
        }

        if ($2 == 0) {
            ####print "\tBit 1, the Transitive bit, is 0 so this is a non-transitive attribute\n";
            print "NON-TRANSITIVE";
            if ($1 == 0) {
                print "\t<span class='error'>ERROR: well-known attributes must be transitive</span>\n";
            }
        } else {
            ####print "\tBit 1, the Transitive bit, is 1 so this is a transitive attribute\n";
            print "TRANSITIVE";
        }

        if ($3 == 1 || $4 == 1) {
           print ", ";
        }

        if ($3 == 0) {
            ####print "\tBit 2, the Partial bit, is not set\n";
        } else {
            ####print "\tBit 2, the Partial bit, is set\n";
            print "PARTIAL, ";
            if ($1 == 0) {
                print "\tERROR: for well-known attributes the partial bit must be 0\n";
            } elsif ($1 == 1 && $2 == 0) {
                print "\tERROR: for optional non-transitive attributes the partial bit must be 0\n";
            }
        }

        my $ext_bit = 0;
        if ($4 == 0) {
            ####print "\tBit 3, the Extended Length Bit, is 0 so the length field is 1 byte\n";
            ##print "\n";
            $ext_bit = 0;
        } else {
            ####print "\tBit 3, the Extended Length Bit, is 1 so the length field is 2 bytes\n";
            print "EXTENDED";
            $ext_bit = 1;
        }

        if ($5 == 0 && $6 == 0 && $7 == 0 && $8 == 0) {
            #### print "\tThe lower-order four bits of the Attribute Flag are unused and are set to 0000\n";
        } else {
            print "\tERROR: The lower-order four bits must be set to 0000 but are set to $5$6$7$8\n";
        }

        print (")\n");

        ####print "\n";
        my $attr_type = print_hex_and_dec(2, "    ATTRIBUTE TYPE:\t", 1, "");
        $attr_guts .= dec2hexpadded($attr_type, 1);
        $bytes--;

        my $attr_length;
        if (!$ext_bit) {
            $attr_length = print_hex_and_dec(2, "    ATTRIBUTE LENGTH:\t", 1, "bytes");
            $bytes--;
            $attr_guts .= dec2hexpadded($attr_length, 1);
        } else {
            $attr_length = print_hex_and_dec(4, "    ATTRIBUTE LENGTH:\t", 1, "bytes");
            $attr_guts .= dec2hexpadded($attr_length, 2);
            $bytes -= 2;
        }

        $bytes -= $attr_length;
        my $attr_value;
        if ($attr_length) {
           $attr_value = print_hex(($attr_length * 2), "    ATTRIBUTE CONTENT:\t");
        }

        $attr_guts .= $attr_value;
        my $attr_name;

        if ($attr_type == 1) {
            $attr_name = "ORIGIN";
            $attr_value = hex2dec($attr_value);
            if ($attr_value == 0) {
                print "\t- IGP\n";
            } elsif ($attr_value == 1) {
                print "\t- EGP\n";
            } elsif ($attr_value == 2) {
                print "\t- Incomplete\n";
            }

        } elsif ($attr_type == 2) {
            $attr_name = "AS_PATH";
            print "\n";
            parse_AS_path($attr_value, $attr_length, 0);

        } elsif ($attr_type == 3) {
            $attr_name = "NEXT_HOP";
            #print "ATTRIBUTE NAME:\t\t<b>NEXT_HOP</b>\t- " . hex2Address(0, 0, $attr_value, 0, 0)  . "\n";
            print "\t- " . hex2Address(0, 0, $attr_value, 0, 0)  . "\n";

        } elsif ($attr_type == 4) {
            $attr_name = "MED";
            #print "ATTRIBUTE NAME:\t\t<b>MED</b>\t- " . hex2dec($attr_value)  . "\n";
            print "\t- " . hex2dec($attr_value)  . "\n";

        } elsif ($attr_type == 5) {
            $attr_name = "LOCAL_PREF";
            #print "ATTRIBUTE NAME:\t\t<b>LOCAL_PREF</b>\t- " . hex2dec($attr_value)  . "\n";
            print "\t- " . hex2dec($attr_value)  . "\n";

        } elsif ($attr_type == 6) {
            $attr_name = "ATOMIC_AGGREGATE";
            #print "ATTRIBUTE NAME:\t\t<b>ATOMIC_AGGREGATE</b>\n";

        } elsif ($attr_type == 7) {
            $attr_name = "AGGREGATOR";
            #print "ATTRIBUTE NAME:\t\t<b>AGGREGATOR</b>\n";
            print "\n\n";
            parse_aggregator($attr_value, $attr_length);

        } elsif ($attr_type == 8) {
            $attr_name = "COMMUNITY";
            #print "ATTRIBUTE NAME:\t\t<b>COMMUNITY</b>\n";
            print "\n\n";
            parse_community($attr_value);

        } elsif ($attr_type == 9) {
            $attr_name = "ORIGINATOR_ID";
            #print "ATTRIBUTE NAME:\t\t<b>ORIGINATOR_ID</b>\t- " . hex2Address(0, 0, $attr_value, 0, 0) . "\n";
            print "\t- " . hex2Address(0, 0, $attr_value, 0, 0) . "\n";

        } elsif ($attr_type == 10) {
            $attr_name = "CLUSTER_LIST";
            #print "ATTRIBUTE NAME:\t\t<b>CLUSTER_LIST</b>\n";
            print "\n\n";
            parse_cluster_list($attr_value);

        } elsif ($attr_type == 11) {
            $attr_name = "DPA";
            #print "ATTRIBUTE NAME:\t\t<b>DPA</b>\t- " . $attr_value  . "\n";
            print "\t- " . $attr_value  . "\n";

        } elsif ($attr_type == 12) {
            $attr_name = "ADVERTISOR";
            #print "ATTRIBUTE NAME:\t\t<b>ADVERTISOR</b>\t- " . $attr_value . "\n";
            print "\t- " . $attr_value . "\n";

        } elsif ($attr_type == 13) {
            $attr_name = "CLUSTER_ID";
            #print "ATTRIBUTE NAME:\t\t<b>CLUSTER_ID</b>\t-" . $attr_value . "\n";
            print "\t-" . $attr_value . "\n";

        } elsif ($attr_type == 14) {
            $attr_name = "MP_REACH_NLRI";
            print "\n\n";
            #print "ATTRIBUTE NAME:\t\t<b>MP_REACH_NLRI</b>\n";
            if ($attr_length < 6) {
                print "\t<span class='error'>ERROR: Attribute length cannot be $attr_length!</span>\n";
            } else {
                parse_MP_reach_nlri($attr_value);
            }

        } elsif ($attr_type == 15) {
            $attr_name = "MP_UNREACH_NLRI";
            print "\n\n";
            #print "ATTRIBUTE NAME:\t\t<b>MP_UNREACH_NLRI</b>\n";
            if ($attr_length < 6) {
                print "\t<span class='error'>ERROR: Attribute length cannot be $attr_length!</span\n";
            } else {
                parse_MP_unreach_nlri($attr_value);
            }

        } elsif ($attr_type == 16) {
            $attr_name = "EXTENDED_COMMUNITY";
            #print "ATTRIBUTE NAME:\t\t<b>EXTENDED_COMMUNITY</b>\n";
            print "\n\n";
            parse_extended_community($attr_value);

        } elsif ($attr_type == 17) {
            $attr_name = "NEW_AS_PATH";
            #print "ATTRIBUTE NAME:\t\t<b>NEW_AS_PATH</b>\n";
            print "\n\n";
            parse_AS_path($attr_value, $attr_length, 1);

        } elsif ($attr_type == 18) {
            $attr_name = "NEW_AGGREGATOR";
            #print "ATTRIBUTE NAME:\t\t<b>NEW_AGGREGATOR</b>\n";
            print "\n\n";
            parse_aggregator($attr_value, $attr_length);

        } elsif ($attr_type == 22) {
            $attr_name = "PMSI_TUNNEL";
            #print "ATTRIBUTE NAME:\t\t<b>PMSI_TUNNEL</b>\n";
            print "\n\n";
            parse_pmsi_tunnel($attr_value, $attr_length);

        } elsif ($attr_type == 23) {
            $attr_name = "OLD_PE_ID";
            # Should be Tunnel Encapulation Attribute (RFC 5512)
            # Cisco assumes it is PE_ID (or PE distinguisher)at the draft stage
            #print "ATTRIBUTE NAME:\t\t<b>OLD_PE_ID - obsolete</b>\n";
            print "\n\n";
            parse_pe_distinguisher_labels($attr_value, $attr_length);

        } elsif ($attr_type == 27) {
            $attr_name = "PE_DISTINGUISHER_LABELS";
            #print "ATTRIBUTE NAME:\t\t<b>PE_DISTINGUISHER_LABELS</b>\n";
            print "\n\n";
            parse_pe_distinguisher_labels($attr_value, $attr_length);

        } else {
            print "<span class='error'>INVALID Atribute Type $attr_type</span>\n";
        }

        ####print "<span class='attribute_name'>$attr_name</span>\n";
        ####print "<span class='attr_guts_hidden'>$attr_guts</span>\n";


        ##print "\n";
    } # End of while ($bytes)
    return 1;
}

sub parse_aggregator {
    (my $agg, my $attr_length) = @_;

    my $four_byte_as = 0;
    if ($attr_length == 8) {
        $four_byte_as = 1;
    }
    my $agg_AS_xx = "";
    my $agg_AS_yy = "";
    my $agg_ID = "";
    if ($four_byte_as && $agg =~ /^(\w\w\w\w)(\w\w\w\w)(\w\w\w\w\w\w\w\w)$/) {
        $agg_AS_xx = $1;
        $agg_AS_yy = $2;
        $agg_ID = $3;
        print "\tAGGREGATOR AS:\t(0x$agg_AS_xx.0x$agg_AS_yy)\t- " . hex2dec($agg_AS_xx) . "." . hex2dec($agg_AS_yy) . "\n";
        print "\tAGGREGATOR ID:\t(0x$agg_ID)\t- " . hex2Address(0, 0, $agg_ID, 0, 0) . "\n";
    } elsif (!$four_byte_as && $agg =~ /^(\w\w\w\w)(\w\w\w\w\w\w\w\w)$/) { 
        $agg_AS_xx = $1;
        $agg_ID = $2;
        print "\tAGGREGATOR AS:\t(0x$agg_AS_xx)\t- " . hex2dec($agg_AS_xx) . "\n";
        print "\tAGGREGATOR ID:\t(0x$agg_ID)\t- " . hex2Address(0, 0, $agg_ID, 0, 0) . "\n";
    } else {
        print "\tAGGREGATOR:\t<span class='error'>ERROR - $agg does not look like the aggregator attribute</span>\n";
    }

    return 0;
}

sub parse_pmsi_tunnel {
    (my $pmsi, my $attr_length) = @_;

    $pmsi =~ /^(\w\w)(\w\w)(\w\w\w\w\w\w)(.*)/;
    my $flag = $1;
    my $tunnel_type_hex = $2;
    my $tunnel_type = hex2dec($2);
    my $mpls_label = $3;
    my $parameter = $4;

    my $parameter_len = $attr_length - 1 - 1 - 3;

    print "\n\tFlag:\t 0x" . $flag . "\n";
    $flag = hex2bin($flag, 1);
    print "\tFLAG binary:\t $flag\n";
    $flag =~ /(\d)(\d)(\d)(\d)(\d)(\d)(\d)(\d)/;

    if ($8 == 0) {
        print "\tBit 7, the Leaf Information Required bit, is 0\n";
    } else {
        print "\tBit 7, the Leaf Information Required bit, is 1\n";
    }

    print "\tTunnel type:\t ". $tunnel_type . " (0x" . $tunnel_type_hex . ") - ";
    if ($tunnel_type == 0) {
        print "No tunnel information present";
    } elsif ($tunnel_type == 1) {
        print "RSVP-TE P2MP LSP";
    } elsif ($tunnel_type == 2) {
        print "mLDP P2MP LSP";
    } elsif ($tunnel_type == 3) {
        print "PIM-SSM Tree";
    } elsif ($tunnel_type == 4) {
        print "PIM-SM Tree";
    } elsif ($tunnel_type == 5) {
        print "BIDIR-PIM Tree";
    } elsif ($tunnel_type == 6) {
        print "Ingress Replication";
    } elsif ($tunnel_type == 7) {
        print "mLDP MP2MP LSP";
    } else {
        print "Unknown";
    }
    print "\n";

    $mpls_label =~ /^(\w\w\w\w\w\w)(.*)/;
    $mpls_label = $1;
    my $data = $2;
    print hex2label($mpls_label);

    print "\tTunnel Parameters:\t ";
    while ($parameter ne "" && $parameter_len >= 2) {
        $parameter =~ /^(\w\w\w\w)(.*)/;
        print "0x" . $1 . " ";
        $parameter = $2;
        $parameter_len -= 2;
    }
    if ($parameter_len == 1) {
        $parameter =~ /^(\w\w)(.*)/;
        print "0x" . $1;
    }
    print "\n";

    return 0;
}

sub parse_pe_distinguisher_labels {
    (my $pe_distinguisher, my $attr_length) = @_;

    if ($attr_length%7 == 0) {
        # IPv4 PE Address

        while ($pe_distinguisher ne "") {

            $pe_distinguisher =~ /^(\w\w\w\w\w\w\w\w)(\w\w\w\w\w\w)(.*)/;
            my $ipaddr = hex2Address(0, 0, $1, 0, 0);
            my $mpls_label = $2;
            $pe_distinguisher = $3;

            print "\n\tPE Address:\t $ipaddr\t(0x$1)\n";

            $mpls_label =~ /^(\w\w\w\w\w\w)(.*)/;
            $mpls_label = $1;
            my $data = $2;

            print hex2label($mpls_label);
        }

    } elsif ($attr_length%19 == 0) {
        # IPv6 PE Address

        while ($pe_distinguisher ne "") {

            $pe_distinguisher =~ /^(\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w)(\w\w\w\w\w\w)(.*)/;
            my $ipaddr = hex2Address(2, 0, $1, 0, 0);
            my $mpls_label = $2;
            $pe_distinguisher = $3;

            print "\n\tPE Address:\t $ipaddr\t(0x$1)\n";

            $mpls_label =~ /^(\w\w\w\w\w\w)(.*)/;
            $mpls_label = $1;
            my $data = $2;
            print hex2label($mpls_label);
        }

    } else {
        print "Error: The attribute length is not multiple of 7 or 19";
    }
    return 0;
}

#
# parse_MP_reach_nlri
# - todo: need to fix this for VPNv4 vs IPv4
#
sub parse_MP_reach_nlri {
    (my $MPReachNLRI) = @_;

    $MPReachNLRI =~ /^(\w\w\w\w)(\w\w)(\w\w)(.*)/;
    my $afi = hex2dec($1);
    my $safi = hex2dec($2);
    my $length_of_next_hop = hex2dec($3);
    $MPReachNLRI = $4;
    my $next_hop = "";

    # AFI 1 - IPv4
    # AFI 2 - IPv6
    # AFI 25 - L2VPN

    # RFC 2858
    # SAFI 1 - Unicast
    # SAFI 2 - Multicast
    # SAFI 3 - Unicast and Multicast
    # SAFI 4 - Unicast carrying a label, RFC 3107
    # SAFI 5 - MVPN, RFC 6514
    # SAFI 65 - L2VPN VPLS BGP signaling, RFC 4761
    # SAFI 70 - E-VPN, draft-ietf-l2vpn-evpn-01
    # SAFI 128 - VPNs
    # SAFI 132 - RT Constraint
    print "\tAFI:\t\t$afi (0x$1)\n";
    print "\tSub AFI:\t$safi (0x$2)\n";
    print "\tNEXTHOP Length:\t$length_of_next_hop (0x$3) bytes\n";

    for (my $i = 0; $i < $length_of_next_hop; $i++) {
        $MPReachNLRI =~ /^(\w\w)(.*)/;
        $next_hop .= "$1";
        $MPReachNLRI = $2;
    }

    print "\tNEXTHOP:\t";
    if ($afi == 25 && $safi == 65) {
       print hex2Address(0, 0, $next_hop, 0, 0);
    } else {
       if ($length_of_next_hop == 16) {
          print hex2Address(2, 0, $next_hop, 0, 0);
       } else {
          print hex2Address($afi, $safi, $next_hop, 0, 0);
       }
    }
    print "\n";

    $MPReachNLRI =~ /^(\w\w)(.*)/;
    my $number_of_snpa = hex2dec($1);
    $MPReachNLRI = $2;
    print "\tNumb of SNPAs:\t$number_of_snpa (0x$1)\n";

    for (my $i = 0; $i < $number_of_snpa; $i++) {
        $MPReachNLRI =~ /(\w\w)(.*)/;
        my $snpa_length = hex2dec($1);
        my $snpa_value  = "";
        $MPReachNLRI     = $2;
        print "SNPA Length = $snpa_length (0x$1)\n";

        for (my $j = 0; $j < $snpa_length; $j++) {
            $MPReachNLRI =~ /^(\w\w)(.*)/;
            $snpa_value .= "$1";
            $MPReachNLRI = $2;
        }
        print "SNPA Value  = $snpa_value\n";
    }

    parse_mp_nlri($MPReachNLRI, "MP_REACH_NLRI", $afi, $safi);
    return 1;
}

#
# parse_MP_unreach_nlri
# - todo: need to fix this for VPNv4 vs IPv4
#
sub parse_MP_unreach_nlri {
    (my $MPUnreachNLRI) = @_;
    $MPUnreachNLRI =~ /(\w\w\w\w)(\w\w)(.*)/;
    my $afi = hex2dec($1);
    my $safi = hex2dec($2);
    my $withdraw_nlri = $3;
    print "\tAFI:\t\t$afi (0x$1)\n";
    print "\tSub AFI:\t$safi (0x$2)\n";

    parse_mp_nlri($withdraw_nlri, "MP_UNREACH_NLRI", $afi, $safi);
    return 1;
}

sub parse_mp_nlri {
    (my $data, my $data_type, my $afi, my $safi) = @_;

    while ($data ne "") {
        my $nlri_incr    = 0;
        my $nlri_length = 0;
        my $route_type = 1;

        # Length is different for VPLS
        if ($afi == 25 && $safi == 65) {

           # Length is in bytes (0x0011=17bytes) for RFC 4761
           # Lenght is in bits (0x60=96bits=12bytes) for RFC 6074
           #
           # cisco implementation, prefix-length is configurable,
           # either prefix-length is 1 or 2 octets
           $data =~ /^(\w\w)(\w\w)(.*)/;
           if ($1 == 0) {
              # prefix length is 2 octets
              $nlri_length = hex2dec($2);
              $data = $3;
           } else {
              # prefix length is 1 octet
              $nlri_length = hex2dec($1);
              $data = $2 . $3;
           }
           if ($nlri_length == 17 || $nlri_length == 12) {
              print "\n\tNLRI Length:\t$nlri_length bytes\t(0x$1)\n";
           }
           if ($nlri_length == 96) {
              print "\n\tNLRI Length:\t$nlri_length bits\t(0x$1)\n";
           }
           if ($nlri_length != 17 && $nlri_length != 96 &&
               $nlri_length != 12) {
              print "\n\tNLRI Length:\t$nlri_length\t(0x$1) - incorrect\n";
           }

        } elsif ($afi == 25 && $safi == 70) {

           # E-VPN
           $data =~ /^(\w\w)(\w\w)(.*)/;
           $route_type = hex2dec($1);
           $nlri_length = hex2dec($2);
           $data = $3;

           print "\tRoute type:\t$route_type\t(0x$1) - ";
           if ($route_type == 1) {
              print "Ethernet Auto-Discovery (A-D) route\n";
           } elsif ($route_type == 2) {
              print "MAC advertisement route\n";
           } elsif ($route_type == 3) {
              print "Inclusive Multicast Ethernet Tag Route\n";
           } elsif ($route_type == 4) {
              print "Ethernet Segment Route\n";
           } else {
              print "Unknown\n";
           }
           print "\tNLRI Length:\t$nlri_length bytes\t(0x$2)\n";

        } elsif ($safi == 5) {

           # MVPN
           $data =~ /^(\w\w)(\w\w)(.*)/;
           $data = $3;
           $route_type = hex2dec($1);
           $nlri_length = hex2dec($2);

           print "\tRoute type:\t $route_type\t(0x$1) - ";
           if ($route_type == 1) {
              print "Intra-AS I-PMSI A-D route\n";
           } elsif ($route_type == 2) {
              print "Inter-AS I-PMSI A-D route\n";
           } elsif ($route_type == 3) {
              print "S-PMSI A-D route\n";
           } elsif ($route_type == 4) {
              print "Leaf A-D route\n";
           } elsif ($route_type == 5) {
              print "Source Active A-D route\n";
           } elsif ($route_type == 6) {
              print "Shared Tree Join route\n";
           } elsif ($route_type == 7) {
              print "Source Tree Join route\n";
           } else {
              print "Unknown\n";
           }
           print "\tNLRI Length:\t$nlri_length bytes\t(0x$2)\n";
           
        } else {
           $data =~ /^(\w\w)(.*)/;
           $data = $2;
           $nlri_length = hex2dec($1);
           $nlri_length = hex2dec($1);
           print "\n\tNLRI Length:\t$nlri_length bits\t(0x$1)\n";

           if ($nlri_length%8 != 0) {
              $nlri_incr = (8 - $nlri_length%8);
           }
           if ($nlri_incr) {
               print "\tNLRI Increase:\t$nlri_incr\n";
           }
        }

        if ($nlri_length == 0) {
            print "\t<span class='error'>ERROR: NLRI length is 0</span>\n";
            print "\t<span class='error'>ERROR: data is $data</span>\n";
            return 1;
        }

        if ($safi == 4 || $safi == 128) {
            my $bottom_of_stack = 0;
            while ($bottom_of_stack == 0 && $nlri_length > 0) {
                $nlri_length -= 24;
                $data =~ /^(\w\w\w\w\w\w)(.*)/;
                my $mpls_label = $1;
                $data = $2;
                print hex2label($mpls_label);

                # routem doesn't set this correctly so hack the decoder
                $bottom_of_stack = 1;
            }
        }

        # If VPN subtract 64 for the RD
        my $mask = $nlri_length;
        if ($safi == 128) {
            $mask -= 64;
        }

        # VPLS is very different
        my $nlri = "";
        if ($afi == 25 && $safi == 65) {
           if ($nlri_length == 17) {
              for (my $k = 0; $k < $nlri_length; $k++) {
                 $data =~ /(\w\w)(.*)/;
                 $nlri .= $1;
                 $data = $2;
              }
              $nlri = hex2VPLS_Address($afi, $safi, $nlri);
           } elsif ($nlri_length == 96) {
              for (my $k = 0; $k < $nlri_length/8; $k++) {
                 $data =~ /(\w\w)(.*)/;
                 $nlri .= $1;
                 $data = $2;
              }
              $nlri = hex2VPLSRFC6074_Address($afi, $safi, $nlri);
           } elsif ($nlri_length == 12) {
              for (my $k = 0; $k < $nlri_length; $k++) {
                 $data =~ /(\w\w)(.*)/;
                 $nlri .= $1;
                 $data = $2;
              }
              $nlri = hex2VPLSRFC6074_Address($afi, $safi, $nlri);
           } else {
              print("\nError decoding L2VPN NLRI");
           }
        
        } elsif ($afi == 25 && $safi == 70) {

           # E-VPN, SAFI = 70
           if ($route_type == 1) {
              # Ethernet Auto-Discovery Route

              $data =~ /(\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w)(\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w)(\w\w\w\w\w\w\w\w)(\w\w\w\w\w\w)(.*)/;
              my $rd_str .= $1;
              my $esi = $2;
              my $etag = $3;
              my $mpls_label = $4;
              $data = $5;

              print "\t" . hex2RD(0, 0, $rd_str, 0, 0) . "\n";

              print "\tEthernet Segment Identifier = 0x$esi\n";

              print "\tEthernet Tag = ";
              print hex2dec($etag) . " (0x$etag)\n";

              print hex2label($mpls_label);

           } elsif ($route_type == 2) {
              # MAC Adverticiation Route
               
              $data =~ /(\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w)(\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w)(\w\w\w\w\w\w\w\w)(.*)/;
              my $rd_str .= $1;
              my $esi = $2;
              my $etag = $3;
              $data = $4;

              print "\t" . hex2RD(0, 0, $rd_str, 0, 0) . "\n";

              print "\tEthernet Segment Identifier = 0x$esi\n";

              print "\tEthernet Tag = ";
              print hex2dec($etag) . " (0x$etag)\n";

              $data =~ /(\w\w)(\w\w\w\w\w\w\w\w\w\w\w\w)(\w\w)(.*)/;
              my $mac_len .= $1;
              my $mac_str = $2;
              my $ip_len = $3;
              $data = $4;
              my $str;

              print "\tMAC Length = ";
              print hex2dec($mac_len) . " (0x$mac_len)\n";

              print "\tMAC = ";
              print "0x$mac_str\n";

              print "\tIP Address Length = ";
              print hex2dec($ip_len) . " (0x$ip_len)\n";
              if (hex2dec($ip_len) == 4) {
                  # IPv4 Group Address
                  $data =~ /(\w\w\w\w\w\w\w\w)(.*)/;
                  $str = $1;
                  $data = $2;
                  print "\tIP Address = ";
                  print hex2IP_Address(0, 0, $str, 0) . "\n";
              } elsif (hex2dec($ip_len) == 16) {
                  # IPv6 Source Address
                  $data =~ /(\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w)(.*)/;
                  $str = $1;
                  $data = $2;
                  print "\tIPv6 Address = ";
                  print hex2IP_Address(2, 0, $str, 0) . "\n";
              }

              while ($data =~ /^(\w\w\w\w\w\w)(.*)/) {
                  my $mpls_label = $1;
                  $data = $2;
                  print hex2label($mpls_label);
              }

           } elsif ($route_type == 3) {
              # Inclusive Multicast Ethernet Tag Route

              $data =~ /(\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w)(\w\w\w\w\w\w\w\w)(\w\w)(.*)/;
              my $rd_str .= $1;
              my $etag = $2;
              my $ip_len = $3;
              $data = $4;
              my $str;

              print "\t" . hex2RD(0, 0, $rd_str, 0, 0) . "\n";

              print "\tEthernet Tag = ";
              print hex2dec($etag) . " (0x$etag)\n";

              print "\tIP Address Length = ";
              print hex2dec($ip_len) . " (0x$ip_len)\n";
              if (hex2dec($ip_len) == 4) {
                  # IPv4 Group Address
                  $data =~ /(\w\w\w\w\w\w\w\w)(.*)/;
                  $str = $1;
                  $data = $2;
                  print "\tIP Address = ";
                  print hex2IP_Address(0, 0, $str, 0) . "\n";
              } elsif (hex2dec($ip_len) == 16) {
                  # IPv6 Source Address
                  $data =~ /(\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w)(.*)/;
                  $str = $1;
                  $data = $2;
                  print "\tIPv6 Address = ";
                  print hex2IP_Address(2, 0, $str, 0) . "\n";
              }

           } elsif ($route_type == 4) {
              # Ethernet Segment Route

              $data =~ /(\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w)(\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w)(.*)/;
              my $rd_str .= $1;
              my $esi = $2;

              $data = $4;

              print "\t" . hex2RD(0, 0, $rd_str, 0, 0) . "\n";

              print "\tEthernet Segment Identifier = 0x$esi\n";

              if ($data ne "") {
                  print "\tIncorrect: extra bytes, " . $data . "\n";
              }
           } else {
              # unknown
              print "\tUnknown route type: " . hex2dec($route_type) . "\n";
           }

        } elsif ($safi == 5) {
           # MVPN, RFC 6514

           if ($route_type == 1) {
              # Intra-AS (1) I-PMSI A-D route

              $data =~ /(\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w)(.*)/;
              my $str .= $1;
              $data = $2;
              print "\t" . hex2VPN_Address(0, 0, $str, 0, 0) . "\n";

           } elsif ($route_type == 2) {
              # Inter-AS (2) I-PMSI A-D route

              $data =~ /(\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w)(.*)/;
              my $str .= $1;
              $data = $2;
              print "\t" . hex2VPN_SourceAS(0, 0, $str, 0, 0) . "\n";

           } elsif ($route_type == 4) {
              # Leaf A-D, special

           } elsif ($route_type == 3 || $route_type == 5 ||
                    $route_type == 6 || $route_type == 7) {
              # S-PMSI A-D (3)
              # Source Active A-D (5)
              # Shared Tree Join (6)
              # Source Tree Join (7)

              $data =~ /(\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w)(.*)/;
              my $str .= $1;
              $data = $2;
              print "\t" . hex2RD(0, 0, $str, 0, 0);

              if ($route_type == 6 || $route_type == 7) {
                  $data =~ /(\w\w\w\w\w\w\w\w)(.*)/;
                  my $as_hex = $1;
                  my $as = hex2dec($as_hex);
                  $data = $2;
                  print "\n\tSource AS = $as (0x$as_hex)";
              }

              $data =~ /(\w\w)(.*)/;
              my $multicast_source_length = hex2dec($1);
              $data = $2;
              print "\n\tMulticast Source Length = $multicast_source_length (0x$1)";
              print "\n\tMulticast Source Address = ";

              if ($multicast_source_length == 32) {
                  # IPv4 Source Address
                  $data =~ /(\w\w\w\w\w\w\w\w)(.*)/;
                  $str = $1;
                  $data = $2;
                  print hex2IP_Address(0, 0, $str, 0);

              } elsif ($multicast_source_length == 128) {
                  # IPv6 Source Address
                  $data =~ /(\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w)(.*)/;
                  $str = $1;
                  $data = $2;
                  print hex2IP_Address(2, 0, $str, 0);
              }

              $data =~ /(\w\w)(.*)/;
              my $multicast_group_length = hex2dec($1);
              $data = $2;
              print "\n\tMulticast Group Length = $multicast_group_length (0x$1)";
              print "\n\tMulticast Group Address = ";

              if ($multicast_group_length == 32) {
                  # IPv4 Group Address
                  $data =~ /(\w\w\w\w\w\w\w\w)(.*)/;
                  $str = $1;
                  $data = $2;
                  print hex2IP_Address(0, 0, $str, 0);

              } elsif ($multicast_group_length == 128) {
                  # IPv6 Source Address
                  $data =~ /(\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w)(.*)/;
                  $str = $1;
                  $data = $2;
                  print hex2IP_Address(2, 0, $str, 0);
              }

              if ($route_type == 3) {
                  $data =~ /(\w\w\w\w\w\w\w\w)(.*)/;
                  $str = $1;
                  $data = $2;
                  print "\n\tOriginating Router IP Address = ";
                  print hex2IP_Address(0, 0, $str, 0);
              }

              print "\n";

           } else {
              # unknown
              $data =~ /(\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w)(.*)/;
              my $str .= $1;
              $data = $2;
              print "\t" . hex2VPN_Address(0, 0, $str, 0, 0) . "\n";
           }

        } else {
           for (my $k = 0; $k < (($nlri_length + $nlri_incr)/8); $k++) {
              $data =~ /(\w\w)(.*)/;
              $nlri .= $1;
              $data = $2;
           }

           my $orig_nlri = $nlri;
           $nlri = hex2Address($afi, $safi, $nlri, $mask, 0);
           #print "\t$data_type:\t $nlri\t(0x" . $orig_nlri . ")\n";
           print "\t$data_type:\t$nlri\n";
        }

    }

    return 1;
}

#
# parse_community
# - print out the communities in 32 bit and A:B notation
#
sub parse_community {
    (my $community) = @_;

    while ($community ne "") {
        $community =~ /^(\w\w\w\w)(\w\w\w\w)(.*)$/;
        $community = $3;
        my $tmpA = hex2dec($1);
        my $tmpB = hex2dec($2);
        my $tmpC = hex2dec("$1$2");
        print "\tCOMMUNITY:\t$tmpA:$tmpB ($1:$2) or $tmpC ($1$2)\n";
    }
    return 1;
}

#
# parse_extended_community
# - parse the extended communities
#
sub parse_extended_community {
    (my $extCommunity) = @_;

    while ($extCommunity ne "") {
        $extCommunity =~ /(\w\w)(\w\w)(\w\w\w\w\w\w\w\w\w\w\w\w)(.*)/;
        my $type_field_high = $1;
        my $type_field_low  = $2;
        my $value_field      = $3;
        $extCommunity         = $4;

        print "\tType Field = 0x" . $type_field_high . $type_field_low . "\n";

        $type_field_high = hex2dec($type_field_high);
        $type_field_low  = hex2dec($type_field_low);

        #
        # These are all defined here:
        # http://www.iana.org/assignments/bgp-extended-communities
        #

        if ($type_field_high == 0) {
            $value_field =~ /(\w\w\w\w)(\w\w\w\w\w\w\w\w)/;
            my $admin  = hex2dec($1);
            my $number = $2;
            print "\tAS Number = $admin (0x$1)\n";

            if ($type_field_low == 2) {
                $number = hex2dec($number);
                print "\tRoute Target = $number\n";

            } elsif ($type_field_low == 3) {
                $number = hex2dec($number);
                print "\tRoute Origin = $number\n";

            } elsif ($type_field_low == 4) {
                $number = hex2dec($number);
                print "\tLink BW = $number bytes per second\n";

            } elsif ($type_field_low == 5) {
                print "\tOSPF Domain ID (RFC 4577) = 0x$2\n";

            } elsif ($type_field_low == 8) {
                print "\tBGP Data Collection (RFC 4384) = 0x$2\n";

            } elsif ($type_field_low == 9) {
                $number =~ /(\w\w\w\w)(\w\w\w\w)/;
                my $source_as_xx = hex2dec($1);
                my $source_as_yy = hex2dec($2);
                print "\tSource AS = $source_as_xx.$source_as_yy (0x$1.0x$2)"; 

                # used to be draft-ietf-l3vpn-2547bis-mcast-bgp

            } elsif ($type_field_low == 10) {
                # L2VPN VPLS type 0x000A
                $number = hex2dec($number);
                print "\tAGI L2VPN ID = $number (0x$2)\n";

            } else {
                print "\tUnknown Extcommunity Value = 0x$2\n";
            }

        } elsif ($type_field_high == 1) {
            $value_field =~ /(\w\w\w\w\w\w\w\w)(\w\w\w\w)/;
            my $admin  = hex2Address(0, 0, $1, 0, 0);
            my $number = $2;

            print "\tIP Addr = $admin (0x$1)\n";
            if ($type_field_low == 2) {
                $number = hex2dec($number);
                print "\tRoute Target = $number\n";

            } elsif ($type_field_low == 3) {
                $number = hex2dec($number);
                print "\tRoute Origin = $number\n";

            } elsif ($type_field_low == 5) {
                print "\tOSPF Domain ID (RFC 4577) = 0x$2\n";

            } elsif ($type_field_low == 7) {
                print "\tOSPF Router ID (RFC 4577) = 0x$2\n";

            } elsif ($type_field_low == 10) {
                # L2VPN BGP AD type 0x010A
                # somehow overlapping with 2547bis-mcast-bgp
                print "\tAGI L2VPN ID = 0x$2\n";
                print "\tor\n";
                print "\tVRF Route Import = 0x$2 - draft-ietf-l3vpn-2547bis-mcast-bgp\n";

            } elsif ($type_field_low == 11) {
                # MVPN VRF Import ext community 0x010B
                $number = hex2dec($2);
                print "\tVRF Route Import (Local Administrator field) = $number (0x$2)\n";

            } else {
                print "\tUnknown Extcommunity Value = 0x$2\n";
            }

        } elsif ($type_field_high == 2) {
            if ($type_field_low == 9) {
                # 0x0209 is Source AS ext community for 4BAS
                $value_field =~ /(\w\w\w\w)(\w\w\w\w)(\w\w\w\w)/;
                my $admin1  = hex2dec($1);
                my $admin2  = hex2dec($2);
                my $number = hex2dec($3);
                print "\tSource AS = $admin1.$admin2 (0x$1.0x$2)\n";
                print "\tLocal Administrator field = $number (0x$3)\n";
            }

        } elsif ($type_field_high == 6) {
            # 0x060?, E-VPN extended community
            # http://www.iana.org/assignments/bgp-extended-communities/bgp-extended-communities.xml
            print "E-VPN ";
            if ($type_field_low == 0) {
                # MAC Mobility
                $value_field =~ /(\w\w\w\w)(\w\w\w\w\w\w\w\w)/;
                my $reserved = hex2dec($1);
                my $seq_num = hex2dec($2);

                print "\tMAC Mobility extended community\n";
                print "\tReserved = $reserved (0x$1)\n";
                print "\tSequence Number = $seq_num (0x$2)\n";

            } elsif ($type_field_low == 1) {
                # ESI MPLS Label
                $value_field =~ /(\w\w)(\w\w\w\w)(\w\w\w\w\w\w)/;
                my $flags = $1;
                my $reserved = hex2dec($2);
                my $mpls_label = $3;

                print "\tESI MPLS Label extended community\n";
                print "\tFlags = 0x$1\n";
                print "\tReserved = $reserved (0x$2)\n";
                print "\tESI MPLS Label = 0x$3\n";
                print hex2label($mpls_label);

            } elsif ($type_field_low == 2) {
                # ES Import
                $value_field =~ /(\w\w\w\w\w\w\w\w\w\w\w\w)/;
                print "\tES-Import extended community\n";
                print "\tES Import (MAC) = 0x$value_field\n";
            } else {
                # unknown
                print "\tUnknown extended community type\n";
            }

        } elsif ($type_field_high == 67) {
            if ($type_field_low == 1) {
                # Cost
                print "\tCost extended community\n";
                $value_field =~ /(\w\w)(\w\w\w\w)(\w\w\w\w\w\w)/;
                my $value1 = hex2dec($1);
                my $flags = $2;
                my $value2 = hex2dec($3);
                print "\tValue = 0x$value_field ($value1:$value2)\n";
            } else {
                # unknown
                print "\tUnknown extended community type\n";
            }

        } elsif ($type_field_high == 128) {
            if ($type_field_low == 10) {
                # L2VPN VPLS Layer2 Info Ext Community type 0x800A

                $value_field =~ /(\w\w)(\w\w)(\w\w\w\w)(\w\w\w\w)/;
                my $encap_type = $1;
                my $flags = $2;
                my $l2mtu = $3;
                my $reserved = $4;

                print "\tRFC 4761 Layer2 Info ext-community = 0x$value_field\n";
                print "\tEncap type = 0x$encap_type\n";
                print "\tFlags = 0x$flags\n";
                print "\tL2MTU = 0x$l2mtu\n";
                print "\tReserved = 0x$reserved\n";

            } else {
                print "\tUnknown Extcommunity Value = 0x$2\n";
            }

        } elsif ($type_field_high == 136) {
            if ($type_field_low == 0) {
                # EIGRP 0x8800
                print "\tEIGRP extended community\n";
                $value_field =~ /(\w\w)(\w\w\w\w)(\w\w\w\w\w\w)/;
                print "\tValue = 0x$value_field\n";
            } elsif ($type_field_low == 1) {
                # EIGRP 0x8801
                print "\tEIGRP extended community\n";
                $value_field =~ /(\w\w)(\w\w\w\w)(\w\w\w\w\w\w)/;
                print "\tValue = 0x$value_field\n";
            } elsif ($type_field_low == 2) {
                # EIGRP 0x8802
                print "\tEIGRP extended community\n";
                $value_field =~ /(\w\w)(\w\w\w\w)(\w\w\w\w\w\w)/;
                print "\tValue = 0x$value_field\n";
            } elsif ($type_field_low == 3) {
                # EIGRP 0x8803
                print "\tEIGRP extended community\n";
                $value_field =~ /(\w\w)(\w\w\w\w)(\w\w\w\w\w\w)/;
                print "\tValue = 0x$value_field\n";
            } else {
                print "\tUnknown Extcommunity Value = 0x$2\n";
            }

        } else {
            print "\tUnknown 'High' Type Field " . dec2hex($type_field_high) . "\n";
        }

        #print "\n";
    }
    return 1;
}

sub decode_AS_test {
    (my $as_path, my $test_4bytes) = @_;
    my $rc = 1;

    while ($as_path ne "" && $rc == 1) {
        $as_path =~ /^(\w\w)(\w\w)(.*)/;
        my $as_path_type       = hex2dec($1);
        my $as_path_seg_length = hex2dec($2);
        $as_path               = $3;

        if ($as_path_type != 1 &&
            $as_path_type != 2 &&
            $as_path_type != 3 &&
            $as_path_type != 4) {
            $rc = 0;
        }

        if ($as_path_seg_length == 0) {
            $rc = 0;
        }

        for (my $k = 0; $rc == 1 && $k < $as_path_seg_length && $as_path ne ""; $k++) {
            if ($test_4bytes) {
                if ($as_path =~ /(\w\w\w\w)(\w\w\w\w)(.*)/) {
                    $as_path = $3;
                } else {
                    $rc = 0;
                }
            } else {
                if ($as_path =~ /(\w\w\w\w)(.*)/) {
                    $as_path = $2;
                } else {
                    $rc = 0;
                }
            }
        }
    }

    return ($rc);
}

sub parse_AS_path {
    (my $as_path, my $attr_length, my $new_as_path) = @_;
    ##print "\n";

    my $four_byte_as;
    if ($new_as_path ||
        (!decode_AS_test($as_path, 0) &&
          decode_AS_test($as_path, 1))) {
        $four_byte_as = 1;
    } else {
        $four_byte_as = 0;
    }

    while ($as_path ne "") {
        $as_path =~ /^(\w\w)(\w\w)(.*)/;
        my $as_path_type       = hex2dec($1);
        my $as_path_seg_length = hex2dec($2);
        $as_path               = $3;
        $attr_length -= 2;

        if ($as_path_type == 1) {
            print "\n\tAS_PATH:\tType $as_path_type is AS_SET\n";
        } elsif ($as_path_type == 2) {
            print "\n\tAS_PATH:\tType $as_path_type is AS_SEQUENCE\n";
        } elsif ($as_path_type == 3) {
            print "\n\tAS_PATH:\tType $as_path_type is AS_CONFED_SEQUENCE\n";
        } elsif ($as_path_type == 4) {
            print "\n\tAS_PATH:\tType $as_path_type is AS_CONFED_SET\n";
        } else {
            print "\n\tAS_PATH:\t<span class='error'>ERROR: Type $as_path_type (0x$1) is INVALID</span>\n";
        }

        print "\tAS_PATH:\tSegment Length is $as_path_seg_length (0x$2) segments long\n";
        print "\tAS_PATH:\t";

        for (my $k = 0; $k < $as_path_seg_length && $as_path ne ""; $k++) {
            if ($four_byte_as) {
                $as_path =~ /(\w\w\w\w)(\w\w\w\w)(.*)/;
                $as_path = $3;
                my $as_xx = hex2dec($1);
                my $as_yy = hex2dec($2);
                print "$as_xx.$as_yy(0x$1.0x$2)  ";
            } else {
                $as_path =~ /(\w\w\w\w)(.*)/;
                $as_path = $2;
                my $tmp = hex2dec($1);
                print "$tmp (0x$1)  ";
            }
        }
        print "\n";
    }
}

sub parse_cluster_list {
    (my $cluster_list) = @_;

    while ($cluster_list =~ /^(\w\w\w\w\w\w\w\w)(.*)/) {
        my $tmp_string = $1;
        $cluster_list = $2;
        $tmp_string = hex2Address(0, 0, $tmp_string, 0, 0);
        print "\tCLUSTER ID:\t$tmp_string\n";
    }

    return 1;
}


# Functions that extract data from @message and does some type of print
# ---------------------------------------------------------------------

#
# get_message_chars
# - number of chars to get is passed to this function
# - chars are shifted off of @message and returned as a string
#
sub get_message_chars {
    (my $chars) = @_;
    my $return_string = "";

    if ($chars > $#message + 1) {
        #print "\n\n<span class='error'>ERROR: Requested to read $chars more characters but only " . $#message + 1 . " are available.</span>\n";
        printf( "\n\n\tERROR: Requested to read %d more characters but only %d are available.\n", $chars, $#message + 1);

        exit(0);
    }

    for (my $i = 0; $i < $chars; $i++) {
        $return_string .= "$message[$i]";
    }
    for (my $i = 0; $i < $chars; $i++) {
        shift @message;
    }

    return $return_string;
}

sub peek_message_chars {
   (my $chars) = @_;
   my $return_string = "";

    if ($chars > $#message + 1) {
        #print "\n\n<span class='error'>ERROR: Requested to read $chars more characters but only " . $#message + 1 . " are available.</span>\n";
        printf( "\n\n\tERROR: Requested to read %d more characters but only %d are available.\n", $chars, $#message + 1);
     
        exit(0);
    }

    for (my $i = 0; $i < $chars; $i++) {
        $return_string .= "$message[$i]";
    }

    return $return_string;

}


#
# Arg 1 - Chars to get
# Arg 2 - print string
#
sub print_hex {
    (my $chars_to_get, my $print_string) = @_;
    my $tmp_hex = get_message_chars($chars_to_get);
    print "$print_string" . "0x" . "$tmp_hex";

    return $tmp_hex;
}

#
# Arg 1 - Chars to get
# Arg 2 - print string
# Arg 3 - return decimal value - 0 is hex, 1 is decimal
#
sub print_hex_and_dec {
    (my $chars_to_get, my $print_string, my $return_type, my $unit) = @_;
    my $tmp_hex = get_message_chars($chars_to_get);
    my $tmp_dec = hex2dec($tmp_hex);
    print "$print_string" . "0x" . "$tmp_hex\t- $tmp_dec $unit\n";

    if ($return_type == 0) {
        return $tmp_hex;
    } elsif ($return_type == 1) {
        return $tmp_dec;
    }

    return 0;
}

#
# Arg 1 - Chars to get
# Arg 2 - print string
# Arg 3 - return decimal value - 0 is hex, 1 is ipv4
#
sub print_hex_and_ipv4 {
    (my $afi, my $safi, my $chars_to_get, my $print_string, my $return_type, my $unit) = @_;
    my $tmp_hex = get_message_chars($chars_to_get);
    my $tmp_ipv4 = hex2Address($afi, $safi, $tmp_hex, 0, 0);
    print "$print_string" . "0x" . "$tmp_hex\t- $tmp_ipv4$unit\n";

    if ($return_type == 0) {
        return $tmp_hex;
    } elsif ($return_type == 1) {
        return $tmp_ipv4;
    }

    return 0;
}

#
# Various conversion functions
#

sub string_length {
    (my $string) = @_;
    my $string_length = 0;

    while($string =~ /^\w(.*)/) {
        $string = $1;
        $string_length++;
    }

    return $string_length;    
}

sub dec2bin {
    my $a = unpack("B32", pack("N",shift));
    $a =~ s/^0+(?=\d)//;    # otherwise you'll get leading zeros
    # $a =~ /(\d\d\d\d\d\d\d\d)$/;
    # $a = $1;
    return $a;
}

sub bin2dec {
    return unpack("N", pack("B32", substr("0" x32 . shift, -32)));
}

sub dec2hex {
    (my $b) = @_;
    $b = sprintf "%1x", $b;
    return $b;
}

sub dec2hexpadded {
    (my $b, my $bytes) = @_;

    if ($bytes == 1) {
        $b = sprintf "%1x", $b;
        if ($b =~ /^\d$/) {
           $b = "0" . $b;
        }

    } elsif ($bytes == 2) {
        $b = sprintf "%1x", $b;

        if ($b =~ /^\d$/) {
           $b = "000" . $b;

        } elsif ($b =~ /^\d\d$/) {
           $b = "00" . $b;

        } elsif ($b =~ /^\d\d\d$/) {
           $b = "0" . $b;
        }

    } else {
        die("<span class='error'>ERROR: dec2hexpadded only support 1 or 2 bytes of padding</span>");
    }

    return $b;
}


sub hex2dec {
    (my $c) = @_;
    return hex($c);
}

sub bin2hex {
   (my $c) = @_;
   return dec2hex(bin2dec($c));
}

sub hex2label {
    (my $mpls_label) = @_;

    $mpls_label =~ /^(\w\w\w\w\w)(\w)(.*)/;
    my $label_hex = $1;
    my $label = $1 . $2;

    $label = hex2bin($label, 1);
    $label =~ /(.*)(\d\d\d)(\d)$/;
    $label = $1;
    my $exp_bits = $2;
    my $b_of_stack = $3;

    return "\tLABEL:\t\t" . bin2dec($label) . "\t\t(0x" . $label_hex . ")\n" .
           "\tLABEL Exp:\t$exp_bits\t\t(0x" . bin2hex($exp_bits) . ")\n" .
           "\tLABEL BSB:\t$b_of_stack\t\t(0x" . bin2hex($b_of_stack) . ")\n";
}

sub hex2bin () {
    (my $hex_string, my $include_leading_zeros) = @_;
    my $hex_string_length = string_length($hex_string);
    my $tmp = hex2dec($hex_string);
    my $bin_string = dec2bin($tmp);
    my $bin_string_length = string_length($bin_string);
    my $bin_string_length_required = 4 * $hex_string_length;

    while ($include_leading_zeros == 1 && ($bin_string_length < $bin_string_length_required)) {
        $bin_string = "0" . $bin_string;
        $bin_string_length++;
    } 

    return $bin_string;
}

sub hex2CLNS_Address {
     (my $str) = @_;
     my $addr = "";
     my $partA = "";
     my $partB = "";
     my $partC = "";

     if ($str =~ /(\w\w)(\w\w\w\w)(.*)(\w\w)/) {
        $partA = $1;
        $partB = $2;
        $str   = $3;
        $partC = $4;
     }
     $addr = $partA . "." . $partB . ".";
     while ($str =~ /^(\w\w\w\w)(.*)/) {
        $addr .= $1 . ".";
        $str = $2;
     }

     $addr .= $partC;

     return $addr;
}

sub hex2Address {
     (my $afi, my $safi, my $str, my $mask, my $rd_type) = @_;

     #
     # CLNS
     #
     if ($afi == 3) {
         return hex2CLNS_Address($str, $mask);

     # L2VPN
     } elsif ($afi == 25) {
         if ($safi == 65) {
            return hex2VPLSRFC6074_Address($afi, $safi, $str);
         } elsif ($safi == 70) {
            # E-VPN
            return hex2IP_Address($afi, $safi, $str, $mask);
         } else {
            print "<span class='error'>\tERROR: $afi/$safi is not supported by the decoder yet</span>\n";
         }

     #
     # IPv4 or IPv6
     #
     } else {
        if ($safi == 128) {
            return hex2VPN_Address($afi, $safi, $str, $mask, $rd_type);
        } else {
            return hex2IP_Address($afi, $safi, $str, $mask);
        }
    }
}

sub hex2VPLS_Address {
   (my $afi, my $safi, my $str) = @_;
   $str =~ /(\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w)(\w\w\w\w)(\w\w\w\w)(\w\w\w\w)(\w\w\w\w\w)(\w)(.*)/;
   my $vpls_rd           = $1;
   my $ve_id             = $2;
   my $vbo               = $3;
   my $vbs               = $4;
   my $lb1               = $5;
   my $lb2               = $6;
   my $dummy             = $7;

# scheung
   print "\tVPLS " . hex2VPN_Address($afi, $safi, $vpls_rd, 0, 0) . "\n";
   my $tmp_dec = hex2dec($ve_id);
   print "\tVPLS VE ID:\t" . "0x" . "$ve_id\t- $tmp_dec\n";
   $tmp_dec = hex2dec($vbo);
   print "\tVPLS VBO:\t" . "0x" . "$vbo\t- $tmp_dec\n";
   $tmp_dec = hex2dec($vbs);
   print "\tVPLS VBS:\t" . "0x" . "$vbs\t- $tmp_dec\n";

   $tmp_dec = hex2dec($lb1);
   print "\tVPLS LB:\t" . "0x" . "$lb1\t- $tmp_dec\n";
   print "\tVPLS LB Exp BSB:\t" . "0x" . "$lb2\n";
}

sub hex2VPLSRFC6074_Address {
   (my $afi, my $safi, my $str) = @_;
   $str =~ /(\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w\w)(\w\w\w\w\w\w\w\w)/;
   my $vpls_rd           = $1;
   my $vpls_router_id    = $2;
   print "\tVPLS " . hex2VPN_Address($afi, $safi, $vpls_rd, 0, 0) . "\n";
   print "\tVPLS Router ID: " . hex2IP_Address(0, 0, $vpls_router_id) . "(0x$vpls_router_id)\n";
}

sub hex2IP_Address {
     (my $afi, my $safi, my $str, my $mask) = @_;

     my $addr = "";
     my $one;
     my $two;
     my $three;
     my $four;

     if ($afi == 2) {

         # todo - fix this IPv6 parser problem
         my $tmp_str = $str;
         while ($tmp_str ne "") {
             if ($addr =~ /\w\w\w\w$/) {
                 $addr .= ":";
             }

             if ($tmp_str =~ /^(\w\w\w\w)(.*)/) {
                 $addr .= $1;
                 $tmp_str = $2;
             } elsif ($tmp_str =~ /^(\w+)/) {
                 $addr .= $1;
                 $tmp_str = "";
             }
         }

         # 0000:0000:0000:0000:0000:FFFF:C371:9C04 
         # 2001:0db8:85a3:0000:1319:8a2e:0370:7344
         if ($addr !~ /^\w\w\w\w:\w\w\w\w:\w\w\w\w:\w\w\w\w:\w\w\w\w:\w\w\w\w:\w\w\w\w:\w\w\w\w$/)  {
             $addr .= "::";
         }

         if ($mask) {
             $addr .= "/$mask";
         }

     } else {
         if ($str =~ /^(\w?\w?)(\w?\w?)(\w?\w?)(\w?\w?)$/)  {
             if ($1 eq "") { $one = "00" }    else { $one    = $1 }
             if ($2 eq "") { $two = "00" }    else { $two    = $2 }
             if ($3 eq "") { $three = "00" } else { $three = $3 }
             if ($4 eq "") { $four = "00" }  else { $four  = $4 }
             $addr  = hex2dec($one) . "." . hex2dec($two) . "." . hex2dec($three) . "." . hex2dec($four);

             if ($mask) {
                 $addr .= "/$mask";
             }
         } else {
             print "\tERROR: '$str' does not look like an IPv4 prefix\n";
         }
     }

     return $addr;
}

sub hex2RD {
    (my $afi, my $safi, my $str, my $mask, my $rd_type) = @_;

    my $rd_type_hex;
    my $rd1;
    my $rd1_hex;
    my $rd2;
    my $rd2_hex;

    $str =~ /(\w\w\w\w)(.*)/;
    $rd_type_hex = $1;
    $rd_type = hex2dec($1);
    $str = $2;
      
    if ($rd_type == 0) {
        $str =~ /(\w\w\w\w)(\w\w\w\w\w\w\w\w)(.*)/;
        $rd1_hex = $1;
        $rd1 = hex2dec($1);
        $rd2_hex = $2;
        $rd2 = hex2dec($2);
    } elsif ($rd_type == 1) {
        $str =~ /(\w\w\w\w\w\w\w\w)(\w\w\w\w)(.*)/;
        $rd1_hex = $1;
        $rd1 = hex2IP_Address($afi, $safi, $1, 0);
        $rd2_hex = $2;
        $rd2 = hex2dec($2);
    } elsif ($rd_type == 2) {
        $str =~ /(\w\w\w\w\w\w\w\w)(\w\w\w\w)(.*)/;
        $rd1_hex = $1;
        $rd1 = hex2dec($1);
        $rd2_hex = $2;
        $rd2 = hex2dec($2);
    }

    return "RD: $rd1:$rd2 (0x$rd_type_hex - 0x$rd1_hex:0x$rd2_hex)";
}

sub hex2VPN_Address {
    (my $afi, my $safi, my $str, my $mask, my $rd_type) = @_;

    my $rd;
    my $ip;
    my $ip_hex;
    while ($str !~ /(\w\w\w\w\w\w\w\w)(\w\w\w\w\w\w\w\w)(\w\w\w\w\w\w\w\w)/) {
        $str .= "0";
    }

    $str =~ /(\w\w\w\w)(\w\w\w\w\w\w\w\w\w\w\w\w)(\w\w\w\w\w\w\w\w)/;
    $rd = $1 . $2;
    $ip_hex = $3;
    $ip = hex2IP_Address($afi, $safi, $3, $mask);

    return hex2RD($afi, $safi, $rd, $mask, $rd_type) . "\n\t\t\tIP: $ip (0x$ip_hex)";
}

sub hex2VPN_SourceAS {
    (my $afi, my $safi, my $str, my $mask, my $rd_type) = @_;

    my $rd;
    my $as;
    my $as_hex;
    while ($str !~ /(\w\w\w\w\w\w\w\w)(\w\w\w\w\w\w\w\w)(\w\w\w\w\w\w\w\w)/) {
        $str .= "0";
    }

    $str =~ /(\w\w\w\w)(\w\w\w\w\w\w\w\w\w\w\w\w)(\w\w\w\w\w\w\w\w)/;
    $rd = $1 . $2;
    $as_hex = $3;
    $as = hex2dec($3);

    return hex2RD($afi, $safi, $rd, $mask, $rd_type) . 
        " - Source AS: $as (0x$as_hex)";
}

sub remove_Xtra_spaces() {
    (my $foo) = @_;
    chomp($foo);
    $foo =~ tr/\t//s;
    $foo =~ s/\t//g;
    $foo =~ tr/ / /s;
    $foo =~ s/ //g;


    while ($foo =~ /^\s/) {
        $foo =~ s/^\s//;
    }

    while ($foo =~ /\s$/) {
        $foo =~ s/\s$//;
    }

    return $foo;
}