line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
2
|
|
|
2
|
|
24443
|
use strict; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
77
|
|
2
|
2
|
|
|
2
|
|
9
|
use warnings; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
80
|
|
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
package Net::IMP::HTTP::Connection; |
5
|
2
|
|
|
2
|
|
8
|
use base 'Net::IMP::Base'; |
|
2
|
|
|
|
|
7
|
|
|
2
|
|
|
|
|
1126
|
|
6
|
2
|
|
|
2
|
|
8648
|
use fields qw(dispatcher pos); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
15
|
|
7
|
2
|
|
|
2
|
|
108
|
use Net::IMP::HTTP; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
183
|
|
8
|
2
|
|
|
2
|
|
10
|
use Net::IMP; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
181
|
|
9
|
2
|
|
|
2
|
|
9
|
use Carp 'croak'; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
1371
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
# just define a typical set, maybe need to be redefined in subclass |
12
|
|
|
|
|
|
|
sub RTYPES { |
13
|
0
|
|
|
0
|
0
|
0
|
my $factory = shift; |
14
|
0
|
|
|
|
|
0
|
return (IMP_PASS, IMP_PREPASS, IMP_REPLACE, IMP_DENY, IMP_LOG) |
15
|
|
|
|
|
|
|
} |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
sub INTERFACE { |
18
|
2
|
|
|
2
|
0
|
24
|
my $factory = shift; |
19
|
2
|
|
|
|
|
6
|
my @rtx = my @rt = $factory->RTYPES; |
20
|
2
|
50
|
|
|
|
14
|
push @rtx, IMP_DENY if ! grep { IMP_DENY == $_ } @rtx; |
|
6
|
|
|
|
|
12
|
|
21
|
|
|
|
|
|
|
return ( |
22
|
2
|
|
|
|
|
10
|
[ IMP_DATA_HTTP, \@rt ], |
23
|
|
|
|
|
|
|
[ IMP_DATA_HTTPRQ, \@rt ], |
24
|
|
|
|
|
|
|
[ IMP_DATA_STREAM, \@rtx, 'Net::IMP::Adaptor::STREAM2HTTPConn' ], |
25
|
|
|
|
|
|
|
); |
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
sub set_interface { |
29
|
2
|
|
|
2
|
1
|
4472
|
my ($factory,$interface) = @_; |
30
|
2
|
100
|
|
|
|
11
|
my $newf = $factory->SUPER::set_interface($interface) |
31
|
|
|
|
|
|
|
or return; |
32
|
1
|
50
|
|
|
|
58
|
return $newf if $newf != $factory; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# original factory, set dispatcher based on input data type |
35
|
1
|
50
|
|
|
|
5
|
if ( $interface->[0] == IMP_DATA_HTTP ) { |
|
|
0
|
|
|
|
|
|
36
|
1
|
|
|
|
|
49
|
$factory->{dispatcher} = { |
37
|
|
|
|
|
|
|
IMP_DATA_HTTP_HEADER+0 => [ |
38
|
|
|
|
|
|
|
$factory->can('request_hdr'), |
39
|
|
|
|
|
|
|
$factory->can('response_hdr'), |
40
|
|
|
|
|
|
|
], |
41
|
|
|
|
|
|
|
IMP_DATA_HTTP_BODY+0 => [ |
42
|
|
|
|
|
|
|
$factory->can('request_body'), |
43
|
|
|
|
|
|
|
$factory->can('response_body'), |
44
|
|
|
|
|
|
|
], |
45
|
|
|
|
|
|
|
IMP_DATA_HTTP_CHKHDR+0 => [ |
46
|
|
|
|
|
|
|
undef, |
47
|
|
|
|
|
|
|
$factory->can('rsp_chunk_hdr') |
48
|
|
|
|
|
|
|
], |
49
|
|
|
|
|
|
|
IMP_DATA_HTTP_CHKTRAILER+0 => [ |
50
|
|
|
|
|
|
|
undef, |
51
|
|
|
|
|
|
|
$factory->can('rsp_chunk_trailer') |
52
|
|
|
|
|
|
|
], |
53
|
|
|
|
|
|
|
IMP_DATA_HTTP_DATA+0 => $factory->can('any_data'), |
54
|
|
|
|
|
|
|
IMP_DATA_HTTP_JUNK+0 => $factory->can('junk_data') |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
} elsif ( $interface->[0] == IMP_DATA_HTTPRQ ) { |
57
|
0
|
|
|
|
|
0
|
$factory->{dispatcher} = { |
58
|
|
|
|
|
|
|
# HTTP request interface |
59
|
|
|
|
|
|
|
IMP_DATA_HTTPRQ_HEADER+0 => [ |
60
|
|
|
|
|
|
|
$factory->can('request_hdr'), |
61
|
|
|
|
|
|
|
$factory->can('response_hdr'), |
62
|
|
|
|
|
|
|
], |
63
|
|
|
|
|
|
|
IMP_DATA_HTTPRQ_CONTENT+0 => [ |
64
|
|
|
|
|
|
|
$factory->can('request_body'), |
65
|
|
|
|
|
|
|
$factory->can('response_body'), |
66
|
|
|
|
|
|
|
], |
67
|
|
|
|
|
|
|
IMP_DATA_HTTPRQ_DATA+0 => $factory->can('any_data'), |
68
|
|
|
|
|
|
|
} |
69
|
|
|
|
|
|
|
} else { |
70
|
0
|
|
|
|
|
0
|
die "unknown input data type $interface->[0]" |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
1
|
|
|
|
|
3
|
return $factory; |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
sub new_analyzer { |
77
|
1
|
|
|
1
|
1
|
12
|
my ($factory,%args) = @_; |
78
|
1
|
|
|
|
|
6
|
my $analyzer = $factory->SUPER::new_analyzer(%args); |
79
|
1
|
|
|
|
|
136
|
$analyzer->{dispatcher} = $factory->{dispatcher}; |
80
|
1
|
|
|
|
|
2
|
return $analyzer; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
# we can overide data to handle the types directly, but per default we |
85
|
|
|
|
|
|
|
# dispatch to seperate methods |
86
|
|
|
|
|
|
|
sub data { |
87
|
0
|
|
|
0
|
1
|
|
my ($self,$dir,$data,$offset,$type) = @_; |
88
|
0
|
0
|
|
|
|
|
$self->{pos}[$dir] = $offset if $offset; |
89
|
0
|
|
|
|
|
|
$self->{pos}[$dir] += length($data); |
90
|
0
|
|
|
|
|
|
my $disp = $self->{dispatcher}; |
91
|
0
|
0
|
|
|
|
|
my $sub = $disp->{$type+0} or croak("cannot dispatch type $type".Data::Dumper::Dumper($disp)); |
92
|
0
|
0
|
|
|
|
|
if ( ref($sub) eq 'ARRAY' ) { |
93
|
0
|
0
|
|
|
|
|
$sub = $sub->[$dir] or croak("cannot dispatch type $type dir $dir"); |
94
|
0
|
|
|
|
|
|
$sub->($self,$data,$offset); |
95
|
|
|
|
|
|
|
} else { |
96
|
0
|
|
|
|
|
|
$sub->($self,$dir,$data,$offset); |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
sub offset { |
101
|
0
|
|
|
0
|
0
|
|
my ($self,$dir) = @_; |
102
|
0
|
|
0
|
|
|
|
return $self->{pos}[$dir] // 0; |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
########################################################################### |
106
|
|
|
|
|
|
|
# public interface |
107
|
|
|
|
|
|
|
# most of these methods need to be implemented in subclass |
108
|
|
|
|
|
|
|
########################################################################### |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
for my $subname ( |
111
|
|
|
|
|
|
|
'request_hdr', # ($self,$hdr) |
112
|
|
|
|
|
|
|
'request_body', # ($self,$data,[$offset]) |
113
|
|
|
|
|
|
|
'response_hdr', # ($self,$hdr) |
114
|
|
|
|
|
|
|
'response_body', # ($self,$data,[$offset]) |
115
|
|
|
|
|
|
|
'rsp_chunk_hdr', # ($self,$hdr) |
116
|
|
|
|
|
|
|
'rsp_chunk_trailer', # ($self,$hdr) |
117
|
|
|
|
|
|
|
'any_data', # ($self,$dir,$data,[$offset]) |
118
|
|
|
|
|
|
|
) { |
119
|
2
|
|
|
2
|
|
11
|
no strict 'refs'; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
208
|
|
120
|
0
|
|
|
0
|
|
|
*$subname = sub { croak("$subname needs to be implemented") } |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
# by default simply ignore junk data (leading \n before message header) |
124
|
|
|
|
|
|
|
sub junk_data { |
125
|
0
|
|
|
0
|
1
|
|
my ($self,$dir,$data,$offset) = @_; |
126
|
|
|
|
|
|
|
return |
127
|
0
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
1; |
132
|
|
|
|
|
|
|
__END__ |