File Coverage

blib/lib/Net/IMP/SessionLog.pm
Criterion Covered Total %
statement 27 59 45.7
branch 0 14 0.0
condition 0 7 0.0
subroutine 9 13 69.2
pod 3 4 75.0
total 39 97 40.2


line stmt bran cond sub pod time code
1 1     1   791 use strict;
  1         2  
  1         24  
2 1     1   5 use warnings;
  1         2  
  1         30  
3              
4             package Net::IMP::SessionLog;
5 1     1   5 use base 'Net::IMP::Base';
  1         1  
  1         102  
6 1     1   6 use fields qw(fh conn);
  1         1  
  1         6  
7              
8 1     1   56 use Net::IMP; # import IMP_ constants
  1         1  
  1         66  
9 1     1   5 use Net::IMP::Debug;
  1         2  
  1         5  
10 1     1   9 use Carp 'croak';
  1         3  
  1         38  
11 1     1   453 use Time::HiRes 'gettimeofday';
  1         981  
  1         4  
12 1     1   737 use File::Temp 'tempfile';
  1         12354  
  1         378  
13              
14             sub INTERFACE { return (
15             [
16             undef, # all types/protocols are supported
17             [
18 0     0 0   IMP_PREPASS, # nothing gets ever changed or denied
19             IMP_ACCTFIELD, # to account the session log file
20             ]
21             ]
22             )}
23              
24             sub validate_cfg {
25 0     0 1   my ($class,%args) = @_;
26 0           my @err;
27 0   0       my $fmt = delete $args{format} || 'bin';
28 0 0         if ( $fmt eq 'pcap' ) {
    0          
29 0 0         push @err, "cannot load Net::PcapWriter needed for format pcap: $@"
30             if ! eval "require Net::PcapWriter";
31             } elsif ( $fmt ne 'bin' ) {
32 0           push @err, "format should be bin or pcap"
33             }
34              
35 0           my $dir = delete $args{dir};
36 0 0         push @err, "no dir given" if ! $dir;
37              
38 0           push @err,$class->SUPER::validate_cfg(%args);
39 0           return @err;
40             }
41              
42              
43             # create new context object
44             # - open log file
45             # - prepare initial and only results (PREPASS in both directions)
46             sub new_analyzer {
47 0     0 1   my ($factory,%args) = @_;
48              
49 0           my $dir = $factory->{factory_args}{dir};
50 0   0       my $fmt = $factory->{factory_args}{format} || 'bin';
51              
52 0           my $meta = $args{meta};
53             my ($fh,$fname) = tempfile(
54             sprintf("%d-%s.%s-%s.%s-XXXXX", time(),
55 0 0         @{$meta}{qw(caddr cport saddr sport)}),
  0            
56             SUFFIX => ".$fmt",
57             DIR => $dir,
58             ) or croak("cannot create tmpfile: $!");
59 0 0         $DEBUG && debug("new context with filename $fname");
60              
61 0           binmode($fh);
62 0           $fh->autoflush(1);
63              
64             my $conn = $fmt eq 'pcap'
65             && Net::PcapWriter->new($fh)
66 0   0       ->tcp_conn( @{$meta}{qw(caddr cport saddr sport)} );
67              
68 0           my $analyzer = $factory->SUPER::new_analyzer( %args );
69 0           $analyzer->{fh} = $fh;
70 0           $analyzer->{conn} = $conn;
71              
72             # only results for both directions + acct
73 0           $analyzer->add_results(
74             [ IMP_ACCTFIELD,'logfile',$fname ],
75             [ IMP_PREPASS,0,IMP_MAXOFFSET ],
76             [ IMP_PREPASS,1,IMP_MAXOFFSET ]
77             );
78              
79 0           return $analyzer;
80             }
81              
82             sub data {
83 0     0 1   my ($analyzer,$dir,$data) = @_;
84 0 0         if ( my $c = $analyzer->{conn} ) {
85             # pcap format
86 0           $c->write($dir,$data,[gettimeofday()]);
87             } else {
88             # bin format
89 0           print {$analyzer->{fh}} pack("NNcN/a*",gettimeofday(),$dir,$data);
  0            
90             }
91 0           $analyzer->run_callback;
92             }
93              
94             1;
95              
96             __END__