use
constant
OS_SPEC
=>
defined
eval
"require Net::DNS::Resolver::$^O"
;
use
constant
OS_CONF
=>
join
'::'
,
'Net::DNS::Resolver'
, OS_SPEC ? $^O :
'UNIX'
;
our
$VERSION
;
BEGIN {
$VERSION
=
'1.24_02'
;
eval
{ __PACKAGE__->bootstrap(
$VERSION
) };
}
use
constant
UB_CONTEXT
=>
'Net::DNS::Resolver::Unbound::Context'
;
sub
new {
my
(
$class
,
@args
) =
@_
;
my
$self
=
$class
->SUPER::new();
$self
->nameservers(
$self
->SUPER::nameservers );
$self
->_finalise_config;
$self
->{update} = {}
if
@args
;
while
(
my
$attr
=
shift
@args
) {
my
$value
=
shift
@args
;
$self
->
$attr
(
ref
(
$value
) ?
@$value
:
$value
);
}
$self
->_finalise_config;
return
$self
;
}
sub
nameservers {
my
(
$self
,
@nameservers
) =
@_
;
if
(
defined
wantarray
) {
$self
->_finalise_config;
my
%config
= %{
$self
->{config}};
return
@{
$config
{set_fwd}};
}
$self
->set_fwd()
unless
@nameservers
;
$self
->set_fwd(
$_
)
foreach
@nameservers
;
return
;
}
sub
nameserver {
&nameservers
; }
use
constant
UB_SEND
=> UB_CONTEXT->can(
'ub_send'
);
sub
send
{
my
(
$self
,
@argument
) =
@_
;
$self
->_finalise_config;
$self
->_reset_errorstring;
my
(
$packet
) =
@argument
;
my
$query
=
$self
->_make_query_packet(
@argument
);
my
$result
;
if
( UB_SEND &&
ref
(
$packet
) ) {
$result
=
$self
->{ub_ctx}->ub_send(
$query
->encode );
}
else
{
my
(
$q
) =
$query
->question;
$result
=
$self
->{ub_ctx}->ub_resolve(
$q
->name,
$q
->{qtype},
$q
->{qclass} );
}
return
$self
->_decode_result(
$result
);
}
sub
bgsend {
my
(
$self
,
@argument
) =
@_
;
$self
->_finalise_config;
$self
->_reset_errorstring;
my
$query
=
$self
->_make_query_packet(
@argument
);
my
$image
=
$query
->encode;
my
$ident
=
$query
->header->id;
my
(
$q
) =
$query
->question;
return
$self
->{ub_ctx}->ub_resolve_async(
$q
->name,
$q
->{qtype},
$q
->{qclass},
$ident
);
}
sub
bgbusy {
my
(
$self
,
$handle
) =
@_
;
return
unless
$handle
;
return
unless
$handle
->waiting;
$self
->{ub_ctx}->ub_process;
eval
{
select
(
undef
,
undef
,
undef
, 0.200 ) };
return
$handle
->waiting;
}
sub
bgread {
my
(
$self
,
$handle
) =
@_
;
return
unless
$handle
;
$self
->{ub_ctx}->ub_wait
if
&bgbusy
;
$self
->errorstring(
$handle
->err );
my
$reply
=
$self
->_decode_result(
$handle
->result ) ||
return
;
$reply
->header->id(
$handle
->query_id );
return
$reply
;
}
sub
option {
my
(
$self
,
$name
,
@value
) =
@_
;
return
$self
->_option(
$name
,
@value
);
}
sub
config {
my
(
$self
,
$filename
) =
@_
;
return
$self
->_config(
'config'
,
$filename
);
}
sub
set_fwd {
my
(
$self
,
@fwd
) =
@_
;
return
$self
->_config(
'set_fwd'
, [
@fwd
] );
}
use
constant
SET_TLS
=> UB_CONTEXT->can(
'set_tls'
);
sub
set_tls {
my
(
$self
,
$tls
) =
@_
;
return
SET_TLS ?
$self
->_config(
'set_tls'
,
$tls
) :
undef
;
}
use
constant
SET_STUB
=> UB_CONTEXT->can(
'set_stub'
);
sub
set_stub {
my
(
$self
,
$zone
,
$address
,
$prime
) =
@_
;
return
SET_STUB ?
$self
->_config(
'set_stub'
, [[
$zone
,
$address
,
$prime
]] ) :
undef
;
}
sub
resolv_conf {
my
(
$self
,
$filename
) =
@_
;
return
$self
->_config(
'resolv_conf'
,
$filename
);
}
sub
hosts {
my
(
$self
,
$filename
) =
@_
;
return
$self
->_config(
'hosts'
,
$filename
);
}
sub
add_ta {
my
(
$self
,
@argument
) =
@_
;
my
$ta
= Net::DNS::RR->new(
@argument
)->plain;
return
$self
->_config(
'add_ta'
,
$ta
);
}
sub
add_ta_file {
my
(
$self
,
$filename
) =
@_
;
return
$self
->_config(
'add_ta_file'
,
$filename
);
}
use
constant
ADD_TA_AUTR
=> UB_CONTEXT->can(
'add_ta_autr'
);
sub
add_ta_autr {
my
(
$self
,
$filename
) =
@_
;
return
ADD_TA_AUTR ?
$self
->_config(
'add_ta_autr'
,
$filename
) :
undef
;
}
sub
trusted_keys {
my
(
$self
,
$filename
) =
@_
;
return
$self
->_config(
'trusted_keys'
,
$filename
);
}
sub
debug_out {
my
(
$self
,
$stream
) =
@_
;
return
$self
->_config(
'debug_out'
,
$stream
);
}
sub
debug_level {
my
(
$self
,
$verbosity
) =
@_
;
$self
->debug(
$verbosity
);
return
$self
->_config(
'debug_level'
,
$verbosity
);
}
sub
async_thread {
my
(
$self
,
$threaded
) =
@_
;
return
$self
->_config(
'async'
,
$threaded
);
}
sub
string {
my
$self
=
shift
;
$self
=
$self
->new()
unless
ref
(
$self
);
my
$image
=
<<END;
;; RESOLVER state:
;; debug $self->{debug} ndots $self->{ndots}
;; defnames $self->{defnames} dnsrch $self->{dnsrch}
;; searchlist @{$self->{searchlist}}
END
$self
->_finalise_config;
my
%config
= %{
$self
->{config}};
my
$optref
=
$config
{set_option} || [];
my
%option
=
map
{
@$_
}
@$optref
;
my
@option
;
foreach
my
$opt
(
sort
keys
%option
) {
push
@option
, [
$opt
,
$option
{
$opt
}];
}
my
$format
=
";; %s\t%s\n"
;
foreach
my
$name
(
sort
keys
%config
) {
local
$config
{set_option} = \
@option
;
my
$value
=
$config
{
$name
};
if
(
ref
$value
) {
foreach
my
$arg
(
@$value
) {
my
@arg
=
map
{
ref
(
$_
) ?
@$_
:
$_
}
$arg
;
$image
.=
sprintf
(
$format
,
$name
,
join
' '
,
@arg
);
}
}
else
{
$image
.=
sprintf
(
$format
,
$name
,
$value
);
}
}
return
$image
;
}
sub
_decode_result {
my
(
$self
,
$result
) =
@_
;
return
unless
$result
;
$self
->errorstring(
'INSECURE'
)
unless
$result
->secure;
$self
->errorstring(
$result
->why_bogus )
if
$result
->bogus;
my
$buffer
=
$result
->answer_packet ||
return
;
my
$packet
= Net::DNS::Packet->decode( \
$buffer
);
$self
->errorstring($@);
$packet
->
print
if
$self
->debug;
return
$packet
;
}
sub
_config {
my
(
$self
,
$name
,
$arg
) =
@_
;
$self
->{ub_ctx} = Net::DNS::Resolver::Unbound::Context->new()
unless
$self
->{update};
my
$update
=
$self
->{update} ||= {};
if
(
ref
$arg
) {
my
@arg
=
map
{
ref
(
$_
) ?
@$_
:
$_
}
@$arg
;
$self
->{ub_ctx}->
$name
(
@arg
)
if
@arg
;
my
$list
=
$update
->{
$name
} ||= [];
push
@$list
,
@$arg
if
@arg
;
$update
->{
$name
} = []
unless
@arg
;
}
elsif
(
defined
$arg
) {
$self
->{ub_ctx}->
$name
(
$arg
);
$update
->{
$name
} =
$arg
;
}
return
;
}
sub
_option {
my
(
$self
,
$name
,
@arg
) =
@_
;
$self
->{ub_ctx} = Net::DNS::Resolver::Unbound::Context->new()
unless
$self
->{update};
my
$setopt
=
$self
->{config}->{set_option};
my
$updopt
=
$self
->{update}->{set_option} || [];
my
%option
=
map
{
@$_
}
@$setopt
,
@$updopt
;
my
$opt
=
"${name}:"
;
return
$option
{
$opt
}
unless
@arg
;
my
$arg
=
shift
@arg
;
delete
$option
{
$opt
};
if
(
defined
$arg
) {
$self
->{ub_ctx}->set_option(
$opt
,
$arg
);
$option
{
$opt
} =
$arg
;
}
my
@option
=
map
{ [
$_
,
$option
{
$_
}] }
keys
%option
;
$self
->{update}->{set_option} = \
@option
;
return
;
}
my
%IP_conf
= (
force_v4
=> [
'do-ip6'
=>
'no'
],
force_v6
=> [
'do-ip4'
=>
'no'
],
prefer_v4
=> [
'prefer-ip4'
=>
'yes'
],
prefer_v6
=> [
'prefer-ip6'
=>
'yes'
] );
sub
_finalise_config {
my
$self
=
shift
;
my
$update
=
delete
$self
->{update};
return
unless
$update
;
my
$ctx
=
$self
->{ub_ctx} = Net::DNS::Resolver::Unbound::Context->new();
my
$config
=
$self
->{config} || {
set_option
=> [] };
my
%config
= (
%$config
,
%$update
);
my
$optref
=
delete
$config
{set_option};
my
%option
=
map
{
@$_
}
@$optref
;
my
@prefer
=
keys
%IP_conf
;
delete
@option
{
@prefer
};
my
@option
=
map
{ [
$_
,
$option
{
$_
}] }
keys
%option
;
foreach
my
$name
(
keys
%config
) {
my
$value
=
$config
{
$name
};
if
(
ref
$value
) {
foreach
my
$arg
(
@$value
) {
my
@arg
=
map
{
ref
(
$_
) ?
@$_
:
$_
}
$arg
;
$ctx
->
$name
(
@arg
);
}
}
else
{
$ctx
->
$name
(
$value
);
}
}
foreach
my
$key
(
@prefer
) {
eval
{
my
(
$name
,
$arg
) = @{
$IP_conf
{
$key
}};
my
$opt
=
"${name}:"
;
$ctx
->set_option(
$opt
,
$arg
);
push
@option
, [
$opt
,
$arg
];
}
if
$self
->
$key
;
}
$config
{set_option} = \
@option
if
@option
;
$self
->{config} = \
%config
;
return
;
}
1;