# very simple request, using lots of default values:
{ rd => 1, qd => [ [ "host.domain", "a"] ] }
# more complex example, showing how flags etc. are named:
{
id => 10000,
op => "query",
rc => "nxdomain",
# flags
qr => 1,
aa => 0,
tc => 0,
rd => 0,
ra => 0,
ad => 0,
cd => 0,
qd => [@rr], # query section
an => [@rr], # answer section
ns => [@rr], # authority section
ar => [@rr], # additional records section
}
=cut
sub dns_pack($) {
my ($req) = @_;
pack "nn nnnn a* a* a* a* a*",
$req->{id},
! !$req->{qr} * 0x8000
+ $opcode_id{$req->{op}} * 0x0800
+ ! !$req->{aa} * 0x0400
+ ! !$req->{tc} * 0x0200
+ ! !$req->{rd} * 0x0100
+ ! !$req->{ra} * 0x0080
+ ! !$req->{ad} * 0x0020
+ ! !$req->{cd} * 0x0010
+ $rcode_id{$req->{rc}} * 0x0001,
scalar @{ $req->{qd} || [] },
scalar @{ $req->{an} || [] },
scalar @{ $req->{ns} || [] },
$EDNS0 + scalar @{ $req->{ar} || [] }, # EDNS0 option included here
(join "", map _enc_qd, @{ $req->{qd} || [] }),
(join "", map _enc_rr, @{ $req->{an} || [] }),
(join "", map _enc_rr, @{ $req->{ns} || [] }),
(join "", map _enc_rr, @{ $req->{ar} || [] }),
($EDNS0 ? pack "C nnNn", 0, 41, MAX_PKT, 0, 0 : "") # EDNS0 option
}
our $ofs;
our $pkt;
# bitches
sub _dec_name {
my @res;
my $redir;
my $ptr = $ofs;
my $cnt;
while () {
return undef if ++$cnt >= 256; # to avoid DoS attacks
my $len = ord substr $pkt, $ptr++, 1;
if ($len >= 0xc0) {
$ptr++;
$ofs = $ptr if $ptr > $ofs;
$ptr = (unpack "n", substr $pkt, $ptr - 2, 2) & 0x3fff;
} elsif ($len) {
push @res, substr $pkt, $ptr, $len;
$ptr += $len;
} else {
$ofs = $ptr if $ptr > $ofs;
return join ".", @res;
}
}
}
sub _dec_qd {
my $qname = _dec_name;
my ($qt, $qc) = unpack "nn", substr $pkt, $ofs; $ofs += 4;
[$qname, $type_str{$qt} || $qt, $class_str{$qc} || $qc]
}
our %dec_rr = (
1 => sub { join ".", unpack "C4", $_ }, # a
2 => sub { local $ofs = $ofs - length; _dec_name }, # ns
5 => sub { local $ofs = $ofs - length; _dec_name }, # cname
6 => sub {
local $ofs = $ofs - length;
my $mname = _dec_name;
my $rname = _dec_name;
=5= |