File Coverage

blib/lib/Parse/Netstat/Colorizer.pm
Criterion Covered Total %
statement 60 89 67.4
branch 9 28 32.1
condition 2 6 33.3
subroutine 15 17 88.2
pod 5 8 62.5
total 91 148 61.4


line stmt bran cond sub pod time code
1             package Parse::Netstat::Colorizer;
2              
3 2     2   105687 use 5.006;
  2         12  
4 2     2   9 use strict;
  2         3  
  2         32  
5 2     2   7 use warnings;
  2         10  
  2         71  
6 2     2   12 use base 'Error::Helper';
  2         2  
  2         763  
7 2     2   1985 use Parse::Netstat;
  2         904  
  2         76  
8 2     2   784 use Parse::Netstat::Search;
  2         13228  
  2         59  
9 2     2   770 use Parse::Netstat::Search::Sort;
  2         98272  
  2         69  
10 2     2   1144 use Term::ANSIColor;
  2         13426  
  2         116  
11 2     2   993 use Text::Table;
  2         13159  
  2         1471  
12              
13             =head1 NAME
14              
15             Parse::Netstat::Colorizer - Searches and colorizes the output from Parse::Netstat
16              
17             =head1 VERSION
18              
19             Version 0.0.0
20              
21             =cut
22              
23             our $VERSION = '0.0.0';
24              
25              
26             =head1 SYNOPSIS
27              
28             use Parse::Netstat;
29             use Parse::Netstat::Colorizer;
30            
31             my $pnc = Parse::Netstat::Colorizer->new();
32            
33             # don't even bother parsing unix sockets... Parse::Netstat::Search, Parse::Netsat::Search::Sort;
34             # and this only currently handle non-unix network connections
35             my $res = parse_netstat(output => join("", `netstat -n`), tcp=>1, udp=>1, unix=>0, flavor=>$^O);
36            
37             # search only for connections to/from specific networks
38             my @networks=('192.168.0.0/24', '10.10.10.0/24');
39             my $search=$pnc->get_search;
40             $search->set_cidrs( \@networks );
41             if ( $search->error ){
42             warn( 'One of the passed CIDRs is bad' );
43             }
44            
45             # set it to host local sort
46             my $sorter=$pnc->get_sort;
47             $sorter->set_sort( 'host_l' );
48              
49             Sorting and searching is handled via L and
50             L. Their objects for tweaking can be
51             fetched via get_sort and get_search.
52              
53             =head1 METHODS
54              
55             =head2 new
56              
57             Creates a new object. This will never error.
58              
59             my $pnc->new;
60              
61             =cut
62              
63             sub new {
64 1     1 1 453 my $self={
65             perror=>undef,
66             error=>undef,
67             errorString=>'',
68             errorExtra=>{
69             1 => 'badResults',
70             2 => 'searchErrored',
71             3 => 'sortErrored',
72             },
73             os=>$^O,
74             invert=>undef,
75             port_resolve=>1,
76             search=>Parse::Netstat::Search->new,
77             sort=>Parse::Netstat::Search::Sort->new,
78             };
79 1         41 bless $self;
80              
81 1         2 return $self;
82             }
83              
84             =head1 colorize
85              
86             This runs the configured search and colorizes
87             the output.
88              
89             One value is taken and that is the array ref returned
90             by Parse::Netstat.
91              
92             my $colorized=$pnc->colorize($res);
93             if ( $pnc->error ){
94             warn( 'Either $res is not valid post a basic check or sorting failed.
95             }
96              
97             =cut
98              
99             sub colorize{
100 1     1 0 226 my $self=$_[0];
101 1         2 my $res=$_[1];
102              
103 1 50       3 if( ! $self->errorblank ){
104 0         0 return undef;
105             }
106              
107             #make sure what ever we are passed is sane and very likely a return from Parse::Netdata
108 1 50 33     26 if (
      33        
109             ( ref( $res ) ne 'ARRAY' ) ||
110             ( ! defined( $res->[2] ) ) ||
111             ( ! defined( $res->[2]->{active_conns} ) )
112             ){
113 0         0 $self->{error}=1;
114 0         0 $self->{errorString}='$res->[2]->{active_conns} not defiend. Does not appear to be a Parse::Netstat return';
115 0         0 $self->warn;
116 0         0 return undef;
117             }
118              
119 1         6 my @found=$self->{search}->search( $res );
120              
121             # sort it all
122 1         341 @found=$self->{sort}->sort( \@found );
123 1 50       44983 if ( $self->{sort}->error ){
124 0         0 $self->{error}=3;
125 0         0 $self->{errorString}='Sort failed';
126 0         0 $self->warn;
127 0         0 return undef;
128             }
129              
130             # invert if needed
131 1 50       7 if ( $self->{invert} ){
132 0         0 @found=reverse(@found);
133             }
134              
135             # Holds colorized lines for the table.
136 1         4 my @colored=([
137             color('underline white').'Proto'.color('reset'),
138             color('underline white').'SendQ'.color('reset'),
139             color('underline white').'RecvQ'.color('reset'),
140             color('underline white').'Local Host'.color('reset'),
141             color('underline white').'Port'.color('reset'),
142             color('underline white').'Remote Host'.color('reset'),
143             color('underline white').'Port'.color('reset'),
144             color('underline white').'State'.color('reset'),
145             ]);
146              
147             # process each connection
148 1         224 my $conn=pop(@found);
149 1         4 while ( defined( $conn->{local_port} ) ){
150 7         10 my $port_l=$conn->{local_port};
151 7         11 my $port_f=$conn->{foreign_port};
152              
153             #resolve port numbers if needed
154 7 50       14 if ( $self->{port_resolve} ){
155 0         0 my $port_l_search=getservbyport( $port_l, '' );
156 0 0       0 if ( defined( $port_l_search ) ){
157 0         0 $port_l=$port_l_search;
158             }
159              
160             # make sure we have have a actual number
161             # UDP may not have one of these listed
162 0 0       0 if ( $port_f =~ /^\d+$/ ){
163 0         0 my $port_f_search=getservbyport( $port_f, '' );
164 0 0       0 if ( defined( $port_f_search ) ){
165 0         0 $port_f=$port_f_search;
166             }
167             }
168             }
169              
170             my @new_line=(
171             color('BRIGHT_YELLOW').$conn->{proto}.color('reset'),
172             color('BRIGHT_CYAN').$conn->{sendq}.color('reset'),
173             color('BRIGHT_RED').$conn->{recvq}.color('reset'),
174             color('BRIGHT_GREEN').$conn->{local_host}.color('reset'),
175             color('GREEN').$port_l.color('reset'),
176             color('BRIGHT_MAGENTA').$conn->{foreign_host}.color('reset'),
177             color('MAGENTA').$port_f.color('reset'),
178 7         13 color('BRIGHT_BLUE').$conn->{state}.color('reset'),
179             );
180              
181 7         1389 push( @colored, \@new_line );
182              
183 7         26 $conn=pop(@found);
184             }
185              
186 1         9 my $tb = Text::Table->new;
187              
188 1         148 return $tb->load( @colored );
189             }
190              
191             =head2 get_invert
192              
193             This returns a boolean as to if the return
194             from the sort is inverted or not.
195              
196             my $invert=$pnc->get_invert;
197              
198             =cut
199              
200             sub get_invert{
201 3     3 1 254 my $self=$_[0];
202              
203 3 50       6 if( ! $self->errorblank ){
204 0         0 return undef;
205             }
206              
207 3         23 return $self->{invert};
208             }
209              
210             =head2 get_port_resolve
211              
212             This gets the port_resolve value, which is if it should try to resolve
213             port names or not.
214              
215             The returned value is a boolean and defaults to 1.
216              
217             my $port_resolve=$pnc->get_port_resolve;
218              
219             =cut
220              
221             sub get_port_resolve{
222 3     3 1 9 my $self=$_[0];
223              
224 3 50       12 if( ! $self->errorblank ){
225 0         0 return undef;
226             }
227              
228 3         34 return $self->{port_resolve};
229             }
230              
231             =head1 get_search
232              
233             This returns the Parse::Netstat::Search object.
234              
235             my $search=$pnc->get_search;
236              
237             =cut
238              
239             sub get_search{
240 0     0 0 0 my $self=$_[0];
241              
242 0 0       0 if( ! $self->errorblank ){
243 0         0 return undef;
244             }
245              
246 0         0 return $self->{search};
247             }
248              
249             =head1 get_sort
250              
251             This returns the Parse::Netstat::Search::Sort object.
252              
253             my $sorter=$pnc->get_sort;
254              
255             # set it to host local sort
256             $sorter->set_sort( 'host_l' );
257              
258             =cut
259              
260             sub get_sort{
261 0     0 0 0 my $self=$_[0];
262              
263 0 0       0 if( ! $self->errorblank ){
264 0         0 return undef;
265             }
266              
267 0         0 return $self->{sort};
268             }
269              
270             =head2 set_invert
271              
272             This sets wether or not it should invert the
273             returned sort or not.
274              
275             # sets it to false, the default
276             $pnc->set_invert;
277              
278             # the results will be inverted
279             $pnc->set_invert;
280              
281             =cut
282              
283             sub set_invert{
284 2     2 1 460 my $self=$_[0];
285              
286 2 50       5 if( ! $self->errorblank ){
287 0         0 return undef;
288             }
289              
290 2         17 $self->{invert}=$_[1];
291             }
292              
293             =head2 set_port_resolve
294              
295             This sets wether or not the ports should be resolved or not.
296              
297             One value is taken and that is a perl boolean.
298              
299             # sets it to true, the default
300             $pnc->set_port_resolve(1);
301              
302             # set it false, don't resolve the ports
303             $pnc->set_port_resolve;
304              
305             =cut
306              
307             sub set_port_resolve{
308 2     2 1 483 my $self=$_[0];
309              
310 2 50       5 if( ! $self->errorblank ){
311 0         0 return undef;
312             }
313              
314 2         22 $self->{port_resolve}=$_[1];
315             }
316              
317             =head
318              
319             =head1 ERROR CODES / FLAGS
320              
321             Error handling is provided by L.
322              
323             =head2 1 / badResults
324              
325             The passed Parse::Netstat array does not appear to be properly formatted.
326              
327             =head2 2 / searchErrored
328              
329             Parse::Netstat::Search->search errored.
330              
331             =head2 3 / sortErrored
332              
333             Parse::Netsat::Search::Sort errored.
334              
335             =head1 AUTHOR
336              
337             Zane C. Bowers-Hadley, C<< >>
338              
339             =head1 BUGS
340              
341             Please report any bugs or feature requests to C, or through
342             the web interface at L. I will be notified, and then you'll
343             automatically be notified of progress on your bug as I make changes.
344              
345              
346              
347              
348             =head1 SUPPORT
349              
350             You can find documentation for this module with the perldoc command.
351              
352             perldoc Parse::Netstat::Colorizer
353              
354              
355             You can also look for information at:
356              
357             =over 4
358              
359             =item * RT: CPAN's request tracker (report bugs here)
360              
361             L
362              
363             =item * AnnoCPAN: Annotated CPAN documentation
364              
365             L
366              
367             =item * CPAN Ratings
368              
369             L
370              
371             =item * Search CPAN
372              
373             L
374              
375             =item * Code Repo
376              
377             L
378              
379             =back
380              
381              
382             =head1 ACKNOWLEDGEMENTS
383              
384              
385             =head1 LICENSE AND COPYRIGHT
386              
387             Copyright 2019 Zane C. Bowers-Hadley.
388              
389             This program is free software; you can redistribute it and/or modify it
390             under the terms of the the Artistic License (2.0). You may obtain a
391             copy of the full license at:
392              
393             L
394              
395             Any use, modification, and distribution of the Standard or Modified
396             Versions is governed by this Artistic License. By using, modifying or
397             distributing the Package, you accept this license. Do not use, modify,
398             or distribute the Package, if you do not accept this license.
399              
400             If your Modified Version has been derived from a Modified Version made
401             by someone other than you, you are nevertheless required to ensure that
402             your Modified Version complies with the requirements of this license.
403              
404             This license does not grant you the right to use any trademark, service
405             mark, tradename, or logo of the Copyright Holder.
406              
407             This license includes the non-exclusive, worldwide, free-of-charge
408             patent license to make, have made, use, offer to sell, sell, import and
409             otherwise transfer the Package with respect to any patent claims
410             licensable by the Copyright Holder that are necessarily infringed by the
411             Package. If you institute patent litigation (including a cross-claim or
412             counterclaim) against any party alleging that the Package constitutes
413             direct or contributory patent infringement, then this Artistic License
414             to you shall terminate on the date that such litigation is filed.
415              
416             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
417             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
418             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
419             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
420             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
421             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
422             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
423             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
424              
425              
426             =cut
427              
428             1; # End of Parse::Netstat::Colorizer