1package Net::DNS::Resolver::MSWin32; 2 3use strict; 4use warnings; 5our $VERSION = (qw$Id: MSWin32.pm 1812 2020-10-07 18:09:53Z willem $)[2]; 6 7 8=head1 NAME 9 10Net::DNS::Resolver::MSWin32 - MS Windows resolver class 11 12=cut 13 14 15use base qw(Net::DNS::Resolver::Base); 16use Carp; 17 18use constant WINHLP => defined eval 'require Win32::IPHelper'; ## no critic 19use constant WINREG => defined eval 'use Win32::TieRegistry qw(KEY_READ REG_DWORD); 1'; ## no critic 20 21our $Registry; 22 23 24sub _init { 25 my $defaults = shift->_defaults; 26 27 my $debug = 0; 28 29 my $FIXED_INFO = {}; 30 31 my $err = Win32::IPHelper::GetNetworkParams($FIXED_INFO); 32 croak "GetNetworkParams() error %u: %s\n", $err, Win32::FormatMessage($err) if $err; 33 34 if ($debug) { 35 require Data::Dumper; 36 print Data::Dumper::Dumper $FIXED_INFO; 37 } 38 39 40 my @nameservers = map { $_->{IpAddress} } @{$FIXED_INFO->{DnsServersList}}; 41 $defaults->nameservers(@nameservers); 42 43 my $devolution = 0; 44 my $domainname = $FIXED_INFO->{DomainName} || ''; 45 my @searchlist = grep {length} $domainname; 46 47 if (WINREG) { 48 49 # The Win32::IPHelper does not return searchlist. 50 # Make best effort attempt to get searchlist from the registry. 51 52 my @root = qw(HKEY_LOCAL_MACHINE SYSTEM CurrentControlSet Services); 53 54 my $leaf = join '\\', @root, qw(Tcpip Parameters); 55 my $reg_tcpip = $Registry->Open( $leaf, {Access => KEY_READ} ); 56 57 unless ( defined $reg_tcpip ) { # Didn't work, Win95/98/Me? 58 $leaf = join '\\', @root, qw(VxD MSTCP); 59 $reg_tcpip = $Registry->Open( $leaf, {Access => KEY_READ} ); 60 } 61 62 if ( defined $reg_tcpip ) { 63 my $searchlist = $reg_tcpip->GetValue('SearchList') || ''; 64 push @searchlist, split m/[\s,]+/, $searchlist; 65 66 my ( $value, $type ) = $reg_tcpip->GetValue('UseDomainNameDevolution'); 67 $devolution = defined $value && $type == REG_DWORD ? hex $value : 0; 68 } 69 } 70 71 72 # fix devolution if configured, and simultaneously 73 # eliminate duplicate entries (but keep the order) 74 my @list; 75 my %seen; 76 foreach (@searchlist) { 77 s/\.+$//; 78 push( @list, $_ ) unless $seen{lc $_}++; 79 80 next unless $devolution; 81 82 # while there are more than two labels, cut 83 while (s#^[^.]+\.(.+\..+)$#$1#) { 84 push( @list, $_ ) unless $seen{lc $_}++; 85 } 86 } 87 $defaults->searchlist(@list); 88 89 %$defaults = Net::DNS::Resolver::Base::_untaint(%$defaults); 90 91 $defaults->_read_env; 92 return; 93} 94 95 961; 97__END__ 98 99 100=head1 SYNOPSIS 101 102 use Net::DNS::Resolver; 103 104=head1 DESCRIPTION 105 106This class implements the OS specific portions of C<Net::DNS::Resolver>. 107 108No user serviceable parts inside, see L<Net::DNS::Resolver> 109for all your resolving needs. 110 111=head1 COPYRIGHT 112 113Copyright (c)2003 Chris Reinhardt. 114 115Portions Copyright (c)2009 Olaf Kolkman, NLnet Labs 116 117All rights reserved. 118 119=head1 LICENSE 120 121Permission to use, copy, modify, and distribute this software and its 122documentation for any purpose and without fee is hereby granted, provided 123that the above copyright notice appear in all copies and that both that 124copyright notice and this permission notice appear in supporting 125documentation, and that the name of the author not be used in advertising 126or publicity pertaining to distribution of the software without specific 127prior written permission. 128 129THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 130IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 131FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL 132THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 133LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 134FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 135DEALINGS IN THE SOFTWARE. 136 137=head1 SEE ALSO 138 139L<perl>, L<Net::DNS>, L<Net::DNS::Resolver> 140 141=cut 142 143