File Coverage

blib/lib/Parse/Netstat/solaris.pm
Criterion Covered Total %
statement 46 46 100.0
branch 31 36 86.1
condition 12 15 80.0
subroutine 5 5 100.0
pod 1 1 100.0
total 95 103 92.2


line stmt bran cond sub pod time code
1             package Parse::Netstat::solaris;
2              
3 1     1   24 use 5.010001;
  1         2  
4 1     1   3 use strict;
  1         1  
  1         21  
5 1     1   3 use warnings;
  1         1  
  1         24  
6              
7 1     1   3 use Exporter;
  1         1  
  1         717  
8             our @ISA = qw(Exporter);
9             our @EXPORT_OK = qw(parse_netstat);
10              
11             our $VERSION = '0.13'; # VERSION
12              
13             our %SPEC;
14              
15             $SPEC{parse_netstat} = {
16             v => 1.1,
17             summary => 'Parse the output of Solaris "netstat" command',
18             description => <<'_',
19              
20             Netstat can be called with `-n` (show raw IP addresses and port numbers instead
21             of hostnames or port names) or without. It can be called with `-a` (show all
22             listening and non-listening socket) option or without.
23              
24             _
25             args => {
26             output => {
27             summary => 'Output of netstat command',
28             schema => 'str*',
29             req => 1,
30             },
31             tcp => {
32             summary => 'Whether to parse TCP (and TCP6) connections',
33             schema => [bool => default => 1],
34             },
35             udp => {
36             summary => 'Whether to parse UDP (and UDP6) connections',
37             schema => [bool => default => 1],
38             },
39             unix => {
40             summary => 'Whether to parse Unix socket connections',
41             schema => [bool => default => 1],
42             },
43             },
44             };
45             sub parse_netstat {
46 4     4 1 9 my %args = @_;
47 4 50       9 my $output = $args{output} or return [400, "Please specify output"];
48 4   50     6 my $tcp = $args{tcp} // 1;
49 4   50     6 my $udp = $args{udp} // 1;
50 4   50     7 my $unix = $args{unix} // 1;
51              
52 4         2 my $proto = '';
53 4         4 my @conns;
54 4         4 my $i = 0;
55 4         61 for my $line (split /^/, $output) {
56 124         67 $i++;
57 124         68 my %k;
58 124 100 100     585 if ($line =~ /^UDP: IPv([46])/) {
    100 100        
    100 100        
    100          
    100          
    100          
59 4         10 $proto = "udp$1";
60             } elsif ($line =~ /^TCP: IPv([46])/) {
61 4         6 $proto = "tcp$1";
62             } elsif ($line =~ /^Active UNIX domain sockets/) {
63 4         3 $proto = "unix";
64             } elsif ($proto =~ /udp/ && $udp) {
65             #UDP: IPv4
66             # Local Address Remote Address State
67             #-------------------- -------------------- ----------
68             #8.8.17.4.15934 8.8.7.7.53 Connected
69 18 100       40 $line =~ /^\s*$/ and next; # blank line
70 15 100       21 $line =~ /^\s+/ and next; # header
71 12 100       36 $line =~ /^[- ]+$/ and next; # separator
72 9 50       45 $line =~ m!^(?P\S+?)\.(?P\w+)\s+
73             (?P\S+?)\.(?P\w+|\*)\s+
74             (?P\S+)
75             \s*$!x
76             or return [400, "Can't parse udp line (#$i): $line"];
77 9         97 %k = %+;
78 9         21 $k{proto} = $proto;
79             } elsif ($proto =~ /tcp/ && $tcp) {
80             #TCP: IPv4
81             # Local Address Remote Address Swind Send-Q Rwind Recv-Q State
82             #-------------------- -------------------- ----- ------ ----- ------ -----------
83             #8.8.17.4.1337 8.8.213.120.65472 262140 0 1049920 0 ESTABLISHED
84 27 100       56 $line =~ /^\s*$/ and next; # blank line
85 24 100       33 $line =~ /^\s+/ and next; # header
86 21 100       43 $line =~ /^[- ]+$/ and next; # separator
87 18 50       87 $line =~ m!^(?P\S+?)\.(?P\w+)\s+
88             (?P\S+?)\.(?P\w+|\*)\s+
89             (?P\d+) \s+
90             (?P\d+) \s+
91             (?P\d+) \s+
92             (?P\d+) \s+
93             (?P\S+)
94             \s*$!x
95             or return [400, "Can't parse tcp line (#$i): $line"];
96 18         261 %k = %+;
97 18         47 $k{proto} = $proto;
98             } elsif ($proto eq 'unix' && $unix) {
99             #Active UNIX domain sockets
100             #Address Type Vnode Conn Local Addr Remote Addr
101             #30258256428 stream-ord 00000000 00000000
102 36 50       67 $line =~ /^\s*$/ and next; # blank line
103 36 100       45 $line =~ /^Address\s/ and next; # header
104             #$line =~ /^[- ]+$/ and next; # separator
105 33 50       102 $line =~ m!^(?P
[0-9a-f]+)\s+
106             (?P\S+)\s+
107             (?P[0-9a-f]+)\s+
108             (?P[0-9a-f]+)\s+
109             (?:
110             (?P\S+)\s+
111             (?:
112             (?P\S+)\s+
113             )?
114             )?
115             \s*$!x
116             or return [400, "Can't parse unix line (#$i): $line"];
117 33         273 %k = %+;
118 33         61 $k{proto} = $proto;
119             } else {
120             # XXX error? because there are no other lines
121 31         29 next;
122             }
123 72         92 push @conns, \%k;
124             }
125              
126 4         27 [200, "OK", {active_conns => \@conns}];
127             }
128              
129             1;
130             # ABSTRACT: Parse the output of Solaris "netstat" command
131              
132             __END__