File Coverage

blib/lib/Net/IMP/Adaptor/STREAM2HTTPConn.pm
Criterion Covered Total %
statement 16 18 88.8
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 22 24 91.6


line stmt bran cond sub pod time code
1 2     2   1712 use strict;
  2         2  
  2         77  
2 2     2   8 use warnings;
  2         3  
  2         77  
3              
4             package Net::IMP::Adaptor::STREAM2HTTPConn;
5 2     2   8 use base 'Net::IMP::Base';
  2         4  
  2         311  
6 2     2   12 use Net::IMP::HTTP; # constants
  2         3  
  2         176  
7 2     2   10 use Net::IMP; # constants
  2         1  
  2         196  
8 2     2   457 use Net::Inspect::L7::HTTP;
  0            
  0            
9             use Carp;
10              
11             use fields (
12             'inner_factory', # factory with IMP_DATA_HTTP interface
13             'inner_analyzer', # analyzer with IMP_DATA_HTTP interface
14             'http_parser', # HTTP parser based on Net::Inspect::L7::HTTP
15             'gap', # true when last data where a gap, per dir
16             'buf', # data received but not processed by http_parser, per dir
17             );
18              
19             sub new_factory {
20             my ($class,%args) = @_;
21             my $factory = fields::new($class);
22             $factory->{inner_factory} = $args{factory};
23             $factory->{inner_factory}->set_interface([ IMP_DATA_HTTP, undef ])
24             or croak("inner interface does not support http data");
25             return $factory;
26             }
27              
28             sub INTERFACE {
29             my $factory = shift;
30             my @if;
31             for my $if ( $factory->get_interface ) {
32             my ($dt,$rt) = @$if;
33             push @if, [ IMP_DATA_STREAM, $rt ] if $dt == IMP_DATA_HTTP;
34             }
35             return @if;
36             }
37              
38             sub new_analyzer {
39             my ($factory,%args) = @_;
40             my $analyzer = fields::new(ref($factory));
41             %$analyzer = %$factory;
42              
43             $analyzer->{inner_analyzer} = $factory->{inner_factory}->new_analyzer(%args);
44             $analyzer->{http_parser} = Net::IMP::Adaptor::STREAM2HTTPConn::Conn
45             ->new(Net::IMP::Adaptor::STREAM2HTTPConn::Request->new)
46             ->new_connection($args{meta} || {},$analyzer);
47             $analyzer->{gap} = [0,0];
48             $analyzer->{buf} = ['',''];
49              
50             return $analyzer;
51             }
52              
53             sub data {
54             my ($analyzer,$dir,$data,$offset,$type) = @_;
55             $type == IMP_DATA_STREAM or
56             croak("invalid type in ${analyzer}::data - $type");
57              
58             if ( $offset ) {
59             my $gap = $offset - $analyzer->{http_parser}->offset($dir);
60             $analyzer->{http_parser}->in($dir,{ gap => $gap });
61             }
62              
63             $analyzer->{buf}[$dir] .= $data;
64             my $processed = $analyzer->{http_parser}->in(
65             $dir,$analyzer->{buf}[$dir], $data eq '');
66             substr($analyzer->{buf}[$dir],0,$processed,'') if $processed;
67             }
68              
69             for my $sub (qw(set_callback poll_results add_results run_callback)) {
70             no strict 'refs';
71             *$sub = eval "sub { shift->{inner_analyzer}->$sub(\@_); }";
72             }
73              
74             sub tell {
75             my ($analyzer,$dir) = @_;
76             return $analyzer->{http_parser}->offset($dir);
77             }
78              
79              
80              
81             # callback from Net::IMP::Adaptor::STREAM2HTTPConn::Request
82             sub _data {
83             my ($analyzer,$dir,$data,$type) = @_;
84              
85             if ( ref $data ) { # gap
86             my $gapsize = $data->{gap} or die "invalid gapsize";
87             $type < 0 or croak("gaps not supported for type $type");
88             $analyzer->{gap}[$dir] = 1;
89             return;
90             }
91              
92             if ( $analyzer->{gap}[$dir] ) {
93             $analyzer->{gap}[$dir] = 0;
94             return $analyzer->{inner_analyzer}->data(
95             $dir,$data,$analyzer->tell($dir)+length($data),$type);
96             } else {
97             return $analyzer->{inner_analyzer}->data($dir,$data,0,$type);
98             }
99             }
100              
101              
102             ###########################################################################
103             # interface as request object, called from Net::Inspect::L7::HTTP
104             # this gets translated to the internal interface, which then calls the
105             # methods of the official Net::IMP::HTTP::Base API
106             ###########################################################################
107              
108             package Net::IMP::Adaptor::STREAM2HTTPConn::Conn;
109             use base 'Net::Inspect::L7::HTTP';
110             use fields qw(analyzer);
111              
112             use Scalar::Util 'weaken';
113              
114             sub new_connection {
115             my ($self,$meta,$analyzer) = @_;
116             my $obj = $self->SUPER::new_connection($meta) or return;
117             weaken($obj->{analyzer} = $analyzer);
118             return $obj;
119             }
120              
121             package Net::IMP::Adaptor::STREAM2HTTPConn::Request;
122             use base 'Net::Inspect::Flow';
123             use fields qw(conn meta);
124              
125             use Scalar::Util 'weaken';
126             use Net::IMP;
127             use Net::IMP::HTTP; # constants
128             use Carp;
129              
130             sub new_request {
131             my ($self,$meta,$conn) = @_;
132             my $obj = $self->new;
133             weaken( $obj->{conn} = $conn );
134             $obj->{meta} = $meta;
135             return $obj;
136             }
137              
138             sub in_request_header {
139             my ($self,$hdr) = @_;
140             $self->{conn}{analyzer}->_data(0,$hdr,IMP_DATA_HTTP_HEADER);
141             }
142              
143             sub in_request_body {
144             my ($self,$data,$eof) = @_;
145             $self->{conn}{analyzer}->_data(0,$data,IMP_DATA_HTTP_BODY);
146             $self->{conn}{analyzer}->_data(0,'',IMP_DATA_HTTP_BODY)
147             if $eof and $data ne '';
148             }
149              
150             sub in_response_header {
151             my ($self,$hdr) = @_;
152             $self->{conn}{analyzer}->_data(1,$hdr,IMP_DATA_HTTP_HEADER);
153             }
154              
155             sub in_response_body {
156             my ($self,$data,$eof) = @_;
157             $self->{conn}{analyzer}->_data(1,$data,IMP_DATA_HTTP_BODY);
158             $self->{conn}{analyzer}->_data(1,'',IMP_DATA_HTTP_BODY)
159             if $eof and $data ne '';
160             }
161              
162             sub in_chunk_header {
163             my ($self,$hdr) = @_;
164             $self->{conn}{analyzer}->_data(1,$hdr,IMP_DATA_HTTP_CHKHDR);
165             }
166              
167             sub in_chunk_trailer {
168             my ($self,$trailer) = @_;
169             $self->{conn}{analyzer}->_data(1,$trailer,IMP_DATA_HTTP_CHKTRAILER);
170             }
171              
172             sub in_data {
173             my ($self,$dir,$data,$eof) = @_;
174             $self->{conn}{analyzer}->_data($dir,$data,IMP_DATA_HTTP_DATA);
175             $self->{conn}{analyzer}->_data($dir,'',IMP_DATA_HTTP_DATA)
176             if $eof and $data ne '';
177             }
178              
179             sub in_junk {
180             my ($self,$dir,$data,$eof) = @_;
181             return $self->{conn}{analyzer}->_data($dir,$data,IMP_DATA_HTTP_JUNK);
182             return $self->{conn}{analyzer}->_data($dir,'',IMP_DATA_HTTP_JUNK)
183             if $eof and $data ne '';
184             }
185              
186             sub fatal {
187             my ($self,$reason) = @_;
188             $self->{conn}{analyzer}->run_callback([ IMP_DENY,0,$reason ]);
189             }
190              
191             1;
192             __END__