File Coverage

blib/lib/Virani.pm
Criterion Covered Total %
statement 44 396 11.1
branch 0 224 0.0
condition 0 222 0.0
subroutine 15 29 51.7
pod 11 14 78.5
total 70 885 7.9


line stmt bran cond sub pod time code
1             package Virani;
2              
3 1     1   71600 use 5.006;
  1         3  
4 1     1   7 use strict;
  1         2  
  1         34  
5 1     1   6 use warnings;
  1         2  
  1         30  
6 1     1   557 use TOML;
  1         30857  
  1         55  
7 1     1   617 use File::Slurp;
  1         32253  
  1         63  
8 1     1   472 use Net::Subnet;
  1         5956  
  1         63  
9 1     1   516 use File::Find::IncludesTimeRange;
  1         12004  
  1         40  
10 1     1   487 use File::Find::Rule;
  1         8506  
  1         8  
11 1     1   56 use Digest::MD5 qw(md5_hex);
  1         2  
  1         71  
12 1     1   11 use File::Spec;
  1         2  
  1         21  
13 1     1   745 use IPC::Cmd qw(run);
  1         42719  
  1         79  
14 1     1   636 use File::Copy "cp";
  1         2538  
  1         98  
15 1     1   761 use Sys::Syslog;
  1         8832  
  1         66  
16 1     1   811 use JSON;
  1         8883  
  1         6  
17 1     1   116 use Time::Piece;
  1         2  
  1         8  
