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