line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Linux::PacketFilter; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
85044
|
use strict; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
52
|
|
4
|
2
|
|
|
2
|
|
9
|
use warnings; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
481
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
our $VERSION = '0.01_1'; |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
=encoding utf-8 |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
=head1 NAME |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
Linux::PacketFilter - Simple interface to Linux packet filtering |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=head1 SYNOPSIS |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
# Reject any packet that starts with a period: |
17
|
|
|
|
|
|
|
my $filter = Linux::PacketFilter->new( |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
# Load the accumulator with the 1st byte in the packet: |
20
|
|
|
|
|
|
|
[ 'ld b abs', 0 ], |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
# If the accumulator value is an ASCII period, continue; |
23
|
|
|
|
|
|
|
# otherwise, skip a line. (See below for what “k8” means.) |
24
|
|
|
|
|
|
|
[ 'jmp jeq k8', ord('.'), 0, 1 ], |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
# If we continued, we’ll get here and thus reject the packet. |
27
|
|
|
|
|
|
|
[ ret => 0 ], |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
# If we get here, we skipped a line above. That means |
30
|
|
|
|
|
|
|
# the packet’s first byte wasn’t an ASCII period, |
31
|
|
|
|
|
|
|
# so we'll return the full packet. |
32
|
|
|
|
|
|
|
[ ret => 0xffffffff ], |
33
|
|
|
|
|
|
|
); |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
$filter->apply( $socket ); |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
=head1 DESCRIPTION |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
This module is a simple, small, pure-Perl compiler for Linux’s |
40
|
|
|
|
|
|
|
“classic” Berkeley Packet Filter (BPF) implementation. |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
=head1 HOW TO USE THIS MODULE |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
If you’re familiar with BPF already, the SYNOPSIS above should mostly make |
45
|
|
|
|
|
|
|
sense “out-of-the-box”. If you’re new to BPF, though, take heart; it’s |
46
|
|
|
|
|
|
|
fairly straightforward. |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
The best source I have found for learning about BPF itself is |
49
|
|
|
|
|
|
|
L; |
50
|
|
|
|
|
|
|
see the section entitled B. |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
Linux-specific implementation notes are available in the kernel |
53
|
|
|
|
|
|
|
source tree at L. This contains a lot of detail |
54
|
|
|
|
|
|
|
about uses for BPF that don't pertain to packet filtering, though. |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
L Take |
57
|
|
|
|
|
|
|
especial note of the need to convert between network and host byte order. |
58
|
|
|
|
|
|
|
(See below for a convenience that this module provides for this conversion.) |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
You might also take interest in L. |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
B This module works with Linux’s I<“classic”> BPF, not the |
63
|
|
|
|
|
|
|
much more powerful (and complex) “extended” BPF. |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=cut |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
my %BPF; |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
sub _populate_BPF { |
70
|
2
|
|
|
2
|
|
14
|
%BPF = ( |
71
|
|
|
|
|
|
|
w => 0x00, # 32-bit word |
72
|
|
|
|
|
|
|
h => 0x08, # 16-bit half-word |
73
|
|
|
|
|
|
|
b => 0x10, # 8-bit byte |
74
|
|
|
|
|
|
|
# dw => 0x18, # 64-bit double word |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
k => 0x00, # given constant |
77
|
|
|
|
|
|
|
x => 0x08, # index register |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
# Conveniences: |
80
|
|
|
|
|
|
|
k_n8 => 0x00, |
81
|
|
|
|
|
|
|
k_n16 => 0x00, |
82
|
|
|
|
|
|
|
k_n32 => 0x00, |
83
|
|
|
|
|
|
|
); |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
# ld = to accumulator |
86
|
|
|
|
|
|
|
# ldx = to index |
87
|
|
|
|
|
|
|
# st = accumulator to scratch[k] |
88
|
|
|
|
|
|
|
# stx = index to scratch[k] |
89
|
2
|
|
|
|
|
7
|
my @inst = qw( ld ldx st stx alu jmp ret misc ); |
90
|
2
|
|
|
|
|
9
|
for my $i ( 0 .. $#inst ) { |
91
|
16
|
|
|
|
|
33
|
$BPF{ $inst[$i] } = $i; |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
# Load accumulator: |
95
|
|
|
|
|
|
|
# imm = k |
96
|
|
|
|
|
|
|
# abs = offset into packet |
97
|
|
|
|
|
|
|
# ind = index + k |
98
|
|
|
|
|
|
|
# mem = scratch[k] |
99
|
|
|
|
|
|
|
# len = packet length |
100
|
|
|
|
|
|
|
# msh = IP header length (hack ..) |
101
|
2
|
|
|
|
|
15
|
my @code = qw( imm abs ind mem len msh ); |
102
|
2
|
|
|
|
|
5
|
for my $i ( 0 .. $#code ) { |
103
|
12
|
|
|
|
|
23
|
$BPF{ $code[$i] } = ( $i << 5 ); |
104
|
|
|
|
|
|
|
} |
105
|
|
|
|
|
|
|
|
106
|
2
|
|
|
|
|
8
|
my @alu = qw( add sub mul div or and lsh rsh neg mod xor ); |
107
|
2
|
|
|
|
|
4
|
for my $i ( 0 .. $#alu ) { |
108
|
22
|
|
|
|
|
51
|
$BPF{ $alu[$i] } = ( $i << 4 ); |
109
|
|
|
|
|
|
|
} |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
# ja = move forward k |
112
|
|
|
|
|
|
|
# jeq = move (A == k) ? jt : jf |
113
|
|
|
|
|
|
|
# jset = (A & k) |
114
|
2
|
|
|
|
|
6
|
my @j = qw( ja jeq jgt jge jset ); |
115
|
2
|
|
|
|
|
6
|
for my $i ( 0 .. $#j ) { |
116
|
10
|
|
|
|
|
17
|
$BPF{ $j[$i] } = ( $i << 4 ); |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
2
|
|
|
|
|
7
|
return; |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
=head1 METHODS |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=head2 $obj = I->new( @filters ) |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
Creates an object that represents an array of instructions for |
127
|
|
|
|
|
|
|
the BPF filter machine. Each @filters member is an array reference |
128
|
|
|
|
|
|
|
that represents a single instruction and has either 2 or 4 members, |
129
|
|
|
|
|
|
|
which correspond with the BPF_STMT and BPF_JUMP macros, respectively. |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
The first member of each array reference is, rather than a number, |
132
|
|
|
|
|
|
|
a space-separated string of options, lower-cased and without the |
133
|
|
|
|
|
|
|
leading C. So where in C you would write: |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
BPF_LD | BPF_W | BPF_ABS |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
... in this module you write: |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
'ld w abs' |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
The full list of options for a single instruction is: |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
=over |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
=item * C, C, C, C, C, C, C (See below for |
146
|
|
|
|
|
|
|
an explanation of the last two.) |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=item * C, C, C, C, C, C, C, C |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
=item * C, C, C, C, C, C |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
=item * C, C, C, C |
153
|
|
|
|
|
|
|
C, C, C |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=item * C, C, C, C, C |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
=back |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
=head3 Byte order conversion |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
Since it’s common to need to do byte order conversions with |
162
|
|
|
|
|
|
|
packet filtering, Linux::PacketFilter adds a convenience for this: |
163
|
|
|
|
|
|
|
the codes C and C indicate to encode the given constant value |
164
|
|
|
|
|
|
|
in 16-bit or 32-bit network byte order, respectively. |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
Note that Linux I consumes BPF instruction constants in |
167
|
|
|
|
|
|
|
B. Thus, if you’re on a little-endian system, to |
168
|
|
|
|
|
|
|
match against numbers that are in host order (e.g., numbers in Netlink |
169
|
|
|
|
|
|
|
headers) you’ll need to do a byte-order conversion. |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
To add to the fun: when BPF compares a 16- or 8-bit number from “k”, |
172
|
|
|
|
|
|
|
it expects to do so from the first available register. This works fine |
173
|
|
|
|
|
|
|
on little-endian systems, but on big-endian systems that means |
174
|
|
|
|
|
|
|
It would be more natural for this module to encode the constants |
175
|
|
|
|
|
|
|
in network order; however, that would also put it at variance with C |
176
|
|
|
|
|
|
|
implementations, which would compromise the usefulness of existing |
177
|
|
|
|
|
|
|
documentation. |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=cut |
180
|
|
|
|
|
|
|
|
181
|
2
|
|
|
2
|
|
13
|
use constant _is_big_endian => pack('n', 1) eq pack('S', 1); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
196
|
|
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
use constant { |
184
|
2
|
|
|
|
|
189
|
_INSTR_PACK => 'S CC L', |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
_NETWORK_INSTR_PACK => { |
187
|
|
|
|
|
|
|
'k_n8' => _is_big_endian ? 'S CC N' : 'S CC C x3', |
188
|
|
|
|
|
|
|
'k_n16' => _is_big_endian ? 'S CC N' : 'S CC n x2', |
189
|
|
|
|
|
|
|
'k_n32' => 'S CC N', |
190
|
|
|
|
|
|
|
}, |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
_ARRAY_PACK => 'S x![P] P', |
193
|
2
|
|
|
2
|
|
13
|
}; |
|
2
|
|
|
|
|
12
|
|
194
|
|
|
|
|
|
|
|
195
|
2
|
|
|
2
|
|
12
|
use constant _INSTR_LEN => length( pack _INSTR_PACK() ); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
671
|
|
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
sub new { |
198
|
7
|
|
|
7
|
1
|
8163
|
my $class = shift; |
199
|
|
|
|
|
|
|
|
200
|
7
|
100
|
|
|
|
25
|
_populate_BPF() if !%BPF; |
201
|
|
|
|
|
|
|
|
202
|
7
|
|
|
|
|
25
|
my $buf = ("\0" x (_INSTR_LEN() * @_)); |
203
|
|
|
|
|
|
|
|
204
|
7
|
|
|
|
|
10
|
my $f = 0; |
205
|
|
|
|
|
|
|
|
206
|
7
|
|
|
|
|
13
|
for my $filter (@_) { |
207
|
26
|
|
|
|
|
46
|
my $code = 0; |
208
|
|
|
|
|
|
|
|
209
|
26
|
|
|
|
|
36
|
my $tmpl; |
210
|
|
|
|
|
|
|
|
211
|
26
|
|
|
|
|
96
|
for my $piece ( split m<\s+>, $filter->[0] ) { |
212
|
64
|
|
50
|
|
|
110
|
$code |= ($BPF{$piece} // die "Unknown BPF option: “$piece”"); |
213
|
|
|
|
|
|
|
|
214
|
64
|
|
66
|
|
|
142
|
$tmpl ||= _NETWORK_INSTR_PACK()->{$piece}; |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
substr( |
218
|
|
|
|
|
|
|
$buf, $f, _INSTR_LEN(), |
219
|
|
|
|
|
|
|
pack( |
220
|
|
|
|
|
|
|
( $tmpl || _INSTR_PACK() ), |
221
|
|
|
|
|
|
|
$code, |
222
|
26
|
100
|
100
|
|
|
111
|
(@$filter == 2) ? (0, 0, $filter->[1]) : @{$filter}[2, 3, 1], |
|
6
|
|
|
|
|
16
|
|
223
|
|
|
|
|
|
|
), |
224
|
|
|
|
|
|
|
); |
225
|
|
|
|
|
|
|
|
226
|
26
|
|
|
|
|
42
|
$f += _INSTR_LEN(); |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
|
229
|
7
|
|
|
|
|
39
|
return bless [ pack(_ARRAY_PACK(), 0 + @_, $buf), $buf ], $class; |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
=head2 $ok = I->attach( $SOCKET ) |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
Attaches the filter instructions to the given $SOCKET. |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
Note that this class purposely omits public access to the value that |
237
|
|
|
|
|
|
|
is given to the underlying L system call. This is because |
238
|
|
|
|
|
|
|
that value contains a pointer to a Perl string. That pointer is only valid |
239
|
|
|
|
|
|
|
during this object’s lifetime, and bad stuff (e.g., segmentation faults) |
240
|
|
|
|
|
|
|
can happen when you give the kernel pointers to strings that Perl has |
241
|
|
|
|
|
|
|
already garbage-collected. |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
The return is the same as the underlying call to Perl’s |
244
|
|
|
|
|
|
|
L built-in. C<$!> is set as that function leaves it. |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
=cut |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
sub attach { |
249
|
6
|
|
|
6
|
1
|
48
|
my ($self, $socket) = @_; |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
# For no good reason, Perl require() clobbers $@ and $!. |
252
|
6
|
|
|
|
|
8
|
do { |
253
|
6
|
|
|
|
|
31
|
local ($@, $!); |
254
|
6
|
|
|
|
|
35
|
require Socket; |
255
|
|
|
|
|
|
|
}; |
256
|
|
|
|
|
|
|
|
257
|
6
|
|
|
|
|
3256
|
return setsockopt $socket, Socket::SOL_SOCKET(), Socket::SO_ATTACH_FILTER(), $self->[0]; |
258
|
|
|
|
|
|
|
} |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
#---------------------------------------------------------------------- |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
1; |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
=head1 AUTHOR |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
Copyright 2019 Gasper Software Consulting (L) |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
=head1 SEE ALSO |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
L suits a similar purpose to this |
271
|
|
|
|
|
|
|
module’s but appears to be geared solely toward PF_PACKET sockets. |
272
|
|
|
|
|
|
|
It also defines its own language for specifying the filters, which I find |
273
|
|
|
|
|
|
|
less helpful than this module’s approach of “porting” the C macros |
274
|
|
|
|
|
|
|
to Perl, thus better capitalizing on existing documention. |