view release on metacpan or  search on metacpan

lib/Linux/PacketFilter.pm  view on Meta::CPAN

=item * C<b>, C<h>, C<w>

=item * C<x>, C<k>, C<k_n>, C<k_N> (See below for
an explanation of the last two.)

=item * C<ld>, C<ldx>, C<st>, C<stx>, C<alu>, C<jmp>, C<ret>, C<misc>

=item * C<imm>, C<abs>, C<ind>, C<mem>, C<len>, C<msh>

=item * C<add>, C<sub>, C<mul>, C<div>, C<or>, C<and>, C<lsh>, C<rsh>,
C<neg>, C<mod>, C<xor>

=item * C<ja>, C<jeq>, C<jgt>, C<jge>, C<jset>

=back

=head3 Byte order conversion

Since it’s common to need to do byte order conversions with
packet filtering, Linux::PacketFilter adds a convenience for this:
the codes C<k_n> and C<k_N> indicate to encode the given constant value
in 16-bit or 32-bit network byte order, respectively. These have the same
effect as calling C<htons(3)> and C<htonl(3)> in C.

B<NOTE:> Linux’s exact behavior regarding byte order in BPF isn’t
always clear, and this module is only tested thus far on little-endian
systems. It seems that only certain operations, like C<jeq>, require the
conversion.

=cut

use constant _is_big_endian => pack('n', 1) eq pack('S', 1);

use constant {
    _INSTR_PACK => 'S CC L',

    _NETWORK_INSTR_PACK => {
        'k_n' => _is_big_endian ? 'S CC N' : 'S CC n x2',
        'k_N' => 'S CC N',
    },

    _ARRAY_PACK => 'S x![P] P',
};

use constant _INSTR_LEN => length( pack _INSTR_PACK() );

sub new {
    my $class = shift;

    _populate_BPF() if !%BPF;

    my $buf = ("\0" x (_INSTR_LEN() * @_));

    my $f = 0;

    for my $filter (@_) {
        my $code = 0;

        my $tmpl;

        for my $piece ( split m<\s+>, $filter->[0] ) {
            $code |= ($BPF{$piece} // die "Unknown BPF option: “$piece”");

            $tmpl ||= _NETWORK_INSTR_PACK()->{$piece};
        }

        substr(
            $buf, $f, _INSTR_LEN(),
            pack(
                ( $tmpl || _INSTR_PACK() ),
                $code,
                (@$filter == 2) ? (0, 0, $filter->[1]) : @{$filter}[2, 3, 1],
            ),
        );

        $f += _INSTR_LEN();
    }

    return bless [ pack(_ARRAY_PACK(), 0 + @_, $buf), $buf ], $class;
}

=head2 $ok = I<OBJ>->attach( $SOCKET )

Attaches the filter instructions to the given $SOCKET.

Note that this class purposely omits public access to the value that
is given to the underlying L<setsockopt(2)> system call. This is because
that value contains a pointer to a Perl string. That pointer is only valid
during this object’s lifetime, and bad stuff (e.g., segmentation faults)
can happen when you give the kernel pointers to strings that Perl has
already garbage-collected.

The return is the same as the underlying call to Perl’s
L<perlfunc/setsockopt> built-in. C<$!> is set as that function leaves it.

=cut

sub attach {
    my ($self, $socket) = @_;

    # For no good reason, Perl require() clobbers $@ and $!.
    do {
        local ($@, $!);
        require Socket;
    };

    return setsockopt $socket, Socket::SOL_SOCKET(), Socket::SO_ATTACH_FILTER(), $self->[0];
}

#----------------------------------------------------------------------

1;

=head1 AUTHOR

Copyright 2019 Gasper Software Consulting (L<http://gaspersoftware.com>)

=head1 SEE ALSO

L<Linux::SocketFilter::Assembler> suits a similar purpose to this
module’s but appears to be geared solely toward PF_PACKET sockets.