1package DJabberd::DNS; 2use strict; 3use base 'Danga::Socket'; 4use fields ( 5 'hostname', 6 'callback', 7 'srv', 8 'port', 9 'recurse_count', 10 'became_readable', # bool 11 'timed_out', # bool 12 ); 13use Carp qw(croak); 14 15use DJabberd::Log; 16our $logger = DJabberd::Log->get_logger(); 17 18use Net::DNS; 19my $resolver = Net::DNS::Resolver->new; 20 21sub srv { 22 my ($class, %opts) = @_; 23 24 foreach (qw(callback domain service)) { 25 croak("No '$_' field") unless $opts{$_}; 26 } 27 28 my $hostname = delete $opts{'domain'}; 29 my $callback = delete $opts{'callback'}; 30 my $service = delete $opts{'service'}; 31 my $port = delete $opts{'port'}; 32 my $recurse_count = delete($opts{'recurse_count'}) || 0; 33 croak "unknown opts" if %opts; 34 35 # default port for s2s 36 $port ||= 5269 if $service eq "_xmpp-server._tcp"; 37 croak("No specified 'port'") unless $port; 38 39 # testing support 40 if ($service eq "_xmpp-server._tcp") { 41 my $endpt = DJabberd->fake_s2s_peer($hostname); 42 if ($endpt) { 43 $callback->($endpt); 44 return; 45 } 46 } 47 48 my $pkt = Net::DNS::Packet->new("$service.$hostname", "SRV", "IN"); 49 50 $logger->debug("pkt = $pkt"); 51 my $sock = $resolver->bgsend($pkt); 52 $logger->debug("sock = $sock"); 53 my $self = $class->SUPER::new($sock); 54 55 $self->{hostname} = $hostname; 56 $self->{callback} = $callback; 57 $self->{srv} = $service; 58 $self->{port} = $port; 59 $self->{recurse_count} = $recurse_count; 60 61 $self->{became_readable} = 0; 62 $self->{timed_out} = 0; 63 64 # TODO: make DNS timeout configurable 65 Danga::Socket->AddTimer(5.0, sub { 66 return if $self->{became_readable}; 67 $self->{timed_out} = 1; 68 $logger->debug("DNS 'SRV' lookup for '$hostname' timed out"); 69 $callback->(); 70 $self->close; 71 }); 72 73 $self->watch_read(1); 74} 75 76sub new { 77 my ($class, %opts) = @_; 78 79 foreach (qw(hostname callback port)) { 80 croak("No '$_' field") unless $opts{$_}; 81 } 82 83 my $hostname = delete $opts{'hostname'}; 84 my $callback = delete $opts{'callback'}; 85 my $port = delete $opts{'port'}; 86 my $recurse_count = delete($opts{'recurse_count'}) || 0; 87 croak "unknown opts" if %opts; 88 89 if ($hostname =~/^\d+\.\d+\.\d+\.\d+$/) { 90 # we already have the IP, lets not looking it up 91 $logger->debug("Skipping lookup for '$hostname', it is already the IP"); 92 $callback->(DJabberd::IPEndPoint->new($hostname, $port)); 93 return; 94 } 95 96 97 my $sock = $resolver->bgsend($hostname); 98 my $self = $class->SUPER::new($sock); 99 100 $self->{hostname} = $hostname; 101 $self->{callback} = $callback; 102 $self->{port} = $port; 103 $self->{recurse_count} = $recurse_count; 104 105 $self->{became_readable} = 0; 106 $self->{timed_out} = 0; 107 108 # TODO: make DNS timeout configurable, remove duplicate code 109 Danga::Socket->AddTimer(5.0, sub { 110 return if $self->{became_readable}; 111 $self->{timed_out} = 1; 112 $logger->debug("DNS 'A' lookup for '$hostname' timed out"); 113 $callback->(); 114 $self->close; 115 }); 116 117 $self->watch_read(1); 118} 119 120# TODO: verify response is for correct thing? or maybe Net::DNS does that? 121# TODO: lots of other stuff. 122sub event_read { 123 my $self = shift; 124 125 if ($self->{timed_out}) { 126 $self->close; 127 return; 128 } 129 $self->{became_readable} = 1; 130 131 if ($self->{srv}) { 132 $logger->debug("DNS socket $self->{sock} became readable for 'srv'"); 133 return $self->event_read_srv; 134 } else { 135 $logger->debug("DNS socket $self->{sock} became readable for 'a'"); 136 return $self->event_read_a; 137 } 138} 139 140sub event_read_a { 141 my $self = shift; 142 143 my $sock = $self->{sock}; 144 my $cb = $self->{callback}; 145 146 my $packet = $resolver->bgread($sock); 147 148 my @ans = $packet->answer; 149 150 for my $ans (@ans) { 151 my $rv = eval { 152 if ($ans->isa('Net::DNS::RR::CNAME')) { 153 if ($self->{recurse_count} < 5) { 154 $self->close; 155 DJabberd::DNS->new(hostname => $ans->cname, 156 port => $self->{port}, 157 callback => $cb, 158 recurse_count => $self->{recurse_count}+1); 159 } 160 else { 161 # Too much recursion 162 $logger->warn("Too much CNAME recursion while resolving ".$self->{hostname}); 163 $self->close; 164 $cb->(); 165 } 166 } elsif ($ans->isa("Net::DNS::RR::PTR")) { 167 $logger->debug("Ignoring RR response for $self->{hostname}"); 168 } 169 else { 170 $cb->(DJabberd::IPEndPoint->new($ans->address, $self->{port})); 171 } 172 $self->close; 173 1; 174 }; 175 if ($@) { 176 $self->close; 177 die "ERROR in DNS world: [$@]\n"; 178 } 179 return if $rv; 180 } 181 182 # no result 183 $self->close; 184 $cb->(); 185} 186 187sub event_read_srv { 188 my $self = shift; 189 190 my $sock = $self->{sock}; 191 my $cb = $self->{callback}; 192 193 my $packet = $resolver->bgread($sock); 194 my @ans = $packet->answer; 195 196 # FIXME: is this right? right order and direction? 197 my @targets = sort { 198 $a->priority <=> $b->priority || 199 $a->weight <=> $b->weight 200 } grep { ref $_ eq "Net::DNS::RR::SRV" && $_->port } @ans; 201 202 unless (@targets) { 203 # no result, fallback to an A lookup 204 $self->close; 205 $logger->debug("DNS socket $sock for 'srv' had nothing, falling back to 'a' lookup"); 206 DJabberd::DNS->new(hostname => $self->{hostname}, 207 port => $self->{port}, 208 callback => $cb); 209 return; 210 } 211 212 # FIXME: we only do the first target now. should do a chain. 213 $logger->debug("DNS socket $sock for 'srv' found stuff, now doing hostname lookup on " . $targets[0]->target); 214 DJabberd::DNS->new(hostname => $targets[0]->target, 215 port => $targets[0]->port, 216 callback => $cb); 217 $self->close; 218} 219 220package DJabberd::IPEndPoint; 221sub new { 222 my ($class, $addr, $port) = @_; 223 return bless { addr => $addr, port => $port }; 224} 225 226sub addr { $_[0]{addr} } 227sub port { $_[0]{port} } 228 2291; 230