1package App::Netdisco::Util::DNS; 2 3use strict; 4use warnings; 5use Dancer ':script'; 6 7use Net::DNS; 8use NetAddr::IP::Lite ':lower'; 9 10use base 'Exporter'; 11our @EXPORT = (); 12our @EXPORT_OK = qw/hostname_from_ip ipv4_from_hostname/; 13our %EXPORT_TAGS = (all => \@EXPORT_OK); 14 15=head1 NAME 16 17App::Netdisco::Util::DNS 18 19=head1 DESCRIPTION 20 21A set of helper subroutines to support parts of the Netdisco application. 22 23There are no default exports, however the C<:all> tag will export all 24subroutines. 25 26=head1 EXPORT_OK 27 28=head2 hostname_from_ip( $ip, \%opts? ) 29 30Given an IP address (either IPv4 or IPv6), return the canonical hostname. 31 32C<< %opts >> can override the various timeouts available in 33L<Net::DNS::Resolver>: 34 35=over 4 36 37=item C<tcp_timeout>: 120 (seconds) 38 39=item C<udp_timeout>: 30 (seconds) 40 41=item C<retry>: 4 (attempts) 42 43=item C<retrans>: 5 (timeout) 44 45=back 46 47Returns C<undef> if no PTR record exists for the IP. 48 49=cut 50 51sub hostname_from_ip { 52 my ($ip, $opts) = @_; 53 return unless $ip; 54 my $ETCHOSTS = setting('dns')->{'ETCHOSTS'}; 55 56 # check /etc/hosts file and short-circuit if found 57 foreach my $name (reverse sort keys %$ETCHOSTS) { 58 if ($ETCHOSTS->{$name}->[0]->[0] eq $ip) { 59 return $name; 60 } 61 } 62 63 my $res = Net::DNS::Resolver->new; 64 $res->tcp_timeout($opts->{tcp_timeout} || 120); 65 $res->udp_timeout($opts->{udp_timeout} || 30); 66 $res->retry($opts->{retry} || 4); 67 $res->retrans($opts->{retrans} || 5); 68 my $query = $res->search($ip); 69 70 if ($query) { 71 foreach my $rr ($query->answer) { 72 next unless $rr->type eq "PTR"; 73 return $rr->ptrdname; 74 } 75 } 76 77 return undef; 78} 79 80=head2 ipv4_from_hostname( $name ) 81 82Given a host name will return the first IPv4 address. 83 84Returns C<undef> if no A record exists for the name. 85 86=cut 87 88sub ipv4_from_hostname { 89 my $name = shift; 90 return unless $name; 91 my $ETCHOSTS = setting('dns')->{'ETCHOSTS'}; 92 93 # check /etc/hosts file and short-circuit if found 94 if (exists $ETCHOSTS->{$name} and $ETCHOSTS->{$name}->[0]->[0]) { 95 my $ip = NetAddr::IP::Lite->new($ETCHOSTS->{$name}->[0]->[0]); 96 return $ip->addr if $ip and $ip->bits == 32; 97 } 98 99 my $res = Net::DNS::Resolver->new; 100 my $query = $res->search($name); 101 102 if ($query) { 103 foreach my $rr ($query->answer) { 104 next unless $rr->type eq "A"; 105 return $rr->address; 106 } 107 } 108 109 return undef; 110} 111 1121; 113