view release on metacpan or  search on metacpan

lib/App/RouterColorizer.pm  view on Meta::CPAN

our $STP_TYPES = qr/designated|root|alternate|Desg|Root|Altn/;

our $TTY_TYPES = qr/AUX|CTY|LPR|TTY|VTY/;

our @bgcolors = (
    "\e[30m\e[47m",    # black on white
    "\e[30m\e[41m",    # black on red
    "\e[30m\e[42m",    # black on green
    "\e[30m\e[43m",    # black on yellow (orange)
    "\e[37m\e[44m",    # white on blue
    "\e[30m\e[45m",    # black on magenta
    "\e[30m\e[46m",    # black on cyan
);

sub format_text ( $self, $text ) {
    # Remove Arista "more" prompt
    $text =~ s/ \x1b \[ \Q3m --More-- \E \x1b \[ 23m \x1b \[ K \r \x1b \[ K //gmsxx;

    # Break into lines
    my $output = '';
    while ( $text =~ m/([^\n\r]*[\r]?[\n]?)/g ) {
        $output .= $self->_parse_line($1);
    }
    return $output;
}

sub _parse_line ( $self, $text ) {
    my ( $line, $eol ) = $text =~ m/([^\n]*)(\n?)/;

    # We want to strip out the control characters at the start of the
    # line. This is kind of black magic...
    my $preamble = '';
    if ( $line =~ s/^ ( .* (?<! \x1b \[23m) \x1b (?: \[K | M)) //sxx ) {
        $preamble = $1;
    }

    # Arista "More" prompt (should this be in the Arista parse-line?)
    $line =~ s/ ^ ( \x1b \[ \Q3m --More-- \E .* \x0d \x1b \[K )//sxx;

    # A space that is backspaced over
    $line =~ s/ \Q \E \x08 //gxx;

    my $trailer = "";
    if ( $line =~ s/(\x0d) $//sxx ) {
        $trailer = $1;
    }

    $line = $self->_parse_line_arista($line);
    $line = $self->_parse_line_vyos($line);
    $line = $self->_parse_line_junos($line);
    $line = $self->_parse_line_ciena($line);

    # IPv4
    $line =~ s/($IPV4CIDR)/$self->_ipv4ify($1)/egxx;

    # IPv6
    $line =~ s/ ( (?<! [a-fA-F0-9:\-]) $IPV6CIDR (?! [\w:\.\/]) ) /$self->_ipv6ify($1)/egxx;

    # Numbers
    # We need to make sure we don't highlight undesirably, such as in an
    # escape sequence.
    $line =~ s/ (
                    (?<! [:\.0-9]) (?<! \e \[) (?<! \e \[\?)
                    [0-9]+ (?! [:0-9])
                ) /$self->_numerify($1)/egxx;

    return "$preamble$line$trailer$eol";
}

sub _parse_line_arista ( $self, $line ) {
    #
    # Arista & Cisco
    #

    # BGP
    $line =~ s/^ ( \Q  BGP state is Established\E \N* ) $/$self->_colorize($1, $GREEN)/exx;
    $line =~ s/^ ( \Q  BGP state is \E            \N* ) $/$self->_colorize($1, $RED)/exx;

    $line =~
s/^ ( \Q  Last \E (?: sent || rcvd) \  (?: socket-error || notification) : \N+ ) $/$self->_colorize($1, $INFO)/exx;

    $line =~
      s/^ ( \ \ (?: Inbound || Outbound) \Q route map is \E \N* )$/$self->_colorize($1, $INFO)/exx;
    $line =~
s/^ ( \Q  Inherits configuration from and member of peer-group \E \N+ ) $/$self->_colorize($1, $INFO)/exx;

    $line =~
      s/^ ( \Q    \E (?: IPv4 | IPv6) \Q Unicast:     \E \N* ) $/$self->_colorize($1, $INFO)/exx;
    $line =~
s/^ ( \Q  Configured maximum total number of routes is \E \d+ (?: \Q, warning limit is \E \d+ )? ) $/$self->_colorize($1, $INFO)/exx;

    # BGP Errors
    my $errors = qr/
        ^
        \Q    \E
        (?:
            \QAS path loop detection\E
            | \QEnforced First AS\E
            | \QMalformed MPBGP routes\E
            | \QAS path loop detection\E
            | \QOriginator ID matches local router ID\E
            | \QNexthop matches local IP address\E
            | \QResulting in removal of all paths in update (treat as withdraw)\E
            | \QResulting in AFI\E \/ \QSAFI disable\E
            | \QResulting in attribute ignore\E
            | \QDisabled AFI\E \/ \QSAFIs\E
            | \QIPv4 labeled-unicast NLRIs dropped due to excessive labels\E
            | \QIPv6 labeled-unicast NLRIs dropped due to excessive labels\E
            | \QIPv4 local address not available\E
            | \QIPv6 local address not available\E
            | \QUnexpected IPv6 nexthop for IPv4 routes\E
        )
        \Q: \E
        $POSINT
        $
    /xx;
    $line =~ s/($errors)/$self->_colorize($1, $RED)/e;

    $line =~ s/^ ( \QBGP neighbor is \E \N+ ) $/$self->_colorize($1, $INFO)/exx;
    $line =~ s/^ ( (?: Local | Remote) \Q TCP address is \E \N+ ) $/$self->_colorize($1, $INFO)/exx;