File Coverage

blib/lib/Virani.pm
Criterion Covered Total %
statement 44 389 11.3
branch 0 220 0.0
condition 0 210 0.0
subroutine 15 29 51.7
pod 11 14 78.5
total 70 862 8.1


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