view release on metacpan or  search on metacpan

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

	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;
		};

		/^option/ && do {
			my ( $keyword, @option ) = grep {defined} split;
			foreach (@option) {
				$self->_option( split m/:/ );
			}
		};
	}

	close($filehandle);

	$self->nameservers(@nameserver) if @nameserver;
	$self->searchlist(@searchlist)	if @searchlist;
	return;
}


sub string {
	my $self = shift;
	$self = $self->_defaults unless ref($self);

	my @nslist   = $self->nameservers();
	my ($force)  = ( grep( { $self->{$_} } qw(force_v6 force_v4) ),	  'force_v4' );
	my ($prefer) = ( grep( { $self->{$_} } qw(prefer_v6 prefer_v4) ), 'prefer_v4' );
	return <<END;
;; RESOLVER state:
;; nameservers	= @nslist
;; searchlist	= @{$self->{searchlist}}
;; defnames	= $self->{defnames}	dnsrch		= $self->{dnsrch}
;; igntc	= $self->{igntc}	usevc		= $self->{usevc}
;; recurse	= $self->{recurse}	port		= $self->{port}
;; retrans	= $self->{retrans}	retry		= $self->{retry}
;; tcp_timeout	= $self->{tcp_timeout}	persistent_tcp	= $self->{persistent_tcp}
;; udp_timeout	= $self->{udp_timeout}	persistent_udp	= $self->{persistent_udp}
;; ${prefer}	= $self->{$prefer}	${force}	= $self->{$force}
;; debug	= $self->{debug}	ndots		= $self->{ndots}
END
}


sub print {
	return print shift->string;
}


sub searchlist {
	my ( $self, @domain ) = @_;
	$self = $self->_defaults unless ref($self);

	foreach (@domain) { $_ = Net::DNS::Domain->new($_)->name }
	$self->{searchlist} = \@domain if scalar(@domain);
	return @{$self->{searchlist}};
}

sub domain {
	return (&searchlist)[0];
}


sub nameservers {
	my ( $self, @ns ) = @_;
	$self = $self->_defaults unless ref($self);

	my @ip;
	foreach my $ns ( grep {defined} @ns ) {