package DJabberd::DNS;
use strict;
use base 'Danga::Socket';
use fields (
            'hostname',
            'callback',
            'srv',
            'port',
            'recurse_count',
            'became_readable',  # bool
            'timed_out',        # bool
            );
use Carp qw(croak);

use DJabberd::Log;
our $logger = DJabberd::Log->get_logger();

use Net::DNS;
my $resolver    = Net::DNS::Resolver->new;

sub srv {
    my ($class, %opts) = @_;

    foreach (qw(callback domain service)) {
        croak("No '$_' field") unless $opts{$_};
    }

    my $hostname = delete $opts{'domain'};
    my $callback = delete $opts{'callback'};
    my $service  = delete $opts{'service'};
    my $port     = delete $opts{'port'};
    my $recurse_count = delete($opts{'recurse_count'}) || 0;
    croak "unknown opts" if %opts;

    # default port for s2s
    $port ||= 5269 if $service eq "_xmpp-server._tcp";
    croak("No specified 'port'") unless $port;

    # testing support
    if ($service eq "_xmpp-server._tcp") {
        my $endpt = DJabberd->fake_s2s_peer($hostname);
        if ($endpt) {
            $callback->($endpt);
            return;
        }
    }

    my $pkt = Net::DNS::Packet->new("$service.$hostname", "SRV", "IN");

    $logger->debug("pkt = $pkt");
    my $sock = $resolver->bgsend($pkt);
    $logger->debug("sock = $sock");
    my $self = $class->SUPER::new($sock);

    $self->{hostname} = $hostname;
    $self->{callback} = $callback;
    $self->{srv}      = $service;
    $self->{port}     = $port;
    $self->{recurse_count} = $recurse_count;

    $self->{became_readable} = 0;
    $self->{timed_out}       = 0;

    # TODO: make DNS timeout configurable
    Danga::Socket->AddTimer(5.0, sub {
        return if $self->{became_readable};
        $self->{timed_out} = 1;
        $logger->debug("DNS 'SRV' lookup for '$hostname' timed out");
        $callback->();
        $self->close;
    });

    $self->watch_read(1);
}

sub new {
    my ($class, %opts) = @_;

    foreach (qw(hostname callback port)) {
        croak("No '$_' field") unless $opts{$_};
    }

    my $hostname = delete $opts{'hostname'};
    my $callback = delete $opts{'callback'};
    my $port     = delete $opts{'port'};
    my $recurse_count = delete($opts{'recurse_count'}) || 0;
    croak "unknown opts" if %opts;

    if ($hostname =~/^\d+\.\d+\.\d+\.\d+/) {
        # we already have the IP, lets not looking it up
        $logger->debug("Skipping lookup for '$hostname', it is already the IP");
        $callback->(DJabberd::IPEndPoint->new($hostname, $port));
        return;
    }


    my $sock = $resolver->bgsend($hostname);
    my $self = $class->SUPER::new($sock);

    $self->{hostname} = $hostname;
    $self->{callback} = $callback;
    $self->{port}     = $port;
    $self->{recurse_count} = $recurse_count;

    $self->{became_readable} = 0;
    $self->{timed_out}       = 0;

    # TODO: make DNS timeout configurable, remove duplicate code
    Danga::Socket->AddTimer(5.0, sub {
        return if $self->{became_readable};
        $self->{timed_out} = 1;
        $logger->debug("DNS 'A' lookup for '$hostname' timed out");
        $callback->();
        $self->close;
    });

    $self->watch_read(1);
}

# TODO: verify response is for correct thing?  or maybe Net::DNS does that?
# TODO: lots of other stuff.
sub event_read {
    my $self = shift;

    if ($self->{timed_out}) {
        $self->close;
        return;
    }
    $self->{became_readable} = 1;

    if ($self->{srv}) {
        $logger->debug("DNS socket $self->{sock} became readable for 'srv'");
        return $self->event_read_srv;
    } else {
        $logger->debug("DNS socket $self->{sock} became readable for 'a'");
        return $self->event_read_a;
    }
}

sub event_read_a {
    my $self = shift;

    my $sock = $self->{sock};
    my $cb   = $self->{callback};

    my $packet = $resolver->bgread($sock);

    my @ans = $packet->answer;

    for my $ans (@ans) {
        my $rv = eval {
            if ($ans->isa('Net::DNS::RR::CNAME')) {
                if ($self->{recurse_count} < 5) {
                    $self->close;
                    DJabberd::DNS->new(hostname => $ans->cname,
                                       port     => $self->{port},
                                       callback => $cb,
                                       recurse_count => $self->{recurse_count}+1);
                }
                else {
                    # Too much recursion
                    $logger->warn("Too much CNAME recursion while resolving ".$self->{hostname});
                    $self->close;
                    $cb->();
                }
            } elsif ($ans->isa("Net::DNS::RR::PTR")) {
                $logger->debug("Ignoring RR response for $self->{hostname}");
            }
            else {
                $cb->(DJabberd::IPEndPoint->new($ans->address, $self->{port}));
            }
            $self->close;
            1;
        };
        if ($@) {
            $self->close;
            die "ERROR in DNS world: [$@]\n";
        }
        return if $rv;
    }

    # no result
    $self->close;
    $cb->();
}

sub event_read_srv {
    my $self = shift;

    my $sock = $self->{sock};
    my $cb   = $self->{callback};

    my $packet = $resolver->bgread($sock);
    my @ans = $packet->answer;

    # FIXME: is this right?  right order and direction?
    my @targets = sort {
        $a->priority <=> $b->priority ||
        $a->weight   <=> $b->weight
    } grep { ref $_ eq "Net::DNS::RR::SRV" && $_->port } @ans;

    unless (@targets) {
        # no result, fallback to an A lookup
        $self->close;
        $logger->debug("DNS socket $sock for 'srv' had nothing, falling back to 'a' lookup");
        DJabberd::DNS->new(hostname => $self->{hostname},
                           port     => $self->{port},
                           callback => $cb);
        return;
    }

    # FIXME:  we only do the first target now.  should do a chain.
    $logger->debug("DNS socket $sock for 'srv' found stuff, now doing hostname lookup on " . $targets[0]->target);
    DJabberd::DNS->new(hostname => $targets[0]->target,
                       port     => $targets[0]->port,
                       callback => $cb);
    $self->close;
}

package DJabberd::IPEndPoint;
sub new {
    my ($class, $addr, $port) = @_;
    return bless { addr => $addr, port => $port };
}

sub addr { $_[0]{addr} }
sub port { $_[0]{port} }

1;