line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
8
|
|
|
8
|
|
26313
|
use strict; |
|
8
|
|
|
|
|
16
|
|
|
8
|
|
|
|
|
192
|
|
2
|
8
|
|
|
8
|
|
39
|
use warnings; |
|
8
|
|
|
|
|
16
|
|
|
8
|
|
|
|
|
343
|
|
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
package Net::IMP; |
5
|
|
|
|
|
|
|
our $VERSION = '0.634'; |
6
|
|
|
|
|
|
|
|
7
|
8
|
|
|
8
|
|
41
|
use Carp 'croak'; |
|
8
|
|
|
|
|
10
|
|
|
8
|
|
|
|
|
429
|
|
8
|
8
|
|
|
8
|
|
40
|
use Scalar::Util 'dualvar'; |
|
8
|
|
|
|
|
18
|
|
|
8
|
|
|
|
|
538
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
# map set_debug into local namespace for convinience, so that one |
11
|
|
|
|
|
|
|
# can call Net::IMP->set_debug instead of Net::IMP::Debug->set_debug |
12
|
8
|
|
|
8
|
|
2539
|
use Net::IMP::Debug 'set_debug'; |
|
8
|
|
|
|
|
30
|
|
|
8
|
|
|
|
|
37
|
|
13
|
|
|
|
|
|
|
|
14
|
8
|
|
|
8
|
|
44
|
use Exporter 'import'; |
|
8
|
|
|
|
|
16
|
|
|
8
|
|
|
|
|
701
|
|
15
|
|
|
|
|
|
|
our @EXPORT = qw( |
16
|
|
|
|
|
|
|
IMP_PASS |
17
|
|
|
|
|
|
|
IMP_PASS_PATTERN |
18
|
|
|
|
|
|
|
IMP_PREPASS |
19
|
|
|
|
|
|
|
IMP_DENY |
20
|
|
|
|
|
|
|
IMP_DROP |
21
|
|
|
|
|
|
|
IMP_TOSENDER |
22
|
|
|
|
|
|
|
IMP_REPLACE |
23
|
|
|
|
|
|
|
IMP_REPLACE_LATER |
24
|
|
|
|
|
|
|
IMP_PAUSE |
25
|
|
|
|
|
|
|
IMP_CONTINUE |
26
|
|
|
|
|
|
|
IMP_LOG |
27
|
|
|
|
|
|
|
IMP_PORT_OPEN |
28
|
|
|
|
|
|
|
IMP_PORT_CLOSE |
29
|
|
|
|
|
|
|
IMP_ACCTFIELD |
30
|
|
|
|
|
|
|
IMP_FATAL |
31
|
|
|
|
|
|
|
IMP_MAXOFFSET |
32
|
|
|
|
|
|
|
IMP_DATA_STREAM |
33
|
|
|
|
|
|
|
IMP_DATA_PACKET |
34
|
|
|
|
|
|
|
); |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
my @log_levels = qw( |
37
|
|
|
|
|
|
|
IMP_LOG_DEBUG |
38
|
|
|
|
|
|
|
IMP_LOG_INFO |
39
|
|
|
|
|
|
|
IMP_LOG_NOTICE |
40
|
|
|
|
|
|
|
IMP_LOG_WARNING |
41
|
|
|
|
|
|
|
IMP_LOG_ERR |
42
|
|
|
|
|
|
|
IMP_LOG_CRIT |
43
|
|
|
|
|
|
|
IMP_LOG_ALERT |
44
|
|
|
|
|
|
|
IMP_LOG_EMERG |
45
|
|
|
|
|
|
|
); |
46
|
|
|
|
|
|
|
our @EXPORT_OK = (@log_levels, 'IMP_DATA','IMP_DATA_TYPES', 'IMP_PASS_IF_BUSY'); |
47
|
|
|
|
|
|
|
our %EXPORT_TAGS = ( log => \@log_levels ); |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
# data types/protocols |
50
|
|
|
|
|
|
|
# These two are the basic types, more application specific types might |
51
|
|
|
|
|
|
|
# be defined somewhere else and be mapped to a number within supported_dtypes. |
52
|
|
|
|
|
|
|
# The only important thing is, that streaming data should be <0, while |
53
|
|
|
|
|
|
|
# packetized data (like HTTP header or UDP datagrams) should be > 0 |
54
|
|
|
|
|
|
|
# If no explicit type is given in sub data, it will assume IMP_DATA_STREAM. |
55
|
8
|
|
|
8
|
|
41
|
use constant IMP_DATA_STREAM => dualvar(-1,'imp.data.stream'); |
|
8
|
|
|
|
|
14
|
|
|
8
|
|
|
|
|
642
|
|
56
|
8
|
|
|
8
|
|
41
|
use constant IMP_DATA_PACKET => dualvar(+1,'imp.data.packet'); |
|
8
|
|
|
|
|
11
|
|
|
8
|
|
|
|
|
385
|
|
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
# the numerical order of the constants describes priority when |
60
|
|
|
|
|
|
|
# cascading modules, e.g. replacement has a higher value then |
61
|
|
|
|
|
|
|
# pass and gets thus forwarded as the cause for the data |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
### information only |
64
|
8
|
|
|
8
|
|
38
|
use constant IMP_LOG => dualvar(0x0001,"log"); |
|
8
|
|
|
|
|
25
|
|
|
8
|
|
|
|
|
352
|
|
65
|
8
|
|
|
8
|
|
37
|
use constant IMP_PORT_OPEN => dualvar(0x0002,"port_open"); |
|
8
|
|
|
|
|
12
|
|
|
8
|
|
|
|
|
333
|
|
66
|
8
|
|
|
8
|
|
37
|
use constant IMP_PORT_CLOSE => dualvar(0x0003,"port_close"); |
|
8
|
|
|
|
|
19
|
|
|
8
|
|
|
|
|
358
|
|
67
|
8
|
|
|
8
|
|
36
|
use constant IMP_ACCTFIELD => dualvar(0x0004,"acctfield"); |
|
8
|
|
|
|
|
15
|
|
|
8
|
|
|
|
|
354
|
|
68
|
|
|
|
|
|
|
### flow control |
69
|
8
|
|
|
8
|
|
45
|
use constant IMP_PAUSE => dualvar(0x0010,"pause"); |
|
8
|
|
|
|
|
15
|
|
|
8
|
|
|
|
|
365
|
|
70
|
8
|
|
|
8
|
|
37
|
use constant IMP_CONTINUE => dualvar(0x0011,"continue"); |
|
8
|
|
|
|
|
16
|
|
|
8
|
|
|
|
|
350
|
|
71
|
8
|
|
|
8
|
|
37
|
use constant IMP_REPLACE_LATER => dualvar(0x0012,"replace_later"); |
|
8
|
|
|
|
|
13
|
|
|
8
|
|
|
|
|
358
|
|
72
|
|
|
|
|
|
|
### keep data |
73
|
8
|
|
|
8
|
|
36
|
use constant IMP_PASS => dualvar(0x1001,"pass"); |
|
8
|
|
|
|
|
14
|
|
|
8
|
|
|
|
|
368
|
|
74
|
8
|
|
|
8
|
|
38
|
use constant IMP_PASS_PATTERN => dualvar(0x1002,"pass_pattern"); |
|
8
|
|
|
|
|
14
|
|
|
8
|
|
|
|
|
373
|
|
75
|
8
|
|
|
8
|
|
36
|
use constant IMP_PREPASS => dualvar(0x1003,"prepass"); |
|
8
|
|
|
|
|
18
|
|
|
8
|
|
|
|
|
342
|
|
76
|
|
|
|
|
|
|
### change data |
77
|
8
|
|
|
8
|
|
64
|
use constant IMP_TOSENDER => dualvar(0x1010,"tosender"); |
|
8
|
|
|
|
|
15
|
|
|
8
|
|
|
|
|
346
|
|
78
|
8
|
|
|
8
|
|
38
|
use constant IMP_REPLACE => dualvar(0x1011,"replace"); |
|
8
|
|
|
|
|
16
|
|
|
8
|
|
|
|
|
322
|
|
79
|
|
|
|
|
|
|
### affect whole connection |
80
|
8
|
|
|
8
|
|
48
|
use constant IMP_DENY => dualvar(0x1100,"deny"); |
|
8
|
|
|
|
|
15
|
|
|
8
|
|
|
|
|
363
|
|
81
|
8
|
|
|
8
|
|
38
|
use constant IMP_DROP => dualvar(0x1101,"drop"); |
|
8
|
|
|
|
|
15
|
|
|
8
|
|
|
|
|
344
|
|
82
|
8
|
|
|
8
|
|
37
|
use constant IMP_FATAL => dualvar(0x1102,"fatal"); |
|
8
|
|
|
|
|
14
|
|
|
8
|
|
|
|
|
397
|
|
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
# these return values still get sent if the data provider is busy |
85
|
|
|
|
|
|
|
# the most important are on top |
86
|
8
|
|
|
|
|
312
|
use constant IMP_PASS_IF_BUSY => [ |
87
|
|
|
|
|
|
|
IMP_FATAL, |
88
|
|
|
|
|
|
|
IMP_DENY, |
89
|
|
|
|
|
|
|
IMP_DROP, |
90
|
|
|
|
|
|
|
IMP_PAUSE, |
91
|
|
|
|
|
|
|
IMP_CONTINUE, |
92
|
|
|
|
|
|
|
IMP_ACCTFIELD |
93
|
8
|
|
|
8
|
|
38
|
]; |
|
8
|
|
|
|
|
16
|
|
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
# marker for (pre)pass to Infinite for IMP_PASS, IMP_PREPASS |
97
|
8
|
|
|
8
|
|
43
|
use constant IMP_MAXOFFSET => -1; |
|
8
|
|
|
|
|
58
|
|
|
8
|
|
|
|
|
335
|
|
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
# log levels for IMP_LOG |
100
|
|
|
|
|
|
|
# these are modeled analog to syslog levels |
101
|
8
|
|
|
8
|
|
43
|
use constant IMP_LOG_DEBUG => dualvar(1,'debug'); |
|
8
|
|
|
|
|
14
|
|
|
8
|
|
|
|
|
322
|
|
102
|
8
|
|
|
8
|
|
38
|
use constant IMP_LOG_INFO => dualvar(2,'info'); |
|
8
|
|
|
|
|
16
|
|
|
8
|
|
|
|
|
319
|
|
103
|
8
|
|
|
8
|
|
37
|
use constant IMP_LOG_NOTICE => dualvar(3,'notice'); |
|
8
|
|
|
|
|
12
|
|
|
8
|
|
|
|
|
336
|
|
104
|
8
|
|
|
8
|
|
39
|
use constant IMP_LOG_WARNING => dualvar(4,'warning'); |
|
8
|
|
|
|
|
17
|
|
|
8
|
|
|
|
|
315
|
|
105
|
8
|
|
|
8
|
|
35
|
use constant IMP_LOG_ERR => dualvar(5,'error'); |
|
8
|
|
|
|
|
17
|
|
|
8
|
|
|
|
|
341
|
|
106
|
8
|
|
|
8
|
|
38
|
use constant IMP_LOG_CRIT => dualvar(6,'critical'); |
|
8
|
|
|
|
|
12
|
|
|
8
|
|
|
|
|
345
|
|
107
|
8
|
|
|
8
|
|
37
|
use constant IMP_LOG_ALERT => dualvar(7,'alert'); |
|
8
|
|
|
|
|
11
|
|
|
8
|
|
|
|
|
316
|
|
108
|
8
|
|
|
8
|
|
746
|
use constant IMP_LOG_EMERG => dualvar(8,'emergency'); |
|
8
|
|
|
|
|
17
|
|
|
8
|
|
|
|
|
2885
|
|
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
# helper function to define new IMP_DATA_* types for protocols |
112
|
|
|
|
|
|
|
{ |
113
|
|
|
|
|
|
|
my @dualvars = ( IMP_DATA_STREAM, IMP_DATA_PACKET ); |
114
|
0
|
|
|
0
|
0
|
0
|
sub IMP_DATA_TYPES { return @dualvars } |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
my %atoi = map {( "$_" => $_+0 )} @dualvars; |
117
|
|
|
|
|
|
|
my %itoa = map {( $_+0 => "$_" )} @dualvars; |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
# $basename - name which gets used in constant name, e.g. 'http' makes |
120
|
|
|
|
|
|
|
# IMP_DATA_HTTP_..... Best would be name of IP service. |
121
|
|
|
|
|
|
|
# - if name[number] will use number as base type number |
122
|
|
|
|
|
|
|
# - if name[other_name+number] will base types on already defined |
123
|
|
|
|
|
|
|
# types with number added as offset |
124
|
|
|
|
|
|
|
# - if no number given it will use port name from getservbyname, |
125
|
|
|
|
|
|
|
# multiplied with 0x10000 and die if no such service is defined |
126
|
|
|
|
|
|
|
# @def: list of defname => [+-]offset which will result in a definition |
127
|
|
|
|
|
|
|
# of IMP_DATA_BASENAME_DEFNAME => [+-](base+offset), e.g. '+' for packet |
128
|
|
|
|
|
|
|
# types and '-' for stream types |
129
|
|
|
|
|
|
|
sub IMP_DATA { |
130
|
1
|
|
|
1
|
0
|
221
|
my ($basename,@def) = @_; |
131
|
1
|
|
|
|
|
3
|
my $basenum; |
132
|
1
|
50
|
|
|
|
6
|
if ( $basename =~s{\[(?:(\w+)\+)?(\d+)\]$}{} ) { |
133
|
0
|
|
|
|
|
0
|
(my $base,$basenum) = ($1,$2); |
134
|
0
|
0
|
|
|
|
0
|
if ( $base ) { |
135
|
0
|
0
|
|
|
|
0
|
my $offset = $atoi{$base} |
136
|
|
|
|
|
|
|
or croak("cannot find base type $base"); |
137
|
0
|
|
|
|
|
0
|
$basenum += $offset; |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
} else { |
140
|
1
|
50
|
33
|
|
|
550
|
$basenum = getservbyname($basename,'tcp' ) |
141
|
|
|
|
|
|
|
|| getservbyname($basename,'udp' ) |
142
|
|
|
|
|
|
|
or croak("cannot determine id for $basename"); |
143
|
1
|
|
|
|
|
5
|
$basenum = $basenum << 16; |
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
1
|
|
|
|
|
2
|
my @const; |
147
|
|
|
|
|
|
|
|
148
|
1
|
|
|
|
|
4
|
my $pkg = caller; |
149
|
1
|
|
|
|
|
4
|
unshift(@def,'',0); |
150
|
1
|
|
|
|
|
3
|
while (@def) { |
151
|
6
|
|
|
|
|
12
|
my $name = shift(@def); |
152
|
6
|
|
|
|
|
8
|
my $diff = shift(@def); |
153
|
6
|
100
|
|
|
|
16
|
my $lname = $name ne '' ? "$basename.$name" : $basename; |
154
|
6
|
50
|
|
|
|
13
|
croak("$lname already defined") if exists $atoi{$lname}; |
155
|
6
|
100
|
|
|
|
17
|
my $lnum = $diff>=0 ? $basenum + $diff : -$basenum+$diff; |
156
|
6
|
50
|
33
|
|
|
28
|
if ( my $s = $itoa{$lnum} || $itoa{-$lnum} ) { |
157
|
0
|
|
|
|
|
0
|
croak("id $lnum alreday used for $s"); |
158
|
|
|
|
|
|
|
} |
159
|
6
|
|
|
|
|
15
|
$atoi{$lname} = $lnum; |
160
|
6
|
|
|
|
|
12
|
$itoa{$lnum} = $lname; |
161
|
|
|
|
|
|
|
|
162
|
6
|
|
|
|
|
16
|
my $string = "imp.data.$lname"; |
163
|
6
|
|
|
|
|
20
|
( my $const = uc($string) )=~s{\.}{_}g; |
164
|
6
|
|
|
|
|
12
|
push @const,$const; |
165
|
|
|
|
|
|
|
|
166
|
8
|
|
|
8
|
|
52
|
no strict 'refs'; |
|
8
|
|
|
|
|
15
|
|
|
8
|
|
|
|
|
938
|
|
167
|
6
|
|
|
|
|
17
|
my $var = dualvar($lnum,$string); |
168
|
6
|
|
|
0
|
|
27
|
*{ "${pkg}::$const" } = sub () { $var }; |
|
6
|
|
|
|
|
27
|
|
|
0
|
|
|
|
|
0
|
|
169
|
6
|
|
|
|
|
19
|
push @dualvars, $var; |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
|
172
|
1
|
|
|
|
|
6
|
return @const; |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
1; |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
__END__ |