view release on metacpan or  search on metacpan

lib/Net/DNS/Resolver/Base.pm  view on Meta::CPAN

my %warned;

sub _deprecate {
	my ( undef, @note ) = @_;
	carp join ' ', 'deprecated method;', "@note" unless $warned{"@note"}++;
	return;
}


sub _untaint {				## no critic		# recurses into user list arguments
	return TAINT ? map { ref($_) ? [_untaint(@$_)] : do { /^(.*)$/; $1 } } @_ : @_;
}


# These are the attributes that the user may specify in the new() constructor.
my %public_attr = (
	map { $_ => $_ } keys %{&_defaults},
	qw(domain nameserver srcaddr),
	map { $_ => 0 } qw(nameserver4 nameserver6 srcaddr4 srcaddr6),
	);


my $initial;

sub new {
	my ( $class, %args ) = @_;

	my $self;
	my $base = $class->_defaults;
	my $init = $initial;
	$initial ||= [%$base];
	if ( my $file = $args{config_file} ) {
		my $conf = bless {@$initial}, $class;
		$conf->_read_config_file($file);		# user specified config
		$self  = bless {_untaint(%$conf)}, $class;
		%$base = %$self unless $init;			# define default configuration

	} elsif ($init) {
		$self = bless {%$base}, $class;

	} else {
		$class->_init();				# define default configuration
		$self = bless {%$base}, $class;
	}

	while ( my ( $attr, $value ) = each %args ) {
		next unless $public_attr{$attr};
		my $ref = ref($value);
		croak "usage: $class->new( $attr => [...] )"
				if $ref && ( $ref ne 'ARRAY' );
		$self->$attr( $ref ? @$value : $value );
	}

	return $self;
}


my %resolv_conf = (			## map traditional resolv.conf option names
	attempts => 'retry',
	inet6	 => 'prefer_v6',
	timeout	 => 'retrans',
	);

my %res_option = (			## any resolver attribute plus those listed above
	%public_attr,
	%resolv_conf,
	);

sub _option {
	my ( $self, $name, @value ) = @_;
	my $attribute = $res_option{lc $name} || return;
	push @value, 1 unless scalar @value;
	return $self->$attribute(@value);
}


sub _read_env {				## read resolver config environment variables
	my $self = shift;

	$self->searchlist( map {split} $ENV{LOCALDOMAIN} ) if defined $ENV{LOCALDOMAIN};

	$self->nameservers( map {split} $ENV{RES_NAMESERVERS} ) if defined $ENV{RES_NAMESERVERS};

	$self->searchlist( map {split} $ENV{RES_SEARCHLIST} ) if defined $ENV{RES_SEARCHLIST};

	foreach ( map {split} $ENV{RES_OPTIONS} || '' ) {
		$self->_option( split m/:/ );
	}
	return;
}


sub _read_config_file {			## read resolver config file
	my ( $self, $file ) = @_;

	my $filehandle = IO::File->new( $file, '<' ) or croak "$file: $!";

	my @nameserver;
	my @searchlist;

	local $_;
	while (<$filehandle>) {
		s/[;#].*$//;					# strip comments

		/^nameserver/ && do {
			my ( $keyword, @ip ) = grep {defined} split;
			push @nameserver, @ip;
			next;
		};

		/^domain/ && do {
			my ( $keyword, $domain ) = grep {defined} split;
			$self->domain($domain);
			next;
		};

		/^search/ && do {
			my ( $keyword, @domain ) = grep {defined} split;
			push @searchlist, @domain;
			next;