File Coverage

blib/lib/Parse/Netstat/freebsd.pm

Criterion	Covered	Total	%
statement	37	37	100.0
branch	16	20	80.0
condition	12	15	80.0
subroutine	5	5	100.0
pod	1	1	100.0
total	71	78	91.0

package Parse::Netstat::freebsd;

use 5.010001;
use strict;
use warnings;

use Exporter 'import';

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2022-12-04'; # DATE
our $DIST = 'Parse-Netstat'; # DIST
our $VERSION = '0.150'; # VERSION

our @EXPORT_OK = qw(parse_netstat);

our %SPEC;

$SPEC{parse_netstat} = {
    v => 1.1,
    summary => 'Parse the output of FreeBSD "netstat" command',
    description => <<'_',

Netstat can be called with `-n` (show raw IP addresses and port numbers instead
of hostnames or port names) or without. It can be called with `-a` (show all
listening and non-listening socket) option or without.

Tested with FreeBSD 10.1's netstat.

_
    args => {
        output => {
            summary => 'Output of netstat command',
            schema => 'str*',
            req => 1,
        },
        tcp => {
            summary => 'Whether to parse TCP (and TCP6) connections',
            schema  => [bool => default => 1],
        },
        udp => {
            summary => 'Whether to parse UDP (and UDP6) connections',
            schema  => [bool => default => 1],
        },
        unix => {
            summary => 'Whether to parse Unix socket connections',
            schema  => [bool => default => 1],
        },
    },
};
sub parse_netstat {
    my %args = @_;
    my $output = $args{output} or return [400, "Please specify output"];
    my $tcp    = $args{tcp} // 1;
    my $udp    = $args{udp} // 1;
    my $unix   = $args{unix} // 1;

    my $in_unix;
    my $in_unix_header;
    my @conns;
    my $i = 0;
    for my $line (split /^/, $output) {
        $i++;
        my %k;
        if ($line =~ /^Registered kernel control modules/) {
            $in_unix = 0;
        } elsif ($line =~ /^tcp/ && $tcp) {
            #Proto Recv-Q Send-Q Local Address               Foreign Address             State       PID/Program name
            #tcp4       0      0 192.168.1.33.632       192.168.1.10.2049      CLOSED
            $line =~ m!^(?Ptcp(?:4|6|46)?) \s+ (?P\d+) \s+ (?P\d+)\s+
                       (?P\S+?)[:.](?P\w+)\s+
                       (?P\S+?)[:.](?P\w+|\*)\s+
                       (?P\S+) (?: \s+ (?:
                               (?P\d+)/(?P.+?) |
                               -
                       ))? \s*$!x
                           or return [400, "Can't parse tcp line (#$i): $line"];
            %k = %+;
        } elsif ($line =~ /^udp/ && $udp) {
            #Proto Recv-Q Send-Q Local Address          Foreign Address        (state)
            #udp4       0      0 *.879                  *.*
            $line =~ m!^(?Pudp(?:4|6|46)?) \s+ (?P\d+) \s+ (?P\d+) \s+
                       (?P\S+?)[:.](?P\w+|\*)\s+
                       (?P\S+?)[:.](?P\w+|\*)
                       (?: \s+
                           (?P\S+)?
                           (?: \s+ (?:
                                   (?P\d+)/(?P.+?) |
                                   -
                           ))?
                       )? \s*$!x
                           or return [400, "Can't parse udp line (#$i): $line"];
            %k = %+;
        } elsif ($in_unix && $unix) {
            #Address  Type   Recv-Q Send-Q    Inode     Conn     Refs  Nextref Addr
            #fffffe00029912d0 stream      0      0 fffffe0002d8abd0        0        0        0 /tmp/ssh-zwZwlpzaip/agent.1089
            $line =~ m!^(?P\S+) \s+ (?P\S+) \s+
                       (?P\d+) \s+ (?P\d+) \s+ (?P[0-9a-f]+) \s+ (?P[0-9a-f]+) \s+
                       (?P[0-9a-f]+) \s+ (?P[0-9a-f]+)
                       (?:
                           \s+
                           (?P.+)
                       )?
                       \s*$!x
                           or return [400, "Can't parse unix/freebsd line (#$i): $line"];
            %k = %+;
            $k{proto} = 'unix';
        } elsif ($in_unix_header) {
            $in_unix_header = 0;
            $in_unix++;
        } elsif ($line =~ /^Active (UNIX|LOCAL \(UNIX\)) domain sockets/) {
            $in_unix_header++;
        } else {
            next;
        }
        push @conns, \%k;
    }

    [200, "OK", {active_conns => \@conns}];
}

1;
# ABSTRACT: Parse the output of FreeBSD "netstat" command

__END__