Short spew:
How does one take a netfilter-queued-to-userspace packet and turn it
into a Perl "Net::Frame::Layer::ETH" object?
No matter how I try to call "new(raw => $something)" it seems to ignore
the "raw" attribute and create a default-value'd object.
I did post this over in the Netfilter Users Mailing list but it really
isn't a netfilter question (the nfqueue part of things does work but
it's the Perl part that I'm ignorant about).
This is perhaps my 5th or 6th copy-and-hack perl file so answers such
as "go read such-and-such document/web page" are quite welcome.
#-------------------
Long spew:
#---------
I did indeed manage to get all of this working with Perl "NetPacket::IP"
objects, but apparently that does IPv4 only and not IPv6.
What *does* work:
1) nftables "ct state { new } udp dport { domain } queue num 53 bypass",
2) Perl nfqueue-bindings (https://github.com/chifflier/nfqueue-bindings,
"libnfqueue-perl" package on Ubuntu),
3) Perl NetPacket::IP (https://metacpan.org/pod/NetPacket::IP,
"libnetpacket-perl" package on Ubuntu), and
4) Perl Net::DNS::Packet (https://metacpan.org/pod/Net::DNS::Packet,
"libnet-dns-perl" package on Ubuntu)
together allow me to inspect DNS packets (UDP, so far) and issue
NF_ACCEPT or NF_DROP verdicts as I wish (so I can drop requests for
recursion, or not for my domains, and so forth).
And I can even add the (IPv4) source IPs as elements to an nftables
IP address set, complete with timeouts.
So far, so good. In fact more like "totally awesome". It eliminates
a lot of crap coming at me.
Except that "NetPacket::IP" appears to handle IPv4 packets only,
not IPv6.
If someone tells me that "NetPacket::IP" does indeed do IPv6 and points
me at the detail that I'm missing then that would be great.
#---------
So I have tried flipping over to "Net::Frame::Layer::ETH"
(https://metacpan.org/release/Net-Frame, "libnet-frame-perl" on Ubuntu)
in the hopes that it can both tell me if it's an IPv4 or IPv6 packet
and then let me work my way up from there.
What *doesn't* work (following is one of four attempts... scroll down
this email for all four together):
$layer = Net::Frame::Layer::ETH->new(raw => $payload);
... that just seems to cheerfully ignore the "raw" attribute and
produce a default-valued result as described by the documentation.
Following is:
a) apparently-default-result from Net::Frame::Layer::ETH,
b) my Perl code attempt to use Net::Frame::Layer::ETH, and
c) the NetPacket::IP that does work (except doesn't do IPv6)
#---------
Got a layer:
ETH: dst:ff:ff:ff:ff:ff:ff src:00:00:00:00:00:00 type:0x0800
Got a layer:
ETH: dst:ff:ff:ff:ff:ff:ff src:00:00:00:00:00:00 type:0x0800
Got a layer:
ETH: dst:ff:ff:ff:ff:ff:ff src:00:00:00:00:00:00 type:0x0800
Got a layer:
ETH: dst:ff:ff:ff:ff:ff:ff src:00:00:00:00:00:00 type:0x0800
#---------
#!/usr/bin/perl -w
use strict;
use nfqueue;
use Socket qw(AF_INET AF_INET6);
use Net::Frame::Layer::ETH;
my $q;
sub cleanup() {
$q->unbind(AF_INET);
$q->close();
}
sub cb() {
my $payload;
my $data;
my $layer;
($payload) = @_;
if ($payload) {
$data = $payload->get_data();
$layer = Net::Frame::Layer::ETH->new(raw => $payload);
if ($layer) {
print("Got a layer:\n");
print($layer->print,"\n");
};
$layer = Net::Frame::Layer::ETH->new(raw => $data);
if ($layer) {
print("Got a layer:\n");
print($layer->print,"\n");
};
$layer = Net::Frame::Layer::ETH->new(raw => \$payload);
if ($layer) {
print("Got a layer:\n");
print($layer->print,"\n");
};
$layer = Net::Frame::Layer::ETH->new(raw => \$data);
if ($layer) {
print("Got a layer:\n");
print($layer->print,"\n");
};
print "---\n";
$payload->set_verdict($nfqueue::NF_ACCEPT);
}
}
$q = new nfqueue::queue();
$SIG{INT} = "cleanup";
$q->set_callback(\&cb);
$q->fast_open(53, AF_INET);
$q->set_queue_maxlen(5000);
$q->try_run();
#---------
#!/usr/bin/perl -w
use strict;
use nfqueue;
use Socket qw(AF_INET AF_INET6);
use NetPacket::IP qw(IP_PROTO_UDP IP_PROTO_TCP);
use NetPacket::UDP;
use NetPacket::TCP;
use Net::DNS::Packet;
my $q;
sub cleanup() {
$q->unbind(AF_INET);
$q->close();
}
sub cb() {
my $payload;
my $ip_obj;
my $udp_obj;
my $tcp_obj;
my $data_obj;
my $dns_obj;
my $dns_hdr;
my @dns_qs;
my $drop = "no";
($payload) = @_;
if ($payload) {
$ip_obj = NetPacket::IP->decode($payload->get_data());
if ($ip_obj->{proto}==IP_PROTO_UDP) {
$udp_obj = NetPacket::UDP->decode($ip_obj->{data});
$data_obj = $udp_obj->{data};
}
if ($ip_obj->{proto}==IP_PROTO_TCP) {
$tcp_obj = NetPacket::TCP->decode($ip_obj->{data});
$data_obj = $tcp_obj->{data};
}
$dns_obj = Net::DNS::Packet->new(\$data_obj);
$dns_hdr = $dns_obj->header;
@dns_qs = $dns_obj->question;
if ($dns_hdr->rd) {
$drop = "yes";
}
if ($dns_hdr->qdcount == 1) {
if ($dns_qs[0]->qname !~ /(firstdomain|seconddomain)\.com)$/i) {
$drop = "yes";
}
if ($dns_qs[0]->qclass ne "IN") {
$drop = "yes";
}
}
if ($drop eq "yes") {
$payload->set_verdict($nfqueue::NF_DROP);
} else {
$payload->set_verdict($nfqueue::NF_ACCEPT);
}
}
}
$q = new nfqueue::queue();
$SIG{INT} = "cleanup";
$q->set_callback(\&cb);
$q->fast_open(53, AF_INET);
$q->set_queue_maxlen(5000);
$q->try_run();
#---------
--
- James
--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/