18              
19             =head1 NAME
20              
21             Virani - PCAP retrieval for a FPC setup writing to PCAP files.
22              
23             =head1 VERSION
24              
25             Version 1.0.1
26              
27             =cut
28              
29             our $VERSION = '1.0.1';
30              
31             =head1 SYNOPSIS
32              
33             use Virani;
34              
35             my $virani = Virani->new();
36             ...
37              
38             =head1 METHODS
39              
40             =head2 new_from_conf
41              
42             Initiates the Virani object from the specified file.
43              
44             - conf :: The config TOML to use.
45             - Default :: /usr/local/etc/virani.toml
46              
47             =cut
48              
49             sub new_from_conf {
50 0     0 1   my ( $blank, %opts ) = @_;
51              
52 0 0         if ( !defined( $opts{conf} ) ) {
53 0           $opts{conf} = '/usr/local/etc/virani.toml';
54             }
55              
56 0 0         if ( !-f $opts{conf} ) {
57 0           die( "'" . $opts{conf} . "' is not a file or does not exist" );
58             }
59              
60 0           my $raw_toml;
61 0           eval { $raw_toml = read_file( $opts{conf} ); };
  0            
62 0 0 0       if ( $@ || !defined($raw_toml) ) {
63 0           my $error = 'Failed to read config file, "' . $opts{conf} . '"';
64 0 0         if ($@) {
65 0           $error = $error . ' ' . $@;
66             }
67 0           die($error);
68             }
69              
70 0           my $toml;
71 0           eval { $toml = from_toml($raw_toml); };
  0            
72 0 0         if ($@) {
73 0           die($@);
74             }
75              
76 0           return Virani->new( %{$toml} );
  0            
77             } ## end sub new_from_conf
78              
79             =head2 new
80              
81             Initiates the object.
82              
83             - allowed_subnets :: The allowed subnets for fetching PCAPs for mojo-varini.
84             Defaults :: [ '192.168.0.0/', '127.0.0.1/8', '::1/127', '172.16.0.0/12' ]
85              
86             - apikey :: Optional API key for mojo-varini.
87             Defaults :: undef
88              
89             - auth_by_IP_only :: Auth by IP only and don't use a API key.
90             Default :: 1
91              
92             - default_set :: The default set to use.
93             Default :: default
94              
95             - cache :: Cache directory to write to.
96             Default :: /var/cache/virani
97              
98             - default_regex :: The regex to use for getting the timestamp. The regex to pass to
99             File::Find::IncludesTimeRange for finding PCAP files with timestamps
100             that include the range in question.
101             Default :: (?\\d\\d\\d\\d\\d\\d+)(\\.pcap|(?\\.\\d+)\\.pcap)$
102              
103             - verbose_to_syslog :: Send verbose items to syslog. This is used by mojo-virani.
104             Default :: 0
105              
106             - verbose :: Print verbose info.
107             Default :: 1
108              
109             - type :: Either tcpdump, tshark, or bpf2tshark, which to use for filtering PCAP files in the
110             specified time slot. tcpdump is faster, but in general will not nicely handles
111             some VLAN types. For that tshark is needed, but it is signfigantly slower. bpf2tshark
112             is handled via Virani->bpf2tshark and that should be seen for more info on that.
113             Default :: tcpdump
114              
115             - padding :: How many seconds to add to the start and end time stamps to ensure the specified
116             time slot is definitely included.
117             Default :: 5
118              
119             - sets :: A hash of hashes of available sets.
120             Default :: { default => { path => '/var/log/daemonlogger' } }
121              
122             For sets, the following keys are usable, of which only path is required.
123              
124             - path :: The base path of which the PCAPs are located.
125              
126             - padding :: Padding value for this set.
127              
128             - regex :: The timestamp regex to use with this set.
129              
130             - type :: The default filter type to use with this set.
131              
132             =cut
133              
134             sub new {
135 0     0 1   my ( $blank, %opts ) = @_;
136              
137 0           my $self = {
138             allowed_subnets => [ '192.168.0.0/', '127.0.0.1/8', '::1/127', '172.16.0.0/12' ],
139             apikey => undef,
140             auth_by_IP_only => 1,
141             default_set => 'default',
142             cache => '/var/cache/virani',
143             default_regex => '(?\\d\\d\\d\\d\\d\\d+)(\\.pcap|(?\\.\\d+)\\.pcap)$',
144             default_max_time => '3600',
145             verbose_to_syslog => 0,
146             verbose => 1,
147             type => 'tcpdump',
148             padding => 5,
149             sets => {
150             default => {
151             path => '/var/log/daemonlogger',
152             }
153             },
154              
155             };
156 0           bless $self;
157              
158 0 0 0       if ( defined( $opts{allowed_subnets} ) && ref( $opts{allowed_subnets} ) eq 'ARRAY' ) {
    0 0        
159 0           $self->{allowed_subnets} = $opts{allowed_subnets};
160             } elsif ( defined( $opts{allowed_subnets} ) && ref( $opts{allowed_subnets} ) ne 'ARRAY' ) {
161 0           die("$opts{allowed_subnets} defined, but not a array");
162             }
163              
164 0 0 0       if ( defined( $opts{sets} ) && ref( $opts{sets} ) eq 'HASH' ) {
    0 0        
165 0           $self->{sets} = $opts{sets};
166             } elsif ( defined( $opts{sets} ) && ref( $opts{allowed_subnets} ) ne 'HASH' ) {
167 0           die("$opts{sets} defined, but not a hash");
168             }
169              
170             # real in basic values
171 0           my @real_in = (
172             'apikey', 'default_set', 'cache', 'padding',
173             'default_max_time', 'verbose_to_syslog', 'verbose', 'auth_by_IP_only',
174             'type'
175             );
176 0           for my $key (@real_in) {
177 0 0         if ( defined( $opts{$key} ) ) {
178 0           $self->{$key} = $opts{$key};
179             }
180             }
181              
182 0           return $self;
183             } ## end sub new
184              
185             =head2 bpf2tshark
186              
187             Does a quick and dumb conversion of a BPF filter to tshark.
188              
189             my $tshark=$virani->bpf2tshark($bpf);
190              
191              
192              
193             () -> ()
194             not () -> !()
195              
196             icmp -> icmp
197             tcp -> tcp
198             udp -> udp
199              
200             port $port -> ( tcp.port == $port or udp.port == $port )
201             not port $port -> ( tcp.port != $port or udp.port != $port )
202              
203             dst port $port -> ( tcp.dstport == $port or udp.dstport == $port )
204             not dst port $port -> ( tcp.dstport != $port or udp.dstport != $port )
205              
206             src port $port -> ( tcp.srcport == $port or udp.srcport == $port )
207             not src port $port -> ( tcp.srcport != $port or udp.srcport != $port )
208              
209             host $host -> ip.addr == $host
210             not host $host -> ip.addr != $host
211              
212             dst host $host -> ip.dst == $host
213             not dst host $host -> ip.dst != $host
214              
215             src host $host -> ip.src == $host
216             not src host $host -> ip.src != $host
217              
218             dst $host -> ip.dst == $host
219             not host $host -> ip.dst != $host
220              
221             src src $host -> ip.src == $host
222             not src $host -> ip.src != $host
223              
224             =cut
225              
226             sub bpf2tshark {
227 0     0 1   my $self = $_[0];
228 0           my $bpf = $_[1];
229              
230 0 0         if ( !defined($bpf) ) {
231 0           return '';
232             }
233              
234             # make sure that () have spaces on either side
235 0           $bpf =~ s/\(/\ \(\ /g;
236 0           $bpf =~ s/\)/\ \)\ /g;
237              
238 0           my @bpf_split = split( /[\ \t]+/, $bpf );
239 0           my @tshark_args;
240             my @previous;
241 0           my $not = 0;
242 0           foreach my $item (@bpf_split) {
243              
244             # sets the equality operator based of if not is true or not
245 0           my $equality = '==';
246 0 0         if ($not) {
247 0           $equality = '!=';
248             }
249              
250             # tcp/udp/icmp
251 0 0 0       if ( $item eq 'tcp' || $item eq 'udp' || $item eq 'icmp' ) {
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
    0 0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
      0        
252 0           push( @tshark_args, $item );
253 0           $not = 0;
254 0           @previous = ();
255             }
256              
257             # handle negation
258             elsif ( $item eq 'not' ) {
259 0           $not = 1;
260             }
261              
262             # handles closing )
263             elsif ( $item eq ')' ) {
264 0           $not = 0;
265 0           push( @tshark_args, ')' );
266 0           @previous = ();
267             }
268              
269             # handles opening (
270             elsif ( $item eq ')' ) {
271 0 0         if ($not) {
272 0           push( @tshark_args, '!(' );
273             } else {
274 0           push( @tshark_args, '(' );
275             }
276 0           $not = 0;
277 0           @previous = ();
278             }
279              
280             # and/or
281             elsif ( $item eq 'or' || $item eq 'and' ) {
282             # make sure we not add it twice
283 0 0 0       if ( $tshark_args[$#tshark_args] ne 'and' && $tshark_args[$#tshark_args] ne 'or' ) {
284 0           push( @tshark_args, $item );
285             }
286 0           $not = 0;
287 0           @previous = ();
288             }
289              
290             # start of src/dst
291             elsif ( !defined( $previous[0] ) && ( $item eq 'src' || $item eq 'dst' ) ) {
292 0           push( @previous, $item );
293             }
294              
295             # start of ether
296             elsif ( !defined( $previous[0] ) && $item eq 'ether' ) {
297 0           push( @previous, $item );
298             }
299              
300             # adding src/dst/host to ether
301             elsif (defined( $previous[0] )
302             && $previous[0] eq 'ether'
303             && ( $item eq 'src' || $item eq 'dst' || $item eq 'host' ) )
304             {
305 0           push( @previous, $item );
306             }
307              
308             # generic host/port
309             elsif ( !defined( $previous[0] ) && ( $item eq 'port' || $item eq 'host' ) ) {
310 0           push( @previous, $item );
311             }
312              
313             # adding host/port to src/dst
314             elsif (defined( $previous[0] )
315             && ( $previous[0] eq 'src' || $previous[0] eq 'dst' )
316             && ( $item eq 'host' || $item eq 'port' ) )
317             {
318 0           push( @previous, $item );
319             }
320              
321             # add ether src $ether
322             elsif (defined( $previous[0] )
323             && defined( $previous[1] )
324             && $previous[0] eq 'ether'
325             && $previous[1] eq 'src' )
326             {
327 0           push( @tshark_args, 'etc.src', $equality, $item );
328 0           $not = 0;
329 0           @previous = ();
330             }
331              
332             # add ether src $ether
333             elsif (defined( $previous[0] )
334             && defined( $previous[1] )
335             && $previous[0] eq 'ether'
336             && $previous[1] eq 'dst' )
337             {
338 0           push( @tshark_args, 'etc.dst', $equality, $item );
339 0           $not = 0;
340 0           @previous = ();
341             }
342              
343             # add ether host $ether
344             elsif (defined( $previous[0] )
345             && defined( $previous[1] )
346             && $previous[0] eq 'ether'
347             && $previous[1] eq 'host' )
348             {
349 0           push( @tshark_args, 'etc.addr', $equality, $item );
350 0           $not = 0;
351 0           @previous = ();
352             }
353              
354             # add src port $port
355             elsif (defined( $previous[0] )
356             && defined( $previous[1] )
357             && $previous[0] eq 'src'
358             && $previous[1] eq 'port' )
359             {
360 0           push( @tshark_args, '(', 'tcp.srcport', $equality, $item, 'or', 'udp.srcport', $equality, $item, ')' );
361 0           $not = 0;
362 0           @previous = ();
363             }
364              
365             # add dst port $port
366             elsif (defined( $previous[0] )
367             && defined( $previous[1] )
368             && $previous[0] eq 'dst'
369             && $previous[1] eq 'port' )
370             {
371 0           push( @tshark_args, '(', 'tcp.dstport', $equality, $item, 'or', 'udp.dstport', $equality, $item, ')' );
372 0           $not = 0;
373 0           @previous = ();
374             }
375              
376             # add src host $host
377             elsif (defined( $previous[0] )
378             && defined( $previous[1] )
379             && $previous[0] eq 'src'
380             && $previous[1] eq 'host' )
381             {
382 0           push( @tshark_args, 'ip.src', $equality, $item );
383 0           $not = 0;
384 0           @previous = ();
385             }
386              
387             # add dst host $host
388             elsif (defined( $previous[0] )
389             && defined( $previous[1] )
390             && $previous[0] eq 'dst'
391             && $previous[1] eq 'host' )
392             {
393 0           push( @tshark_args, 'ip.dst', $equality, $item );
394 0           $not = 0;
395 0           @previous = ();
396             }
397              
398             # add port $port
399             elsif ( defined( $previous[0] ) && !defined( $previous[1] ) && $previous[0] eq 'port' ) {
400 0           push( @tshark_args, '(', 'tcp.port', $equality, $item, 'or', 'udp.port', $equality, $item, ')' );
401 0           $not = 0;
402 0           @previous = ();
403             }
404              
405             # add host $host
406             elsif ( defined( $previous[0] ) && !defined( $previous[1] ) && $previous[0] eq 'host' ) {
407 0           push( @tshark_args, 'ip.addr', $equality, $item );
408 0           $not = 0;
409 0           @previous = ();
410             }
411              
412             # add src $host
413             elsif ( defined( $previous[0] ) && !defined( $previous[1] ) && $previous[0] eq 'src' ) {
414 0           push( @tshark_args, 'ip.src', $equality, $item );
415 0           $not = 0;
416 0           @previous = ();
417             }
418              
419             # add dst $host
420             elsif ( defined( $previous[0] ) && !defined( $previous[1] ) && $previous[0] eq 'dst' ) {
421 0           push( @tshark_args, 'ip.dst', $equality, $item );
422 0           $not = 0;
423 0           @previous = ();
424             }
425              
426             # if anything else is found, skip it
427             else {
428 0           $not = 0;
429 0           @previous = ();
430             }
431             } ## end foreach my $item (@bpf_split)
432              
433 0           return join( ' ', @tshark_args );
434             } ## end sub bpf2tshark
435              
436             =head2 filter_clean
437              
438             Removes starting and trailing whitespace as well as collapsing
439             consecutive whitespace to a single space.
440              
441             The purpose for this is to make sure that tshark/BPF filters passed
442             are consistent for cacheing, even if their white space differs.
443              
444             A undef passed to it will return ''.
445              
446             Will die if the filter matches /^\w*\-/ as it starts with a '-', which
447             tcpdump will interpret as a switch.
448              
449             my $cleaned_bpf=$virani->filter_clean($bpf);
450              
451             =cut
452              
453             sub filter_clean {
454 0     0 1   my $self = $_[0];
455 0           my $string = $_[1];
456              
457 0 0         if ( !defined($string) ) {
458 0           return '';
459             }
460              
461 0 0         if ( $string =~ /^\w*\-/ ) {
462 0           die( 'The filter, "' . $string . '", begins with a "-", which dieing for safety reasons' );
463             }
464              
465             # remove white space at the start and end
466 0           $string =~ s/^\s*//g;
467 0           $string =~ s/\s+$//g;
468              
469             # replace all multiple white space characters with a single space
470 0           $string =~ s/\s\s+/ /g;
471              
472 0           return $string;
473             } ## end sub filter_clean
474              
475             =head1 check_apikey
476              
477             Checks the API key.
478              
479             If auth_via_IP_only is 1, this will always return true.
480              
481             my $apikey=$c->param('apikey');
482             if (!$virani->check_apikey($apikey)) {
483             $c->render( text => "Invalid API key\n", status=>403, );
484             return;
485             }
486              
487             =cut
488              
489             sub check_apikey {
490 0     0 0   my $self = $_[0];
491 0           my $apikey = $_[1];
492              
493 0 0         if ( $self->{auth_by_IP_only} ) {
494 0           return 1;
495             }
496              
497 0 0         if ( !defined($apikey) ) {
498 0           return 0;
499             }
500              
501 0 0 0       if ( !defined( $self->{apikey} ) || $self->{apikey} eq '' ) {
502 0           return 0;
503             }
504              
505 0 0         if ( $apikey ne $self->{apikey} ) {
506 0           return 0;
507             }
508              
509 0           return 1;
510             } ## end sub check_apikey
511              
512             =head1 check_remote_ip
513              
514             Checks if the remote IP is allowed or not.
515              
516             if ( ! $virani->check_remote_ip( $c->{tx}{original_remote_address} )){
517             $c->render( text => "IP or subnet not allowed\n", status=>403, );
518             return;
519             }
520              
521             =cut
522              
523             sub check_remote_ip {
524 0     0 0   my $self = $_[0];
525 0           my $ip = $_[1];
526              
527 0 0         if ( !defined($ip) ) {
528 0           return 0;
529             }
530              
531 0 0         if ( !defined( $self->{allowed_subnets}[0] ) ) {
532 0           return 0;
533             }
534              
535 0           my $allowed_subnets;
536 0           eval { $allowed_subnets = subnet_matcher( @{ $self->{allowed_subnets} } ); };
  0            
  0            
537 0 0         if ($@) {
    0          
538 0           die( 'Failed it init subnet matcher... ' . $@ );
539             } elsif ( !defined($allowed_subnets) ) {
540 0           die('Failed it init subnet matcher... sub_matcher returned undef');
541             }
542              
543 0 0         if ( $allowed_subnets->($ip) ) {
544 0           return 1;
545             }
546              
547 0           return 0;
548             } ## end sub check_remote_ip
549              
550             =head1 check_type
551              
552             Verify if the check is valid or note
553              
554             Returns 0/1 based on if it a known type or not.
555              
556             if ( ! $virani->check_type( $type )){
557             print $type." is not known\n";
558             }
559              
560             =cut
561              
562             sub check_type {
563 0     0 0   my $self = $_[0];
564 0           my $type = $_[1];
565              
566 0 0         if ( !defined($type) ) {
567 0           return 0;
568             }
569              
570 0 0 0       if ( $type ne 'tshark' && $type ne 'tcpdump' && $type ne 'bpf2tshark' ) {
      0        
571 0           return 0;
572             }
573              
574 0           return 1;
575             } ## end sub check_type
576              
577             =head2 get_default_set
578              
579             Returns the deefault set to use.
580              
581             my $set=$virani->get_default_set;
582              
583             =cut
584              
585             sub get_default_set {
586 0     0 1   my ($self) = @_;
587              
588 0           return $self->{default_set};
589             }
590              
591             =head2 get_cache_file
592              
593             Takes the same args as get_pcap_lcal.
594              
595             Returns the path to the file.
596              
597             my $cache_file=$virani->get_cache_file(%opts);
598             if (! -f $cache_file.'json'){
599             echo "Cache file metadata does not exist, so either get_pcap_local died or it has not been ran\n";
600             }
601              
602             =cut
603              
604             sub get_cache_file {
605 0     0 1   my ( $self, %opts ) = @_;
606              
607             # make sure we have something for type and check to make sure it is sane
608 0 0         if ( !defined( $opts{type} ) ) {
609 0           $opts{type} = $self->{type};
610 0 0         if ( defined( $self->{sets}{ $opts{set} }{type} ) ) {
611 0           $opts{type} = $self->{sets}{ $opts{set} }{type};
612             }
613             }
614              
615             # check it here incase the config includes something off
616 0 0         if ( !$self->check_type( $opts{type} ) ) {
617 0           die( 'type "' . $opts{type} . '" is not a supported type, tcpdump or tshark,' );
618             }
619              
620             # basic sanity checking
621 0 0 0       if ( !defined( $opts{start} ) ) {
    0          
    0          
    0          
    0          
622 0           die('$opts{start} not defined');
623             } elsif ( !defined( $opts{end} ) ) {
624 0           die('$opts{start} not defined');
625             } elsif ( ref( $opts{start} ) ne 'Time::Piece' ) {
626 0           die('$opts{start} is not a Time::Piece object');
627             } elsif ( ref( $opts{end} ) ne 'Time::Piece' ) {
628 0           die('$opts{end} is not a Time::Piece object');
629             } elsif ( defined( $opts{padding} ) && $opts{padding} !~ /^\d+/ ) {
630 0           die('$opts{padding} is not numeric');
631             }
632              
633 0 0         if ( !defined( $opts{auto_no_cache} ) ) {
634 0           $opts{auto_no_cache} = 1;
635             }
636              
637 0 0 0       if ( !defined( $opts{set} ) || $opts{set} eq '' ) {
638 0           $opts{set} = $self->get_default_set;
639             }
640              
641             # make sure the set exists
642 0 0         if ( !defined( $self->{sets}->{ $opts{set} } ) ) {
    0          
    0          
643 0           die( 'The set "' . $opts{set} . '" is not defined' );
644             } elsif ( !defined( $self->{sets}->{ $opts{set} }{path} ) ) {
645 0           die( 'The path for set "' . $opts{set} . '" is not defined' );
646             } elsif ( !-d $self->{sets}->{ $opts{set} }{path} ) {
647             die( 'The path for set "'
648             . $opts{set} . '", "'
649             . $self->{sets}->{ $opts{set} }{path}
650 0           . '" is not exist or is not a directory' );
651             }
652              
653             # get the paddimg, make sure it is sane, and apply it
654 0 0         if ( !defined( $opts{padding} ) ) {
655 0           $opts{padding} = $self->{padding};
656 0 0         if ( defined( $self->{sets}{ $opts{set} }{padding} ) ) {
657 0           $opts{padding} = $self->{sets}{ $opts{set} }{padding};
658             }
659             }
660              
661             # clean the filter
662 0           $opts{filter} = $self->filter_clean( $opts{filter} );
663              
664 0           my $cache_file;
665 0 0         if ( defined( $opts{file} ) ) {
666 0           my ( $volume, $directories, $file ) = File::Spec->splitpath( $opts{file} );
667              
668             # make sure the directory the output file is using exists
669 0 0 0       if ( $directories ne '' && !-d $directories ) {
670             die( '$opts{file} is set to "'
671             . $opts{file}
672 0           . '" but the directory part,"'
673             . $directories
674             . '", does not exist' );
675             }
676              
677             # figure what what to use as the cache file
678 0 0 0       if ( $opts{no_cache} ) {
    0 0        
    0 0        
    0 0        
      0        
679 0           $cache_file = $opts{file};
680             } elsif ( $opts{auto_no_cache} && ( !-d $self->{cache} || !-w $self->{cache} ) ) {
681 0           $cache_file = $opts{file};
682              
683             } elsif ( $opts{auto_no_cache} && ( -d $self->{cache} || -w $self->{cache} ) ) {
684             $cache_file
685             = $self->{cache} . '/'
686             . $opts{set} . '-'
687             . $opts{type} . '-'
688             . $opts{start}->epoch . '-'
689             . $opts{end}->epoch . "-"
690 0           . lc( md5_hex( $opts{filter} ) );
691             } elsif ( !$opts{auto_no_cache} && ( !-d $self->{cache} || !-w $self->{cache} ) ) {
692             die( '$opts{auto_no_cache} is false and $opts{no_cache} is false, but the cache dir "'
693             . $self->{dir}
694 0           . '" does not exist, is not a dir, or is not writable' );
695             }
696             } else {
697             # make sure the cache is usable
698 0 0         if ( !-d $self->{cache} ) {
    0          
699 0           die( 'Cache dir,"' . $self->{cache} . '", does not exist or is not a dir' );
700             } elsif ( !-w $self->{cache} ) {
701 0           die( 'Cache dir,"' . $self->{cache} . '", is not writable' );
702             }
703              
704             $cache_file
705             = $self->{cache} . '/'
706             . $opts{set} . '-'
707             . $opts{start}->epoch . '-'
708             . $opts{type} . '-'
709             . $opts{end}->epoch . "-"
710 0           . lc( md5_hex( $opts{filter} ) );
711             } ## end else [ if ( defined( $opts{file} ) ) ]
712              
713 0           return $cache_file;
714             } ## end sub get_cache_file
715              
716             =head2 get_pcap_local
717              
718             Generates a PCAP locally and returns the path to it.
719              
720             - start :: A L object of when to start looking.
721             - Default :: undef
722              
723             - end :: A L object of when to stop looking.
724             - Default :: undef
725              
726             - padding :: Number of seconds to pad the start and end with.
727             - Default :: 5
728              
729             - filter :: The BPF or tshark filter to use.
730             - Default :: ''
731              
732             - set :: The PCAP set to use. Will use what ever the default is set to if undef or blank.
733             - Default :: $virani->get_default_set
734              
735             - file :: The file to output to. If undef it just returns the path to
736             the cache file.
737             - Default :: undef
738              
739             - no_cache :: If cached, don't return that, but regen and if applicable re-cache.
740             - Default :: 0
741              
742             - auto_no_cache :: If the cache dir is being used and not writeable and a file
743             as been specified, don't die, but use the output file name
744             as the basis of for the tmp file.
745             - Default :: 1
746              
747             - type :: 'tcpdump' or 'tshark', depending on what one wants the filter todo.
748             - Default :: tcpdump
749              
750             The return is a hash reference that includes the following keys.
751              
752             - pcaps :: A array of PCAPs used.
753              
754             - pcap_count :: A count of used PCAPs.
755              
756             - failed :: A hash of PCAPs that failed. PCAP path as key and value being the reason.
757              
758             - failed_count :: A count of failed PCAPs.
759              
760             - path :: The path to the results file. If undef, unable it was unable
761             to process any of them.
762              
763             - success_found :: A count of successfully processed PCAPs.
764              
765             - filter :: The used filter.
766              
767             - total_size :: The size of all PCAP files checked.
768              
769             - failed_size :: The size of the PCAP files that failed.
770              
771             - success_size :: the size of the PCAP files that successfully processed
772              
773             - type :: The value of $opts{type}
774              
775             - padding :: The value of padding.
776              
777             - start_s :: Start time in seconds since epoch, not including pading.
778              
779             - end :: Send time in the format '%Y-%m-%dT%H:%M:%S%z'.
780              
781             - end_s :: End time in seconds since epoch, not including pading.
782              
783             - end :: End time in the format '%Y-%m-%dT%H:%M:%S%z'.
784              
785             - using_cache :: If the cache was used or not.
786              
787             - req_start :: Timestamp of when the it started. In the format
788             %Y-%m-%dT%H:%M:%S%z
789              
790             - req_start_s :: Same as req_start, but unixtime.
791              
792             - req_end :: Timestamp of when the it finished. In the format
793             %Y-%m-%dT%H:%M:%S%z
794              
795             - req_end_s :: Same as req_end, but unixtime.
796              
797             - req_time :: Number of seconds it took.
798              
799             =cut
800              
801             sub get_pcap_local {
802 0     0 1   my ( $self, %opts ) = @_;
803              
804             # start of the request
805 0           my $req_start = localtime;
806              
807             # make sure we have something for type and check to make sure it is sane
808 0 0         if ( !defined( $opts{type} ) ) {
809 0           $opts{type} = $self->{type};
810 0 0         if ( defined( $self->{sets}{ $opts{set} }{type} ) ) {
811 0           $opts{type} = $self->{sets}{ $opts{set} }{type};
812             }
813             }
814              
815             # check it here incase the config includes something off
816 0 0         if ( !$self->check_type( $opts{type} ) ) {
817 0           die( 'type "' . $opts{type} . '" is not a supported type, tcpdump or tshark,' );
818             }
819 0           $self->verbose( 'info', 'Type: ' . $opts{type} );
820              
821             # basic sanity checking
822 0 0 0       if ( !defined( $opts{start} ) ) {
    0          
    0          
    0          
    0          
823 0           die('$opts{start} not defined');
824             } elsif ( !defined( $opts{end} ) ) {
825 0           die('$opts{start} not defined');
826             } elsif ( ref( $opts{start} ) ne 'Time::Piece' ) {
827 0           die('$opts{start} is not a Time::Piece object');
828             } elsif ( ref( $opts{end} ) ne 'Time::Piece' ) {
829 0           die('$opts{end} is not a Time::Piece object');
830             } elsif ( defined( $opts{padding} ) && $opts{padding} !~ /^\d+$/ ) {
831 0           die('$opts{padding} is not numeric');
832             }
833 0           $self->verbose( 'info', 'Start: ' . $opts{start}->strftime('%Y-%m-%dT%H:%M:%S%z') . ', ' . $opts{start}->epoch );
834 0           $self->verbose( 'info', 'End: ' . $opts{end}->strftime('%Y-%m-%dT%H:%M:%S%z') . ', ' . $opts{end}->epoch );
835              
836 0 0         if ( !defined( $opts{auto_no_cache} ) ) {
837 0           $opts{auto_no_cache} = 1;
838             }
839 0           $self->verbose( 'info', 'auto_no_cache: ' . $opts{auto_no_cache} );
840              
841 0 0         if ( !defined( $opts{no_cache} ) ) {
842 0           $opts{no_cache} = 0;
843             }
844 0           $self->verbose( 'info', 'no_cache: ' . $opts{no_cache} );
845              
846 0 0 0       if ( !defined( $opts{set} ) || $opts{set} eq '' ) {
847 0           $opts{set} = $self->get_default_set;
848             }
849 0           $self->verbose( 'info', 'Set: ' . $opts{set} );
850              
851             # make sure the set exists
852 0 0         if ( !defined( $self->{sets}->{ $opts{set} } ) ) {
    0          
    0          
853 0           die( 'The set "' . $opts{set} . '" is not defined' );
854             } elsif ( !defined( $self->{sets}->{ $opts{set} }{path} ) ) {
855 0           die( 'The path for set "' . $opts{set} . '" is not defined' );
856             } elsif ( !-d $self->{sets}->{ $opts{set} }{path} ) {
857             die( 'The path for set "'
858             . $opts{set} . '", "'
859             . $self->{sets}->{ $opts{set} }{path}
860 0           . '" is not exist or is not a directory' );
861             }
862              
863             # get the paddimg, make sure it is sane, and apply it
864 0 0         if ( !defined( $opts{padding} ) ) {
865 0           $opts{padding} = $self->{padding};
866 0 0         if ( defined( $self->{sets}{ $opts{set} }{padding} ) ) {
867 0           $opts{padding} = $self->{sets}{ $opts{set} }{padding};
868             }
869             }
870              
871             # clean the filter
872 0           $opts{filter} = $self->filter_clean( $opts{filter} );
873 0           $self->verbose( 'info', 'Filter: ' . $opts{filter} );
874              
875             # get the cache file to use
876 0           my $cache_file;
877 0           eval { $cache_file = $self->get_cache_file(%opts); };
  0            
878 0 0         if ($@) {
879 0           die( '$self->get_cache_files(%opts) failed... ' . $@ );
880             }
881              
882             # if applicable return the cache file
883 0           my $return_cache = 0;
884 0 0 0       if (
    0 0        
      0        
      0        
      0        
      0        
      0        
885             defined( $opts{file} )
886             && $opts{file} ne $cache_file
887             && !$opts{no_cache}
888             && -f $cache_file
889             && -f $cache_file . '.json'
890              
891             )
892             {
893 0           $return_cache = 1;
894             } elsif ( !defined( $opts{file} ) && !$opts{no_cache} && -f $cache_file && -f $cache_file . '.json' ) {
895 0           $return_cache = 1;
896             }
897 0 0         if ($return_cache) {
898 0           my $cache_message = 'Already cached... "' . $cache_file . '"';
899 0 0 0       if ( defined( $opts{file} ) && $opts{file} ne $cache_file ) {
900 0           $cache_message = $cache_message . ' -> "' . $opts{file} . '"';
901             }
902 0           $self->verbose( 'info', $cache_message );
903 0 0 0       if ( defined( $opts{file} ) && $opts{file} ne $cache_file ) {
904 0           cp( $cache_file, $opts{file} );
905             }
906 0           my $to_return;
907 0           eval {
908 0           my $cache_meta_raw = read_file( $cache_file . '.json' );
909 0           $to_return = decode_json($cache_meta_raw);
910             };
911 0 0         if ($@) {
912 0           die( 'Failed to read cache metadata JSON, "' . $cache_file . '.json"' );
913             }
914 0           $to_return->{using_cache} = 1;
915 0           return $to_return;
916             } ## end if ($return_cache)
917              
918             # check it here incase the config includes something off
919 0 0         if ( $opts{padding} !~ /^[0-9]+$/ ) {
920 0           die( '"' . $opts{padding} . '" is not a numeric' );
921             }
922              
923             # set the padding
924 0           my $start = $opts{start} - $opts{padding};
925 0           my $end = $opts{end} + $opts{padding};
926 0           $self->verbose( 'info', 'Padded Start: ' . $start->strftime('%Y-%m-%dT%H:%M:%S%z') . ', ' . $start->epoch );
927 0           $self->verbose( 'info', 'Padded End: ' . $end->strftime('%Y-%m-%dT%H:%M:%S%z') . ', ' . $end->epoch );
928              
929             # get the set
930 0           my $set_path = $self->get_set_path( $opts{set} );
931 0 0         if ( !defined($set_path) ) {
932 0           die( 'The set "' . $opts{set} . '" does not either exist or the path value for it is undef' );
933             }
934              
935             # get the pcaps
936 0           my @pcaps = File::Find::Rule->file()->name("*.pcap*")->in($set_path);
937              
938             # get the ts_regexp to use
939 0           my $ts_regexp;
940 0 0         if ( defined( $self->{sets}{ $opts{set} }{regex} ) ) {
941 0           $ts_regexp = $self->{sets}{ $opts{set} }{regex};
942             } else {
943 0           $ts_regexp = $self->{default_regex};
944             }
945              
946 0           my $to_check = File::Find::IncludesTimeRange->find(
947             items => \@pcaps,
948             start => $start,
949             end => $end,
950             regex => $ts_regexp,
951             );
952              
953             # The return hash and what will be used for the cache JSON
954             # req_end stuff set later
955             my $to_return = {
956             pcaps => $to_check,
957             pcap_count => 0,
958             failed => {},
959             failed_count => 0,
960             success_count => 0,
961             path => $cache_file,
962             filter => $opts{filter},
963             total_size => 0,
964             failed_size => 0,
965             success_size => 0,
966             tmp_size => 0,
967             final_size => 0,
968             type => $opts{type},
969             padding => $opts{padding},
970             start_s => $opts{start}->epoch,
971             start => $opts{start}->strftime('%Y-%m-%dT%H:%M:%S%z'),
972             end_s => $opts{end}->epoch,
973 0           end => $opts{end}->strftime('%Y-%m-%dT%H:%M:%S%z'),
974             req_start => $req_start->strftime('%Y-%m-%dT%H:%M:%S%z'),
975             req_start_s => $req_start->epoch,
976             };
977              
978             # used for tracking the files to cleanup
979 0           my @tmp_files;
980              
981             # puts together the tshark filter if needed
982 0           my $tshark_filter = $opts{filter};
983 0 0         if ( $opts{type} eq 'bpf2tshark' ) {
984 0           $tshark_filter = $self->bpf2tshark( $opts{filter} );
985 0           $to_return->{filter_translated} = $tshark_filter;
986 0           $self->verbose( 'info', 'Translated Filter ' . $tshark_filter );
987             }
988              
989             # the merge command
990 0           my $to_merge = [ 'mergecap', '-w', $cache_file ];
991 0           foreach my $pcap ( @{$to_check} ) {
  0            
992              
993             # get stat info for the file
994 0           my ( $dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks )
995             = stat($pcap);
996 0           $to_return->{total_size} += $size;
997              
998 0           $self->verbose( 'info', 'Processing ' . $pcap . ", size=" . $size . " ..." );
999              
1000 0           my $tmp_file = $cache_file . '-' . $to_return->{pcap_count};
1001              
1002 0           my ( $success, $error_message, $full_buf, $stdout_buf, $stderr_buf );
1003 0 0         if ( $opts{type} eq 'tcpdump' ) {
1004             ( $success, $error_message, $full_buf, $stdout_buf, $stderr_buf ) = run(
1005 0           command => [ 'tcpdump', '-r', $pcap, '-w', $tmp_file, $opts{filter} ],
1006             verbose => 0
1007             );
1008             } else {
1009 0           ( $success, $error_message, $full_buf, $stdout_buf, $stderr_buf ) = run(
1010             command => [ 'tshark', '-r', $pcap, '-w', $tmp_file, $tshark_filter ],
1011             verbose => 0
1012             );
1013             }
1014 0 0         if ($success) {
1015 0           $to_return->{success_count}++;
1016 0           $to_return->{success_size} += $size;
1017 0           push( @{$to_merge}, $tmp_file );
  0            
1018 0           push( @tmp_files, $tmp_file );
1019              
1020             # get stat info for the tmp file
1021 0           ( $dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks )
1022             = stat($tmp_file);
1023 0           $to_return->{tmp_size} += $size;
1024              
1025             } else {
1026 0           $to_return->{failed}{$pcap} = $error_message;
1027 0           $to_return->{failed_count}++;
1028 0           $to_return->{failed_size} += $size;
1029              
1030 0           $self->verbose( 'warning', 'Failed ' . $pcap . " ... " . $error_message );
1031              
1032 0           unlink $tmp_file;
1033             }
1034              
1035 0           $to_return->{pcap_count}++;
1036             } ## end foreach my $pcap ( @{$to_check} )
1037              
1038             # only try merging if we had more than one success
1039 0 0         if ( $to_return->{success_count} > 0 ) {
1040              
1041 0           $self->verbose( 'info', "Merging PCAPs... " . join( ' ', @{$to_merge} ) );
  0            
1042              
1043 0           my ( $success, $error_message, $full_buf, $stdout_buf, $stderr_buf ) = run(
1044             command => $to_merge,
1045             verbose => 0
1046             );
1047 0 0         if ($success) {
1048 0           $self->verbose( 'info', "PCAPs merged into " . $cache_file );
1049             } else {
1050             # if verbose print different messages if mergecap generated a ouput file or not when it fialed
1051 0 0         if ( -f $cache_file ) {
1052 0           $self->verbose( 'warning', "PCAPs partially(output file generated) failed " . $error_message );
1053             } else {
1054 0           $self->verbose( 'err', "PCAPs merge completely(output file not generated) failed " . $error_message );
1055             }
1056             }
1057              
1058             # remove each tmp file
1059 0           foreach my $tmp_file (@tmp_files) {
1060 0           unlink($tmp_file);
1061             }
1062              
1063             # don't bother checking size if the file was not generated
1064 0 0         if ( -f $cache_file ) {
1065 0           my ( $dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks )
1066             = stat($cache_file);
1067 0           $to_return->{final_size} = $size;
1068             }
1069              
1070             } else {
1071 0           $self->verbose( 'err', "No PCAPs to merge" );
1072             }
1073              
1074             $self->verbose( 'info',
1075             "PCAP sizes... failed_size="
1076             . $to_return->{failed_size}
1077             . " success_size="
1078             . $to_return->{success_size}
1079             . " total_size="
1080             . $to_return->{total_size}
1081             . " tmp_size="
1082             . $to_return->{tmp_size}
1083             . " final_size="
1084 0           . $to_return->{final_size} );
1085              
1086             # finalize info on how long the request took
1087 0           my $req_end = localtime;
1088 0           $to_return->{req_end} = $req_end->strftime('%Y-%m-%dT%H:%M:%S%z');
1089 0           $to_return->{req_end_s} = $req_end->epoch;
1090 0           $to_return->{req_time} = $req_end->epoch - $req_start->epoch;
1091              
1092 0           $self->verbose( 'info', 'Creating metadata JSON at "' . $cache_file . '.json" ' );
1093 0           my $json = JSON->new->allow_nonref->pretty->canonical(1);
1094 0           my $raw_json = $json->encode($to_return);
1095 0           write_file( $cache_file . '.json', $raw_json );
1096              
1097             # if the file and cache file are the same, then the cache dir not accessing, so no need to copy it
1098 0 0 0       if ( defined( $opts{file} ) && $cache_file ne $opts{file} ) {
1099 0           $self->verbose( 'info', 'Copying "' . $cache_file . '" to "' . $opts{file} . '"' );
1100 0           cp( $cache_file, $opts{file} );
1101             }
1102              
1103 0           $to_return->{using_cache} = 0;
1104              
1105 0           return $to_return;
1106             } ## end sub get_pcap_local
1107              
1108             =head2 get_set_path
1109              
1110             Returns the path to a set.
1111              
1112             If no set is given, the default is used.
1113              
1114             Will return undef if the set does not exist or if the set does not have a path defined.
1115              
1116             my $path=$virani->get_set_path($set);
1117              
1118             =cut
1119              
1120             sub get_set_path {
1121 0     0 1   my ( $self, $set ) = @_;
1122              
1123 0 0         if ( !defined($set) ) {
1124 0           $set = $self->get_default_set;
1125             }
1126              
1127 0 0         if ( !defined( $self->{sets}{$set} ) ) {
1128 0           return undef;
1129             }
1130              
1131 0 0         if ( !defined( $self->{sets}{$set}{path} ) ) {
1132 0           return undef;
1133             }
1134              
1135 0           return $self->{sets}{$set}{path};
1136             } ## end sub get_set_path
1137              
1138             =head2 set_verbose
1139              
1140             Set if it should be verbose or not.
1141              
1142             # be verbose
1143             $virani->verbose(1);
1144              
1145             # do not be verbose
1146             $virani->verbose(0);
1147              
1148             =cut
1149              
1150             sub set_verbose {
1151 0     0 1   my ( $self, $verbose ) = @_;
1152              
1153 0           $self->{verbose} = $verbose;
1154             }
1155              
1156             =head2 set_verbose_to_syslog
1157              
1158             Set if it should be verbose or not.
1159              
1160             # send verbose messages to syslog
1161             $virani->set_verbose_to_syslog(1);
1162              
1163             # do not send verbose messages to syslog
1164             $virani->set_verbose_to_syslog(0);
1165              
1166             =cut
1167              
1168             sub set_verbose_to_syslog {
1169 0     0 1   my ( $self, $to_syslog ) = @_;
1170              
1171 0           $self->{verbose_to_syslog} = $to_syslog;
1172             }
1173              
1174             =head2 verbose
1175              
1176             Prints out error messages. This is inteded to be internal.
1177              
1178             Only sends the string if verbose is enabled.
1179              
1180             There is no need to add a "\n" as it will automatically if not sending to syslog.
1181              
1182             Two variables are taken. The first is level the second is the message. Level is only used
1183             for syslog. Default level is info.
1184              
1185             - Levels :: emerg, alert, crit, err, warning, notice, info, debug
1186              
1187             $self->verbose('info', 'some string');
1188              
1189             =cut
1190              
1191             sub verbose {
1192 0     0 1   my ( $self, $level, $string ) = @_;
1193              
1194 0 0 0       if ( !defined($string) || $string eq '' ) {
1195 0           return;
1196             }
1197              
1198 0 0         if ( !defined($level) ) {
1199 0           $level = 'info';
1200             }
1201              
1202 0 0         if ( $self->{verbose} ) {
1203 0 0         if ( $self->{verbose_to_syslog} ) {
1204 0           openlog( 'virani', undef, 'daemon' );
1205 0           syslog( $level, $string );
1206 0           closelog();
1207             } else {
1208 0           print $string. "\n";
1209             }
1210             }
1211              
1212 0           return;
1213             } ## end sub verbose
1214              
1215             =head2 CONFIG
1216              
1217             The config format used toml, processed via L.
1218              
1219             'new_from_conf' will initiate virani by reading it in and feeding it to 'new'.
1220              
1221             =head2 DAEMONLOGGER ON FREEBSD
1222              
1223             With daemonlogger setup along the lines of like below...
1224              
1225             daemonlogger_enable="YES"
1226             daemonlogger_flags="-f /usr/local/etc/daemonlogger.bpf -d -l /var/log/daemonlogger -t 120"
1227              
1228             The following can be made available via mojo-varini or locally via varini with the set name of
1229             default as below.
1230              
1231             default_set='default'
1232             allowed_subnets=["192.168.14.0/23", "127.0.0.1/8"]
1233             [sets.default]
1234             path='/var/log/daemonlogger'
1235             regex='(?\d\d\d\d\d\d+)(\.pcap|(?\.\d+)\.pcap)$'
1236              
1237             =head1 AUTHOR
1238              
1239             Zane C. Bowers-Hadley, C<< >>
1240              
1241             =head1 BUGS
1242              
1243             Please report any bugs or feature requests to C, or through
1244             the web interface at L. I will be notified, and then you'll
1245             automatically be notified of progress on your bug as I make changes.
1246              
1247              
1248              
1249              
1250             =head1 SUPPORT
1251              
1252             You can find documentation for this module with the perldoc command.
1253              
1254             perldoc Virani
1255              
1256              
1257             You can also look for information at:
1258              
1259             =over 4
1260              
1261             =item * RT: CPAN's request tracker (report bugs here)
1262              
1263             L
1264              
1265             =item * CPAN Ratings
1266              
1267             L
1268              
1269             =item * Search CPAN
1270              
1271             L
1272              
1273             =back
1274              
1275              
1276             =head1 ACKNOWLEDGEMENTS
1277              
1278              
1279             =head1 LICENSE AND COPYRIGHT
1280              
1281             This software is Copyright (c) 2023 by Zane C. Bowers-Hadley.
1282              
1283             This is free software, licensed under:
1284              
1285             The GNU Lesser General Public License, Version 2.1, February 1999
1286              
1287              
1288             =cut
1289              
1290             1; # End of Virani