line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
3
|
|
|
3
|
|
28947
|
use strict; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
101
|
|
2
|
3
|
|
|
3
|
|
14
|
use warnings; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
119
|
|
3
|
3
|
|
|
3
|
|
16
|
no if $] >= 5.017011, warnings => 'experimental::smartmatch'; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
17
|
|
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
package Net::IMP::Filter; |
6
|
3
|
|
|
3
|
|
190
|
use Net::IMP; |
|
3
|
|
|
|
|
10
|
|
|
3
|
|
|
|
|
222
|
|
7
|
3
|
|
|
3
|
|
16
|
use Net::IMP::Debug; |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
19
|
|
8
|
3
|
|
|
3
|
|
926
|
use Hash::Util 'lock_ref_keys'; |
|
3
|
|
|
|
|
3872
|
|
|
3
|
|
|
|
|
16
|
|
9
|
3
|
|
|
3
|
|
193
|
use Scalar::Util 'weaken'; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
4260
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
############################################################################ |
13
|
|
|
|
|
|
|
# these need to be redefined in subclass |
14
|
|
|
|
|
|
|
############################################################################ |
15
|
|
|
|
|
|
|
# analyzed data output |
16
|
|
|
|
|
|
|
sub out { |
17
|
0
|
|
|
0
|
1
|
0
|
my ($self,$dir,$data) = @_; |
18
|
0
|
|
|
|
|
0
|
return; |
19
|
|
|
|
|
|
|
} |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
sub deny { |
22
|
0
|
|
|
0
|
1
|
0
|
my ($self,$msg,$dir,@extmsg) = @_; |
23
|
0
|
|
|
|
|
0
|
while (@extmsg) { |
24
|
0
|
|
|
|
|
0
|
my ($k,$v) = splice(@extmsg,0,2); |
25
|
0
|
|
|
|
|
0
|
$msg .= " $k:$v"; |
26
|
|
|
|
|
|
|
} |
27
|
0
|
0
|
|
|
|
0
|
$DEBUG && debug("deny $msg"); |
28
|
0
|
|
|
|
|
0
|
return; |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
sub fatal { |
32
|
0
|
|
|
0
|
1
|
0
|
my ($self,$msg) = @_; |
33
|
0
|
0
|
|
|
|
0
|
$DEBUG && debug("fatal $msg"); |
34
|
0
|
|
|
|
|
0
|
return; |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
sub log { |
38
|
0
|
|
|
0
|
1
|
0
|
my ($self,$level,$msg,$dir,$offset,$len,@extmsg) = @_; |
39
|
0
|
|
|
|
|
0
|
while (@extmsg) { |
40
|
0
|
|
|
|
|
0
|
my ($k,$v) = splice(@extmsg,0,2); |
41
|
0
|
|
|
|
|
0
|
$msg .= " $k:$v"; |
42
|
|
|
|
|
|
|
} |
43
|
0
|
0
|
|
|
|
0
|
$DEBUG && debug("log [$level] $msg"); |
44
|
0
|
|
|
|
|
0
|
return; |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
sub acctfld { |
48
|
0
|
|
|
0
|
1
|
0
|
my ($self,$key,$value) = @_; |
49
|
0
|
0
|
|
|
|
0
|
$DEBUG && debug("acctfld $key=$value"); |
50
|
0
|
|
|
|
|
0
|
return; |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
############################################################################ |
54
|
|
|
|
|
|
|
# Implementation |
55
|
|
|
|
|
|
|
############################################################################ |
56
|
|
|
|
|
|
|
sub new { |
57
|
10
|
|
|
10
|
1
|
29
|
my ($class,$imp,%args) = @_; |
58
|
10
|
50
|
|
|
|
25
|
if (ref($class)) { |
59
|
0
|
|
|
|
|
0
|
%args = (%$class, %args); |
60
|
0
|
|
0
|
|
|
0
|
$imp ||= $class->{imp}; |
61
|
|
|
|
|
|
|
} |
62
|
10
|
|
33
|
|
|
121
|
my $self = lock_ref_keys( bless { |
63
|
|
|
|
|
|
|
%args, |
64
|
|
|
|
|
|
|
imp => $imp, # analyzer object |
65
|
|
|
|
|
|
|
buf => [ |
66
|
|
|
|
|
|
|
# list of buffered data [ offset,buf,type ] per dir |
67
|
|
|
|
|
|
|
# buffers for same streaming type will be concatenated |
68
|
|
|
|
|
|
|
[ [0,'',0] ], |
69
|
|
|
|
|
|
|
[ [0,'',0] ], |
70
|
|
|
|
|
|
|
], |
71
|
|
|
|
|
|
|
pass => [0,0], # may pass up to this offset |
72
|
|
|
|
|
|
|
prepass => [0,0], # may prepass up to this offset |
73
|
|
|
|
|
|
|
skipped => [0,0], # flag if last data got not send to analyzer |
74
|
|
|
|
|
|
|
# because of pass into future |
75
|
|
|
|
|
|
|
eof => [0,0], # flag if eof received |
76
|
|
|
|
|
|
|
dead => 0, # set if deny|fatal received |
77
|
|
|
|
|
|
|
},(ref $class || $class) ); |
78
|
|
|
|
|
|
|
|
79
|
10
|
50
|
|
|
|
107
|
if ($imp) { |
80
|
10
|
|
|
|
|
36
|
weaken( my $weak = $self ); |
81
|
10
|
|
|
|
|
32
|
$imp->set_callback(\&_imp_cb,$weak); |
82
|
|
|
|
|
|
|
} |
83
|
10
|
|
|
|
|
25
|
return $self; |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
# data into analyzer |
87
|
|
|
|
|
|
|
sub in { |
88
|
25
|
|
|
25
|
1
|
166
|
my ($self,$dir,$data,$type) = @_; |
89
|
25
|
50
|
|
|
|
57
|
$self->{dead} and return; |
90
|
|
|
|
|
|
|
|
91
|
25
|
|
100
|
|
|
92
|
$type ||= IMP_DATA_STREAM; |
92
|
25
|
50
|
|
|
|
50
|
$DEBUG && debug("in($dir,$type) %d bytes",length($data)); |
93
|
|
|
|
|
|
|
|
94
|
25
|
100
|
|
|
|
83
|
$self->{eof}[$dir] = 1 if $data eq ''; |
95
|
25
|
50
|
|
|
|
59
|
return $self->out($dir,$data,$type) if ! $self->{imp}; |
96
|
|
|
|
|
|
|
|
97
|
25
|
|
|
|
|
40
|
my $buf = $self->{buf}[$dir]; |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
# (pre)pass as much as possible |
100
|
25
|
|
|
|
|
45
|
for my $w (qw(pass prepass)) { |
101
|
50
|
50
|
|
|
|
124
|
my $maxoff = $self->{$w}[$dir] or next; |
102
|
0
|
0
|
0
|
|
|
0
|
@$buf == 1 and ! $buf->[0][2] or die "buf should be empty"; |
103
|
0
|
0
|
0
|
|
|
0
|
if ( $maxoff == IMP_MAXOFFSET |
104
|
|
|
|
|
|
|
or $maxoff > $buf->[-1][0] + length($data) ) { |
105
|
0
|
0
|
|
|
|
0
|
$DEBUG && debug("can $w everything"); |
106
|
0
|
|
0
|
|
|
0
|
my $lastoff = $self->{skipped}[$dir] && $buf->[0][0]; |
107
|
0
|
|
|
|
|
0
|
$buf->[0][0] += length($data); |
108
|
0
|
|
|
|
|
0
|
$self->out($dir,$data,$type); |
109
|
0
|
0
|
0
|
|
|
0
|
if ($w eq 'prepass') { |
|
|
0
|
|
|
|
|
|
110
|
0
|
|
|
|
|
0
|
$self->{imp}->data($dir,$data,$lastoff,$type); |
111
|
0
|
|
|
|
|
0
|
$self->{skipped}[$dir] = 0; |
112
|
|
|
|
|
|
|
} elsif ( $data eq '' and $maxoff != IMP_MAXOFFSET ) { |
113
|
0
|
|
|
|
|
0
|
$self->{imp}->data($dir,$data,$lastoff,$type); |
114
|
0
|
|
|
|
|
0
|
$self->{skipped}[$dir] = 0; |
115
|
|
|
|
|
|
|
} else { |
116
|
0
|
|
|
|
|
0
|
$self->{skipped}[$dir] = 1; |
117
|
|
|
|
|
|
|
} |
118
|
0
|
|
|
|
|
0
|
return; |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
|
121
|
0
|
|
|
|
|
0
|
my $canfw = $maxoff - $buf->[-1][0]; |
122
|
0
|
0
|
0
|
|
|
0
|
if ( $type > 0 and $canfw != length($data)) { |
123
|
|
|
|
|
|
|
# packet types need to be handled as a single piece |
124
|
0
|
|
|
|
|
0
|
debug("partial $w for $type ignored"); |
125
|
0
|
|
|
|
|
0
|
next; |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
0
|
0
|
|
|
|
0
|
$DEBUG && debug("can $w %d bytes of %d", $canfw, length($data)); |
129
|
0
|
|
|
|
|
0
|
my $fwd = substr($data,0,$canfw,''); |
130
|
0
|
|
0
|
|
|
0
|
my $lastoff = $self->{skipped}[$dir] && $buf->[0][0]; |
131
|
0
|
|
|
|
|
0
|
$buf->[0][0] += length($fwd); |
132
|
0
|
|
|
|
|
0
|
$self->{$w}[$dir] = 0; # no more (pre)pass |
133
|
0
|
|
|
|
|
0
|
$self->out($dir,$fwd,$type); |
134
|
0
|
0
|
|
|
|
0
|
if ($w eq 'prepass') { |
135
|
0
|
|
|
|
|
0
|
$self->{imp}->data($dir,$fwd,$lastoff,$type); |
136
|
0
|
|
|
|
|
0
|
$self->{skipped}[$dir] = 0; |
137
|
|
|
|
|
|
|
} else { |
138
|
0
|
|
|
|
|
0
|
$self->{skipped}[$dir] = 1; |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
# data left which need to be forwarded to analyzer |
143
|
25
|
100
|
66
|
|
|
97
|
if ( ! $buf->[-1][2] ) { |
|
|
100
|
|
|
|
|
|
144
|
|
|
|
|
|
|
# replace empty (untyped) buffer with new data |
145
|
12
|
|
|
|
|
21
|
$buf->[-1][1] = $data; |
146
|
12
|
|
|
|
|
22
|
$buf->[-1][2] = $type; |
147
|
|
|
|
|
|
|
} elsif ( $type < 0 and $buf->[-1][2] == $type ) { |
148
|
|
|
|
|
|
|
# streaming data of same type can be added to current buffer |
149
|
12
|
|
|
|
|
24
|
$buf->[-1][1] .= $data; |
150
|
|
|
|
|
|
|
} else { |
151
|
|
|
|
|
|
|
# need new buffer |
152
|
1
|
|
|
|
|
4
|
push @$buf,[ |
153
|
|
|
|
|
|
|
$buf->[-1][0] + length($buf->[-1][1]), # base = end of last |
154
|
|
|
|
|
|
|
$data, |
155
|
|
|
|
|
|
|
$type |
156
|
|
|
|
|
|
|
]; |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
25
|
50
|
|
|
|
56
|
$DEBUG && debug("buffer and analyze %d bytes of data", length($data)); |
160
|
25
|
|
33
|
|
|
61
|
my $lastoff = $self->{skipped}[$dir] && $buf->[0][0]; |
161
|
25
|
|
|
|
|
76
|
$self->{imp}->data($dir,$data,$lastoff,$type); |
162
|
25
|
|
|
|
|
98
|
$self->{skipped}[$dir] = 0; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
# callback from analyzer |
166
|
|
|
|
|
|
|
sub _imp_cb { |
167
|
68
|
|
|
68
|
|
104
|
my $self = shift; |
168
|
68
|
50
|
|
|
|
141
|
$self->{dead} and return; |
169
|
|
|
|
|
|
|
|
170
|
68
|
|
|
|
|
92
|
my @fwd; |
171
|
68
|
|
|
|
|
112
|
for my $rv (@_) { |
172
|
71
|
|
|
|
|
119
|
my $rtype = shift(@$rv); |
173
|
71
|
50
|
|
|
|
145
|
$DEBUG && debug("$rtype ".join(" ",map { "'$_'" } @$rv)); |
|
0
|
|
|
|
|
0
|
|
174
|
|
|
|
|
|
|
|
175
|
71
|
50
|
|
|
|
327
|
if ( $rtype == IMP_DENY ) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
176
|
0
|
|
|
|
|
0
|
my ($dir,$msg,@extmsg) = @$rv; |
177
|
0
|
|
|
|
|
0
|
$self->deny($msg,$dir,@extmsg); |
178
|
0
|
|
|
|
|
0
|
$self->{dead} = 1; |
179
|
0
|
|
|
|
|
0
|
return; |
180
|
|
|
|
|
|
|
} elsif ( $rtype == IMP_FATAL ) { |
181
|
0
|
|
|
|
|
0
|
my $reason = shift; |
182
|
0
|
|
|
|
|
0
|
$self->fatal($reason); |
183
|
0
|
|
|
|
|
0
|
$self->{dead} = 1; |
184
|
0
|
|
|
|
|
0
|
return; |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
} elsif ( $rtype == IMP_LOG ) { |
187
|
0
|
|
|
|
|
0
|
my ($dir,$offset,$len,$level,$msg,@extmsg) = @$rv; |
188
|
0
|
|
|
|
|
0
|
$self->log($level,$msg,$dir,$offset,$len,@extmsg); |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
} elsif ( $rtype == IMP_ACCTFIELD ) { |
191
|
0
|
|
|
|
|
0
|
my ($key,$value) = @$rv; |
192
|
0
|
|
|
|
|
0
|
$self->acctfld($key,$value); |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
} elsif ( $rtype ~~ [ IMP_PASS, IMP_PREPASS ] ) { |
195
|
40
|
|
|
|
|
66
|
my ($dir,$offset) = @$rv; |
196
|
40
|
50
|
|
|
|
85
|
$DEBUG && debug("got %s %d|%d", $rtype,$dir,$offset); |
197
|
|
|
|
|
|
|
|
198
|
40
|
50
|
0
|
|
|
93
|
if ( $self->{pass}[$dir] == IMP_MAXOFFSET ) { |
|
|
50
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
199
|
0
|
|
|
|
|
0
|
next; # cannot get better than previous pass |
200
|
|
|
|
|
|
|
} elsif ( $rtype == IMP_PASS ) { |
201
|
40
|
100
|
|
|
|
92
|
if ( $offset == IMP_MAXOFFSET ) { |
|
|
50
|
|
|
|
|
|
202
|
9
|
|
|
|
|
13
|
$self->{pass}[$dir] = $offset; |
203
|
9
|
|
|
|
|
15
|
$self->{prepass}[$dir] = 0; |
204
|
|
|
|
|
|
|
} elsif ( $offset > $self->{pass}[$dir] ) { |
205
|
31
|
|
|
|
|
47
|
$self->{pass}[$dir] = $offset; |
206
|
|
|
|
|
|
|
$self->{prepass}[$dir] = 0 |
207
|
31
|
50
|
|
|
|
75
|
if $offset >= $self->{prepass}[$dir]; |
208
|
|
|
|
|
|
|
} else { |
209
|
0
|
|
|
|
|
0
|
next; # not better than previous pass |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
# IMP_PREPASS |
213
|
|
|
|
|
|
|
} elsif ( $offset == IMP_MAXOFFSET or ( |
214
|
|
|
|
|
|
|
$offset > $self->{pass}[$dir] and |
215
|
|
|
|
|
|
|
$offset > $self->{prepass}[$dir] )) { |
216
|
|
|
|
|
|
|
# update for prepass |
217
|
0
|
|
|
|
|
0
|
$self->{prepass}[$dir] = $offset |
218
|
|
|
|
|
|
|
} else { |
219
|
|
|
|
|
|
|
# next; # no better than previous prepass |
220
|
|
|
|
|
|
|
} |
221
|
|
|
|
|
|
|
|
222
|
40
|
|
|
|
|
61
|
my $buf = $self->{buf}[$dir]; |
223
|
40
|
|
|
|
|
52
|
my $end; |
224
|
|
|
|
|
|
|
|
225
|
40
|
|
|
|
|
86
|
while ($buf->[0][2]) { |
226
|
32
|
|
|
|
|
54
|
my $buf0 = shift(@$buf); |
227
|
32
|
|
|
|
|
50
|
$end = $buf0->[0] + length($buf0->[1]); |
228
|
32
|
100
|
66
|
|
|
150
|
if ( $offset == IMP_MAXOFFSET |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
229
|
|
|
|
|
|
|
or $offset >= $end ) { |
230
|
10
|
50
|
|
|
|
22
|
$DEBUG && debug("pass complete buf"); |
231
|
10
|
|
|
|
|
21
|
push @fwd, [ $dir, $buf0->[1], $buf0->[2] ]; |
232
|
|
|
|
|
|
|
# keep dummy in buf |
233
|
10
|
100
|
|
|
|
28
|
if ( ! @$buf ) { |
234
|
9
|
|
|
|
|
22
|
unshift @$buf,[ $buf0->[0] + length($buf0->[1]),'',0 ]; |
235
|
|
|
|
|
|
|
push @fwd,[$dir,'',$buf0->[2]] |
236
|
9
|
50
|
|
|
|
30
|
if $self->{eof}[$dir]; # fwd eof |
237
|
9
|
|
|
|
|
19
|
last; |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
} elsif ( $offset < $buf0->[0] ) { |
240
|
0
|
0
|
|
|
|
0
|
$DEBUG && debug("duplicate $rtype $offset ($buf0->[0])"); |
241
|
0
|
|
|
|
|
0
|
unshift @$buf,$buf0; |
242
|
0
|
|
|
|
|
0
|
last; |
243
|
|
|
|
|
|
|
} elsif ( $offset == $buf0->[0] ) { |
244
|
|
|
|
|
|
|
# at border, e.g. forward 0 bytes |
245
|
1
|
|
|
|
|
2
|
unshift @$buf,$buf0; |
246
|
1
|
|
|
|
|
2
|
last; |
247
|
|
|
|
|
|
|
} elsif ( $buf0->[2] < 0 ) { |
248
|
|
|
|
|
|
|
# streaming type, can pass part of buf |
249
|
21
|
50
|
|
|
|
44
|
$DEBUG && debug("pass part of buf"); |
250
|
21
|
|
|
|
|
66
|
push @fwd, [ |
251
|
|
|
|
|
|
|
$dir, |
252
|
|
|
|
|
|
|
substr($buf0->[1],0,$offset - $end,''), |
253
|
|
|
|
|
|
|
$buf0->[2], |
254
|
|
|
|
|
|
|
]; |
255
|
|
|
|
|
|
|
# put back with adjusted offset |
256
|
21
|
|
|
|
|
38
|
$buf0->[0] = $offset; |
257
|
21
|
|
|
|
|
34
|
unshift @$buf, $buf0; |
258
|
21
|
|
|
|
|
32
|
last; |
259
|
|
|
|
|
|
|
} else { |
260
|
0
|
0
|
|
|
|
0
|
$DEBUG && debug( |
261
|
|
|
|
|
|
|
"ignore partial $rtype for $buf0->[2] (offset=$offset,pos=$buf0->[0])"); |
262
|
0
|
|
|
|
|
0
|
unshift @$buf, $buf0; # put back |
263
|
0
|
|
|
|
|
0
|
last; |
264
|
|
|
|
|
|
|
} |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
|
267
|
40
|
100
|
66
|
|
|
151
|
if ( $offset != IMP_MAXOFFSET and $offset <= $end ) { |
268
|
|
|
|
|
|
|
# limit reached, reset (pre)pass |
269
|
31
|
50
|
|
|
|
94
|
$self->{ $rtype == IMP_PASS ? 'pass':'prepass' }[$dir] = 0; |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
} elsif ( $rtype == IMP_REPLACE ) { |
273
|
31
|
|
|
|
|
62
|
my ($dir,$offset,$newdata) = @$rv; |
274
|
31
|
50
|
|
|
|
64
|
$DEBUG && debug("got %s %d|%d", $rtype,$dir,$offset); |
275
|
|
|
|
|
|
|
|
276
|
31
|
50
|
33
|
|
|
126
|
if ( $self->{pass}[$dir] or $self->{prepass}[$dir] ) { |
277
|
|
|
|
|
|
|
# we are allowed to (pre)pass in future, so we cannot replace |
278
|
0
|
|
|
|
|
0
|
die "cannot replace already passed data"; |
279
|
|
|
|
|
|
|
} |
280
|
|
|
|
|
|
|
|
281
|
31
|
|
|
|
|
55
|
my $buf = $self->{buf}[$dir]; |
282
|
31
|
|
|
|
|
43
|
my $buf0 = $buf->[0]; |
283
|
31
|
|
|
|
|
52
|
my $eob = $buf0->[0] + length($buf0->[1]); |
284
|
31
|
50
|
|
|
|
71
|
if ( $eob < $offset ) { |
|
|
100
|
|
|
|
|
|
285
|
0
|
|
|
|
|
0
|
die "replacement cannot span different types or packets"; |
286
|
|
|
|
|
|
|
} elsif ( $eob == $offset ) { |
287
|
|
|
|
|
|
|
# full replace |
288
|
3
|
50
|
|
|
|
7
|
$DEBUG && debug("full replace"); |
289
|
3
|
|
|
|
|
8
|
push @fwd,[ $dir,$newdata,$buf0->[2] ]; |
290
|
3
|
|
|
|
|
4
|
shift(@$buf); |
291
|
3
|
50
|
|
|
|
14
|
push @$buf, [ $eob,'',0 ] if ! @$buf; |
292
|
|
|
|
|
|
|
} else { |
293
|
28
|
50
|
|
|
|
62
|
die "no partial replacement for packet types allowed" |
294
|
|
|
|
|
|
|
if $buf0->[2]>0; |
295
|
28
|
50
|
|
|
|
52
|
$DEBUG && debug("partial replace"); |
296
|
28
|
|
|
|
|
61
|
push @fwd,[ $dir,$newdata,$buf0->[2] ]; |
297
|
28
|
|
|
|
|
56
|
substr( $buf0->[1],0,$offset - $buf0->[0],''); |
298
|
28
|
|
|
|
|
61
|
$buf0->[0] = $offset; |
299
|
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
} elsif ( $rtype ~~ [ IMP_PAUSE, IMP_CONTINUE ] ) { |
302
|
|
|
|
|
|
|
# ignore |
303
|
|
|
|
|
|
|
} else { |
304
|
0
|
|
|
|
|
0
|
die "cannot handle Net::IMP rtype $rtype"; |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
} |
307
|
68
|
|
|
|
|
205
|
$self->out(@$_) for (@fwd); |
308
|
|
|
|
|
|
|
} |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
1; |
312
|
|
|
|
|
|
|
__END__ |