glibc/tests/Regression/bz863384-getaddrinfo-fails-to-return-FQDN-for-AF_INET-and-AF_INET6/ns.pl
Sergey Kolosov ab4bc8a24e Extend the test coverage
Move some of the RHEL QE testcases upstream to Fedora.
2022-05-31 09:29:27 +02:00

62 lines
1.7 KiB
Perl
Executable File

#!/usr/bin/perl
# A simple nameserver that responds only to queries for "A" records of
# "mister.edward.hyde". This program is an almost verbatim copy of the
# Net::DNS::Nameserver example at:
# http://search.cpan.org/dist/Net-DNS/lib/Net/DNS/Nameserver.pm#EXAMPLE
use strict;
use warnings;
use Net::DNS::Nameserver;
sub reply_handler
{
my ($qname, $qclass, $qtype, $peerhost, $query, $conn) = @_;
my ($rcode, @ans, @auth, @add);
print "Received query from $peerhost to " . $conn->{sockhost} . "\n";
$query->print;
my $ttl = 0;
my $rdata = "";
$rcode = "NOERROR";
if ($qtype eq "A")
{
if ($qname eq "foo.red.hat") { $rdata = "127.126.125.124" }
elsif ($qname eq "bar.foo.red.hat") { $rdata = "127.126.125.124" }
elsif ($qname eq "red.hat") { $rdata = "127.126.125.124" }
else { $rcode = "NXDOMAIN" }
}
elsif ($qtype eq "AAAA")
{
if ($qname eq "foo.red.hat") { $rdata = "::1" }
elsif ($qname eq "bar.foo.red.hat") { $rdata = "::1" }
elsif ($qname eq "red.hat") { $rdata = "::1" }
else { $rcode = "NXDOMAIN" }
}
else
{
$rcode = "NXDOMAIN";
}
if ($rcode == "NOERROR")
{
my $rr = new Net::DNS::RR("$qname $ttl $qclass $qtype $rdata");
push @ans, $rr;
}
# mark the answer as authoritive (by setting the 'aa' flag
return ($rcode, \@ans, \@auth, \@add, {aa => 1});
}
my $ns = new Net::DNS::Nameserver(
LocalPort => 53,
ReplyHandler => \&reply_handler,
Verbose => 1
)
|| die "couldn't create nameserver object\n";
$ns->main_loop;