File Coverage

blib/lib/Parse/Netstat/linux.pm

Criterion	Covered	Total	%
statement	35	35	100.0
branch	10	14	71.4
condition	12	15	80.0
subroutine	6	6	100.0
pod	1	1	100.0
total	64	71	90.1

package Parse::Netstat::linux;

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 Linux "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. And can be called with
`-p` (show PID/program names) or without.

_
    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 =~ /^tcp/ && $tcp) {
            #Proto Recv-Q Send-Q Local Address               Foreign Address             State       PID/Program name
            #tcp        0      0 0.0.0.0:8898                0.0.0.0:*                   LISTEN      5566/daemon2.pl [pa
            $line =~ m!^(?Ptcp[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) {
            #udp        0      0 0.0.0.0:631                 0.0.0.0:*                               2769/cupsd
            $line =~ m!^(?Pudp[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 ($line =~ /^unix/ && $unix) {
            #Proto RefCnt Flags       Type       State         I-Node PID/Program name    Path
            #    unix  2      [ ACC ]     STREAM     LISTENING     650654 30463/gconfd-2      /tmp/orbit-t1/linc-76ff-0-3fc1dd3f2f2
            $line =~ m!^(?Punix) \s+ (?P\d+) \s+
                       \[\s*(?P\S*)\s*\] \s+ (?P\S+) \s+
                       (?P\S+|\s+) \s+ (?P\d+) \s+
                       (?: (?: (?P\d+)/(?P.+?) | - ) \s+)?
                       (?P.*?)\s*$!x
                           or return [400, "Can't parse unix line (#$i): $line"];
            %k = %+;
        } else {
            next;
        }
        push @conns, \%k;
    }

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

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

__END__