summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorbrian m. carlson <sandals@crustytoothpaste.net>2018-07-01 18:55:30 +0000
committerbrian m. carlson <sandals@crustytoothpaste.net>2018-07-01 18:55:30 +0000
commit59b4a1bb95fc606818e3e2e96266289ed8225c0b (patch)
tree32d6dc7a30dad76da5e5d9b039e52fba657de133
Initial import
-rw-r--r--.gitignore2
-rw-r--r--Unbound.xs104
-rw-r--r--dist.ini23
-rw-r--r--lib/Net/DNS/Resolver/Unbound.pm131
-rw-r--r--lib/Net/DNS/Resolver/Unbound/Internal.pm6
-rw-r--r--t/00_load.t11
-rw-r--r--t/01_basic.t130
7 files changed, 407 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..527628f
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,2 @@
+.build/
+/Net-DNS-Resolver-Unbound*
diff --git a/Unbound.xs b/Unbound.xs
new file mode 100644
index 0000000..4f3c3e5
--- /dev/null
+++ b/Unbound.xs
@@ -0,0 +1,104 @@
+#include <EXTERN.h>
+#include <perl.h>
+#include <XSUB.h>
+
+#include <unbound.h>
+
+static struct ub_ctx *ctx_from_sv(SV *val)
+{
+ return INT2PTR(struct ub_ctx *, SvIV(SvRV(val)));
+}
+
+MODULE = Net__DNS__Resolver__Unbound__Internal PACKAGE = Net::DNS::Resolver::Unbound::Internal PREFIX=nrdui_
+
+SV *nrdui_new(class)
+ const char *class;
+PREINIT:
+ struct ub_ctx *ctx;
+ SV *obj;
+CODE:
+{
+ ctx = ub_ctx_create();
+ RETVAL = newSViv(0);
+ obj = newSVrv(RETVAL, class);
+ sv_setiv(obj, PTR2IV(ctx));
+ SvREADONLY_on(obj);
+}
+OUTPUT:
+ RETVAL
+
+int nrdui_add_ta_file(self, file)
+ SV *self;
+ const char *file;
+CODE:
+{
+ RETVAL = ub_ctx_add_ta_file(ctx_from_sv(self), file);
+}
+OUTPUT:
+ RETVAL
+
+int nrdui_add_ta(self, anchor)
+ SV *self;
+ const char *anchor;
+PREINIT:
+ struct ub_ctx *ctx;
+CODE:
+{
+ RETVAL = ub_ctx_add_ta(ctx_from_sv(self), anchor);
+}
+OUTPUT:
+ RETVAL
+
+void nrdui_send(self, name, rrtype, rrclass)
+ SV *self;
+ const char *name;
+ int rrtype;
+ int rrclass;
+PREINIT:
+ struct ub_ctx *ctx;
+ struct ub_result *res;
+ int err;
+ const char *insecure;
+PPCODE:
+{
+ ctx = ctx_from_sv(self);
+ res = NULL;
+ err = ub_resolve(ctx, name, rrtype, rrclass, &res);
+ EXTEND(SP, 3);
+ PUSHs(sv_2mortal(newSViv(err)));
+ if (res) {
+ if (res->secure || (!res->secure && !res->bogus))
+ insecure = NULL;
+ else
+ insecure = res->why_bogus;
+ PUSHs(sv_2mortal(newSVpv(insecure, 0)));
+ PUSHs(sv_2mortal(newSVpvn(res->answer_packet, res->answer_len)));
+ }
+ if (res)
+ ub_resolve_free(res);
+}
+
+const char *nrdui_strerror(self, err)
+ SV *self;
+ int err;
+PREINIT:
+CODE:
+{
+ RETVAL = ub_strerror(err);
+}
+OUTPUT:
+ RETVAL
+
+void nrdui_DESTROY(self)
+ SV *self;
+PREINIT:
+ struct ub_ctx *ctx;
+CODE:
+{
+ if (self && SvROK(self) && SvOBJECT(SvRV(self))) {
+ ctx = ctx_from_sv(self);
+ free(ctx);
+ }
+}
+
+MODULE = Net__DNS__Resolver__Unbound PACKAGE = Net::DNS::Resolver::Unbound PREFIX=nrdu_
diff --git a/dist.ini b/dist.ini
new file mode 100644
index 0000000..21d1714
--- /dev/null
+++ b/dist.ini
@@ -0,0 +1,23 @@
+name = Net-DNS-Resolver-Unbound
+author = brian m. carlson <sandals@crustytoothpaste.net>
+license = Perl_5
+copyright_holder = brian m. carlson
+copyright_year = 2018
+
+version = 0.000001
+
+[GatherDir]
+[PruneCruft]
+[ManifestSkip]
+[MetaYAML]
+[License]
+[Readme]
+[ExtraTests]
+[ExecDir]
+[ShareDir]
+[Manifest]
+[TestRelease]
+[ConfirmRelease]
+[UploadToCPAN]
+[MakeMaker::Awesome]
+WriteMakefile_arg = LIBS => [ '-lunbound' ]
diff --git a/lib/Net/DNS/Resolver/Unbound.pm b/lib/Net/DNS/Resolver/Unbound.pm
new file mode 100644
index 0000000..fe0faf2
--- /dev/null
+++ b/lib/Net/DNS/Resolver/Unbound.pm
@@ -0,0 +1,131 @@
+# ABSTRACT: Recursive DNS resolver using libunbound
+package Net::DNS::Resolver::Unbound;
+
+use strict;
+use warnings;
+
+use Net::DNS::Packet ();
+use Net::DNS::Parameters ();
+use Net::DNS::Resolver::Unbound::Internal ();
+
+use XSLoader ();
+
+XSLoader::load(__PACKAGE__);
+
+=head1 NAME
+
+Net::DNS::Resolver::Unbound - recursively resolve DNS using libunbound
+
+=head1 SYNOPSIS
+
+ use Net::DNS::Resolver::Unbound;
+
+ my $res = Net::DNS::Resolver::Unbound->new();
+ my $packet = $res->send('example.com', 'AAAA', 'IN');
+
+=head1 DESCRIPTION
+
+This module implements a small subset of the Net::DNS::Resolver::Recurse
+interface.
+
+=head1 METHODS
+
+=head2 new(%args)
+
+Instantiate a new resolver, which is always recursive. Options, if desired,
+must be passed in the c<%args> hash; they cannot be changed at runtime.
+
+Currently the following options are supported:
+
+=over
+
+=item dnssec
+
+If true, enable DNSSEC validation. A trust anchor must be specified.
+
+=item trust_anchor
+
+If this value is a string, it is a file containing the root zone's DS records
+(and possibly other records). If it is a scalar ref, it is a reference to a
+string containing the same information.
+
+=back
+
+=cut
+
+sub new {
+ my ($class, %args) = @_;
+ my $self = bless {ctx => Net::DNS::Resolver::Unbound::Internal->new},
+ $class;
+ $self->_set_args(%args);
+ return $self;
+}
+
+=head2 send($name, [$rectype, [$recclass]])
+
+Send a request in the foreground, looking up the name C<$name> with type
+C<$rectype> (default "A") and class C<$recclass> (default "IN").
+
+Returns a Net::DNS::Packet instance on success. On failure, returns undef and
+sets the error string.
+
+=cut
+
+sub send {
+ my ($self, $name, $rectype, $recclass) = @_;
+ $rectype //= 'A';
+ $recclass //= 'IN';
+ $rectype = Net::DNS::Parameters::typebyname($rectype);
+ $recclass = Net::DNS::Parameters::classbyname($recclass);
+ my ($insecure, $data) = $self->_checked('send', $name, $rectype, $recclass);
+ if ($insecure && $self->{dnssec}) {
+ $self->{errorstring} = $insecure;
+ return;
+ }
+ return unless $data;
+ return Net::DNS::Packet->new(\$data);
+}
+
+=head2 errorstring
+
+Returns the error associated with the last failed call.
+
+=cut
+
+sub errorstring {
+ my ($self) = @_;
+ return $self->{errorstring};
+}
+
+sub _set_args {
+ my ($self, %args) = @_;
+
+ $self->{dnssec} = $args{dnssec};
+
+ if (ref $args{trust_anchor} eq 'SCALAR') {
+ $self->_hard_checked('add_ta', ${$args{trust_anchor}});
+ }
+ elsif ($args{trust_anchor}) {
+ $self->_hard_checked('add_ta_file', $args{trust_anchor});
+ }
+ return $self;
+}
+
+sub _hard_checked {
+ my ($self, $func, @args) = @_;
+ my ($err, @data) = $self->{ctx}->$func(@args);
+ die $self->{ctx}->strerror($err) if $err;
+ return @data;
+}
+
+sub _checked {
+ my ($self, $func, @args) = @_;
+ my ($err, @data) = $self->{ctx}->$func(@args);
+ if ($err) {
+ $self->{errorstring} = $self->{ctx}->strerror($err);
+ return;
+ }
+ return @data;
+}
+
+1;
diff --git a/lib/Net/DNS/Resolver/Unbound/Internal.pm b/lib/Net/DNS/Resolver/Unbound/Internal.pm
new file mode 100644
index 0000000..f442dfc
--- /dev/null
+++ b/lib/Net/DNS/Resolver/Unbound/Internal.pm
@@ -0,0 +1,6 @@
+package Net::DNS::Resolver::Unbound::Internal;
+
+use strict;
+use warnings;
+
+1;
diff --git a/t/00_load.t b/t/00_load.t
new file mode 100644
index 0000000..643cb89
--- /dev/null
+++ b/t/00_load.t
@@ -0,0 +1,11 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use_ok('Net::DNS::Resolver::Unbound');
+use_ok('Net::DNS::Resolver::Unbound::Internal');
+
+done_testing;
diff --git a/t/01_basic.t b/t/01_basic.t
new file mode 100644
index 0000000..3ad3ec0
--- /dev/null
+++ b/t/01_basic.t
@@ -0,0 +1,130 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+plan skip_all => 'AUTHOR_TESTING and NETWORK_TESTS not set'
+ unless $ENV{'AUTHOR_TESTING'} || $ENV{'NETWORK_TESTS'};
+
+use_ok('Net::DNS::Resolver::Unbound');
+use_ok('Net::DNS::Resolver::Unbound::Internal');
+
+subtest 'example.com' => sub {
+ my @tests = (
+ {
+ init => {
+ dnssec => 1,
+ trust_anchor => "/usr/share/dns/root.ds"
+ },
+ rrsig => 1,
+ type => 'A'
+ },
+ {
+ init => {
+ dnssec => 1,
+ trust_anchor => "/usr/share/dns/root.ds"
+ },
+ rrsig => 1,
+ type => 'AAAA'
+ },
+ {
+ init => {},
+ rrsig => 0,
+ type => 'A'
+ },
+ {
+ init => {},
+ rrsig => 0,
+ type => 'AAAA'
+ }
+ );
+
+ foreach my $test (@tests) {
+ skip 'No trust anchor', 4
+ if exists $test->{init}{trust_anchor} &&
+ !-f $test->{init}{trust_anchor};
+
+ my $res = Net::DNS::Resolver::Unbound->new(%{$test->{init}});
+ my $reply = $res->send('www.example.com', $test->{type});
+ isa_ok($reply, 'Net::DNS::Packet');
+ if ($reply) {
+ my @addresses =
+ grep { $_->isa("Net::DNS::RR::$test->{type}") } $reply->answer;
+ my @rrsig = grep { $_->isa('Net::DNS::RR::RRSIG') } $reply->answer;
+ cmp_ok(scalar @addresses, '>', 0, 'got some addresses');
+ foreach my $address (map { $_->address } @addresses) {
+ if ($test->{type} eq 'A') {
+ like(
+ $address, qr/\A\d+\.\d+\.\d+\.\d+\z/,
+ 'looks something like an IPv4 adddress'
+ );
+ }
+ else {
+ like(
+ $address, qr/\A[0-9a-f:]+\z/,
+ 'looks something like an IPv6 adddress'
+ );
+ }
+ }
+ if ($test->{rrsig}) {
+ cmp_ok(scalar @rrsig, '>', 0, 'got some RRSIGs');
+ }
+ }
+ }
+};
+
+subtest 'dnssec-failed.org' => sub {
+ my @tests = (
+ {
+ init => {
+ dnssec => 1,
+ trust_anchor => "/usr/share/dns/root.ds"
+ },
+ rrsig => 1,
+ type => 'A'
+ },
+ {
+ init => {},
+ rrsig => 0,
+ type => 'A'
+ },
+ );
+
+ foreach my $test (@tests) {
+ my $res = Net::DNS::Resolver::Unbound->new(%{$test->{init}});
+ my $reply = $res->send('www.dnssec-failed.org', $test->{type});
+ if ($test->{init}{dnssec}) {
+ is(
+ $reply, undef,
+ "When DNSSEC is on, invalid DNSSEC causes failure"
+ );
+ like(
+ $res->errorstring, qr/validation failure/,
+ 'error message mentions reason'
+ );
+ }
+ else {
+ isa_ok($reply, 'Net::DNS::Packet');
+ if ($reply) {
+ my @addresses =
+ grep { $_->isa("Net::DNS::RR::A") } $reply->answer;
+ my @rrsig =
+ grep { $_->isa('Net::DNS::RR::RRSIG') } $reply->answer;
+ cmp_ok(scalar @addresses, '>', 0, 'got some addresses');
+ foreach my $address (map { $_->address } @addresses) {
+ like(
+ $address, qr/\A\d+\.\d+\.\d+\.\d+\z/,
+ 'looks something like an IPv4 adddress'
+ );
+ }
+ if ($test->{rrsig}) {
+ cmp_ok(scalar @rrsig, '>', 0, 'got some RRSIGs');
+ }
+ }
+ }
+ }
+};
+
+done_testing;