view release on metacpan or  search on metacpan

lib/Parse/Syslog/Line.pm  view on Meta::CPAN

    }

    #
    # Host Information:
    if( $raw_string =~ s/^$RE{host}//o ) {
        my $hostStr = $1;
        my($ip) = ($hostStr =~ /($RE{IPv4})/o);
        if( defined $ip && length $ip ) {
            $msg{host_raw} = $hostStr;
            $msg{host} = $ip;
        }
        elsif( length $hostStr ) {
            my ($host,$domain) = split /\./, $hostStr, 2;
            $msg{host_raw} = $hostStr;
            $msg{host} = $host;
            $msg{domain} = $domain;
        }
    }
    # Check for relayed logs, grab the origin
    while( $raw_string =~ /^(?:\s*[0-9]+\s+)?$RE{date_iso8601}\s+$RE{host}/go ) {
        $msg{origin} = $2;
        $msg{origin_date} = $1;
        $raw_string = substr($raw_string,pos($raw_string));
    }

    # Find weird cisco dates
    if( $raw_string =~ s/^$RE{cisco_detection}//o ) {
        # Yes, Cisco adds a second timestamp to it's messages, because ...
        if( $raw_string =~ s/^$RE{date_long}//o ) {
            # Cisco encodes the status of NTP in the second datestamp, so let's pass it back
            if ( my $ntp = $1 ) {
                $msg{ntp} = $ntp eq '.' ? 'out of sync'
                          : $ntp eq '*' ? 'not configured'
                          : 'unknown';
            }
            else {
                $msg{ntp} = 'ok';
            }
        }
    }

    #
    # Parse the Program portion
    my $progsep = ':';
    if( $ExtractProgram ) {
        if( $raw_string =~ s/^$RE{program_raw}//o ) {
            $msg{program_raw} = $1;
            $progsep = $2 || '';
            my $progStr = join ' ', grep {!exists $INT_PRIORITY{$_}} split /\s+/, $msg{program_raw};
            if( $progStr =~ /^$RE{program_name}/o ) {
                $msg{program_name} = $1;
                my $remainder      = $2;
                if ( $remainder ) {
                    ($msg{program_pid}) = ($remainder =~ /$RE{program_pid}/o);
                    ($msg{program_sub}) = ($remainder =~ /$RE{program_sub}/o);
                    if( !$msg{program_sub}  ) {
                        ($msg{program_sub}) = ($remainder =~ /^(?:[\/\s])?([^\[(]+)/o);
                    }
                }
                if( $msg{program_name} !~ m{^/} && $msg{program_name} =~ tr{/}{} ) {
                    @msg{qw(program_name program_sub)} = split m{/}, $msg{program_name}, 2;
                }
            }
        }
        elsif( $raw_string =~ s/$RE{program_netapp}//o ) {
            # Check for a [host thing.subthing:level]: tag
            #          or [host:thing.subthing:level]: tag, Thanks NetApp.
            my $subStr = $1;
            $msg{program_raw} = qq{[$subStr]};
            my ($host,$program,$level) = split /[: ]+/, $subStr;
            $msg{program_name} = $program;
            if(!exists $msg{priority} && exists $LOG_PRIORITY{$level}) {
                $msg{priority} = $level;
                $msg{priority_int} = $LOG_PRIORITY{$level};
            }
            $raw_string =~ s/^[ :]+//;
        }
    }
    else {
        $raw_string =~ s/^\s+//;
    }

    # The left overs should be the message
    $msg{content} = $raw_string;
    chomp $msg{content};
    $msg{message} = defined $msg{program_raw} ? "$msg{program_raw}$progsep $msg{content}" : $msg{content};

    # Extract RFC Structured Data
    if( $RFC5424StructuredDataStrict ) {
        while ( $msg{content} =~ s/$RE{rfc_sdata_strict}//o ) {
            my $rfc_sdata = $1;
            my ($sdid,$sdata) = split /\s+/, $rfc_sdata, 2;
            foreach my $token ( $sdata =~ /($RE{sysword}=$RE{quotedstring})/og ) {
                my ($k,$v) = split /=/, $token, 2;
                next unless length $v;
                # Trim off the quotes
                $v = substr($v, 1, length($v) - 2);
                $msg{SDATA}{$sdid}{$k} = $v;
            }
        }
        $msg{content} =~ s/^\s+//;
    }
    elsif ( $RFC5424StructuredData ) {
        while ( $msg{content} =~ s/$RE{rfc_sdata_extract}//o ) {
            my $rfc_sdata = $1;
            my ($group) = $rfc_sdata =~ s/^([^\s=]+)\s// ? $1 : undef;
            foreach my $token ( $rfc_sdata =~ /($RE{sysword}=(?:$RE{quotedstring}|\S+))/og ) {
                my ($k,$v) = split /=/, $token, 2;
                next unless length $v;
                # Trim off the quotes
                $v =~ s/(?:^")|(?:"$)//g;
                if( $group ) {
                    $msg{SDATA}{$group}{$k} = $v;
                } else {
                    $msg{SDATA}{$k} = $v;
                }
            }
            # When we parse without ExtractProgram, shit gets weird.
            #   We need to restore the first space between the first semi-colon
            #   and the rest of the string
            $msg{content} =~ s/:\s*/: / if $msg{SDATA};