File Coverage

blib/lib/Net/Connection/FreeBSD_sockstat.pm
Criterion Covered Total %
statement 14 105 13.3
branch 0 38 0.0
condition 0 9 0.0
subroutine 5 6 83.3
pod 1 1 100.0
total 20 159 12.5


line stmt bran cond sub pod time code
1             package Net::Connection::FreeBSD_sockstat;
2              
3 1     1   76166 use 5.006;
  1         4  
4 1     1   8 use strict;
  1         2  
  1         25  
5 1     1   6 use warnings;
  1         2  
  1         44  
6 1     1   573 use Net::Connection;
  1         118053  
  1         96  
7 1     1   842 use Proc::ProcessTable;
  1         6331  
  1         1229  
8             require Exporter;
9            
10             our @ISA = qw(Exporter);
11             our @EXPORT=qw(sockstat_to_nc_objects);
12              
13             =head1 NAME
14              
15             Net::Connection::FreeBSD_sockstat - Creates Net::Connection objects using sockstat on FreeBSD.
16              
17             =head1 VERSION
18              
19             Version 0.0.2
20              
21             =cut
22              
23             our $VERSION = '0.0.2';
24              
25              
26             =head1 SYNOPSIS
27              
28             use Net::Connection::FreeBSD_sockstat;
29            
30             my @objects;
31             eval{ @objects=&sockstat_to_nc_objects; };
32              
33             # this time don't resolve ports, ptrs, or usernames
34             my $args={
35             ports=>0,
36             ptrs=>0,
37             };
38             eval{ @objects=&sockstat_to_nc_objects( $args )); };
39              
40             =head1 SUBROUTINES
41              
42             =head2 sockstat_to_nc_objects
43              
44             This parses the output of 'sockstat -46s'.
45              
46             =head3 args hash
47              
48             =head4 ports
49              
50             Attempt to resolve the port names.
51              
52             Defaults to 1.
53              
54             This value is a Perl boolean.
55              
56             =head4 ptrs
57              
58             Attempt to resolve the PTRs.
59              
60             Defaults to 1.
61              
62             This value is a Perl boolean.
63              
64             =head4 proc_info
65              
66             Load up the process table and use that to fill in additional info.
67              
68             This is incompatible with the string option.
69              
70             This defaults to true if no string is specified.
71              
72             This value is a Perl boolean.
73              
74             =head4 string
75              
76             If this is specified, it parses the string instead of calling sockstat.
77              
78             If running this on anything other than FreeBSD with out passing this, it will die.
79              
80             =head4 zombie_skip
81              
82             This skips items with connections that died but are still in the table.
83              
84             This skips lines like the one below.
85              
86             USER COMMAND PID FD PROTO LOCAL ADDRESS FOREIGN ADDRESS PATH STATE CONN STATE
87             ? ? ? ? tcp6 ::1:4045 *:* LISTEN
88              
89             This defaults to 1.
90              
91             The value taken is a Perl boolean.
92              
93             =cut
94              
95             sub sockstat_to_nc_objects {
96 0     0 1   my %func_args;
97 0 0         if ( defined( $_[0] ) ) {
98 0           %func_args = %{ $_[0] };
  0            
99             }
100              
101             #
102             # set the defaults for the various args
103             #
104 0 0         if ( !defined( $func_args{proc_info} ) ) {
105              
106             # if a string is set, default to false
107 0 0         if ( defined( $func_args{string} ) ) {
108 0           $func_args{proc_info} = 0;
109             }
110             else {
111 0           $func_args{proc_info} = 1;
112             }
113             }
114 0 0         if ( !defined( $func_args{ptrs} ) ) {
115 0           $func_args{ptrs} = 1;
116             }
117 0 0         if ( !defined( $func_args{ports} ) ) {
118 0           $func_args{ports} = 1;
119             }
120 0 0         if ( !defined( $func_args{zombie_skip} ) ) {
121 0           $func_args{zombie_skip} = 1;
122             }
123              
124 0           my $output_raw;
125 0 0         if ( defined( $func_args{string} ) ) {
126 0           $output_raw = $func_args{string};
127              
128 0 0         if ( $func_args{proc_info} ) {
129 0           die('Function args string and proc_info are mutually exclusive');
130             }
131             }
132              
133 0 0         if ( !defined($output_raw) ) {
134 0           $output_raw = `sockstat -46s`;
135 0 0         if ( $^O !~ /freebsd/ ) {
136 0           die('According to $^O, this is not FreeBSD and this is specifically written for FreeBSDs sockstat');
137             }
138             }
139              
140             # split the lines of the raw
141 0           my @output_lines = split( /\n/, $output_raw );
142              
143             # holds the Net::Conection objects
144 0           my @nc_objects;
145              
146             # process info caches
147             my %pid_proc;
148 0           my %pid_pctmem;
149 0           my %pid_pctcpu;
150 0           my %pid_wchan;
151 0           my %pid_start;
152              
153             # load the process table up if needed.
154 0           my $proc_table;
155 0           my $physmem;
156 0 0         if ( $func_args{proc_info} ) {
157 0           my $pt = Proc::ProcessTable->new;
158 0           $proc_table = $pt->table;
159 0           $physmem = `/sbin/sysctl -a hw.physmem`;
160 0           chomp($physmem);
161 0           $physmem =~ s/^.*\: //;
162             }
163              
164             # process each line
165 0           my $line_int = 1;
166 0           while ( defined( $output_lines[$line_int] ) ) {
167              
168             # skip this line if it is a zombie connection info
169 0           my $process_line = 1;
170 0 0 0       if ( ( $output_lines[$line_int] =~ /^\?/ ) && $func_args{zombie_skip} ) {
171 0           $process_line = 0;
172             }
173 0 0         if ($process_line) {
174              
175 0           my $line = $output_lines[$line_int];
176              
177 0           my @line_split = split( /[\ \t]+/, $line );
178              
179             # USER COMMAND PID FD PROTO LOCAL ADDRESS FOREIGN ADDRESS PATH STATE CONN STATE
180             # kitsune firefox 10942 44 tcp4 192.168.15.2:21084 162.159.130.234:443 CLOSED
181             # ? ? ? ? tcp6 ::1:4045 *:* LISTEN
182              
183 0           my $uid = '?';
184 0           my $pid = '?';
185 0           my $username = '?';
186 0 0         if ( $line_split[0] ne '?' ) {
187 0           $pid = $line_split[2];
188 0           $uid = getpwnam( $line_split[0] );
189 0           $username = $line_split[0];
190             }
191              
192             # the basic args initially for Net::Connection
193             my $args = {
194             pid => $pid,
195             uid => $uid,
196             username => $username,
197             state => '',
198             proto => $line_split[4],
199             ports => $func_args{ports},
200             ptrs => $func_args{ptrs},
201             uid_resolve => $func_args{uid_resolve},
202 0           };
203              
204             # get the local and foreign IPs
205             # not just splitting on \: as that will match IPv$
206 0           $args->{local_host} = $line_split[5];
207 0           $args->{local_host} =~ s/\:[\*0123456789]+$//;
208              
209 0           $args->{local_port} = $line_split[5];
210 0           $args->{local_port} =~ s/^.*\://;
211              
212 0           $args->{foreign_host} = $line_split[6];
213 0           $args->{foreign_host} =~ s/\:[\*0123456789]+$//;
214              
215 0           $args->{foreign_port} = $line_split[6];
216 0           $args->{foreign_port} =~ s/^.*\://;
217              
218             # state is going to be the last item in the array if it is not UDP
219 0 0         if ( $args->{proto} !~ /^udp/ ) {
220 0           $args->{state} = $line_split[-1];
221             }
222              
223             #
224             # put together process info if requested
225             # skips adding it if the UID is ? as that means that the proc no longer exists
226             #
227 0 0 0       if ( $func_args{proc_info}
228             && ( $args->{uid} ne '?' ) )
229             {
230             # if possible used cached info
231 0 0         if ( defined( $pid_proc{ $args->{pid} } ) ) {
232 0           $args->{proc} = $pid_proc{ $args->{pid} };
233 0           $args->{wchan} = $pid_wchan{ $args->{pid} };
234 0           $args->{pctmem} = $pid_pctmem{ $args->{pid} };
235 0           $args->{pctcpu} = $pid_pctcpu{ $args->{pid} };
236 0           $args->{pid_start} = $pid_start{ $args->{pid} };
237             }
238             else {
239 0           my $loop = 1;
240 0           my $proc_int = 0;
241 0   0       while ( defined( $proc_table->[$proc_int] )
242             && $loop )
243             {
244              
245             # matched
246 0 0         if ( $proc_table->[$proc_int]->{pid} eq $args->{pid} ) {
247              
248             # exit the loop
249 0           $loop = 0;
250              
251             # fetch and save the proc info
252 0 0         if ( $proc_table->[$proc_int]->cmndline =~ /^$/ ) {
253              
254             # kernel proc
255 0           $args->{proc} = '[' . $proc_table->[$proc_int]->{fname} . ']';
256             }
257             else {
258             # non-kernel proc
259 0           $args->{proc} = $proc_table->[$proc_int]->{cmndline};
260             }
261 0           $pid_proc{ $args->{pid} } = $args->{proc};
262              
263 0           $args->{wchan} = $proc_table->[$proc_int]->{wchan};
264 0           $pid_wchan{ $args->{pid} } = $args->{wchan};
265              
266 0           $args->{pid_start} = $proc_table->[$proc_int]->{pid_start};
267 0           $pid_start{ $args->{pid} } = $args->{pid_start};
268              
269 0           $args->{pctcpu} = $proc_table->[$proc_int]->{pctcpu};
270 0           $pid_pctcpu{ $args->{pid} } = $args->{pctcpu};
271              
272 0           $args->{pctmem} = ( ( $proc_table->[$proc_int]->{rssize} * 1024 * 4 ) / $physmem ) * 100;
273              
274 0           $pid_pctmem{ $args->{pid} } = $args->{pctmem};
275             }
276              
277 0           $proc_int++;
278             }
279             }
280              
281             }
282              
283 0           push( @nc_objects, Net::Connection->new($args) );
284             }
285              
286 0           $line_int++;
287              
288             }
289              
290 0           return @nc_objects;
291             }
292              
293             =head1 AUTHOR
294              
295             Zane C. Bowers-Hadley, C<< >>
296              
297             =head1 BUGS
298              
299             Please report any bugs or feature requests to C, or through
300             the web interface at L. I will be notified, and then you'll
301             automatically be notified of progress on your bug as I make changes.
302              
303              
304              
305              
306             =head1 SUPPORT
307              
308             You can find documentation for this module with the perldoc command.
309              
310             perldoc Net::Connection::FreeBSD_sockstat
311              
312              
313             You can also look for information at:
314              
315             =over 4
316              
317             =item * RT: CPAN's request tracker (report bugs here)
318              
319             L
320              
321             =item * CPAN Ratings
322              
323             L
324              
325             =item * Search CPAN
326              
327             L
328              
329             =item * Git Repo
330              
331             L
332              
333             =back
334              
335              
336             =head1 ACKNOWLEDGEMENTS
337              
338              
339             =head1 LICENSE AND COPYRIGHT
340              
341             This software is Copyright (c) 2021 by Zane C. Bowers-Hadley.
342              
343             This is free software, licensed under:
344              
345             The Artistic License 2.0 (GPL Compatible)
346              
347              
348             =cut
349              
350             1; # End of Net::Connection::FreeBSD_sockstat