#!/usr/bin/perl

=pod

   FILE: dnsresolve -- resolves domain names to MX and A records.
 AUTHOR: Gyepi Sam <gyepi@praxis-sw.com>
   DATE: 12 October 2004

 Copyright (C) 2004 Gyepi Sam <gyepi@praxis-sw.com>
 All rights reserved.

 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
 the Free Software Foundation; either version 2 of the License, or
 (at your option) any later version.

 This program is distributed in the hope that it will be useful,
 but WITHOUT ANY WARRANTY; without even the implied warranty of
 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 GNU General Public License for more details.

 You should have received a copy of the GNU General Public License
 along with this program; if not, write to the Free Software
 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

=cut

use strict;

use Net::DNS;
use Getopt::Long;

my %opts = (timeout => 5);

my %fields = (
  MX => [qw(name preference exchange ttl)],
  A  => [qw(name address ttl)],
  PTR  => [qw(name ptrdname ttl)],
  CNAME  => [qw(name cname ttl)],
);

my %c_defaults = qw(min 10 max 2500);

unless (GetOptions(\%opts,
                   'type|t=s',
                   'concurrency|c=i',
                   'timeout=i',
                   'help|h',
                   'headers')){
  exit 1;
}

if (exists $opts{'help'}){
  &print_help();
  exit 0;
}

my $type = uc $opts{'type'};

if (!$type){
  print STDERR "missing type argument. try $0 --help\n";
  exit 1;
}

unless (exists $fields{$type}){
  print STDERR "invalid type argument. try $0 --help\n";
  exit 1;
}

my @fields = @{$fields{$type}};

if (exists $opts{'headers'}){
  print join(' ', @fields),"\n";
  exit (0);
}

my $have_lines = 1;
my $active = 0;

my $concurrency = $opts{'concurrency'};

$concurrency = $c_defaults{min} if $concurrency <= 0;
$concurrency = $c_defaults{max} if $concurrency > $c_defaults{max};

my @active =  map { { active => 0 } } (0 .. $concurrency);
my $res = Net::DNS::Resolver->new;

while($have_lines || $active){
  
  if ($have_lines){
    if (defined (my $host = <>)){
      chomp $host;
       
      for my $r (@active){
        next if $r->{active};
       
        @$r{qw(name res active start_time)} = ($host, $res, ++$active, time());
        $r->{'socket'} = $r->{res}->bgsend($host, $type, 'IN');
        
        last;
      }
    }
    else {
      $have_lines = 0;
    }
  }
  
  if ($active){
      my $found = 0;

      for my $r (@active){
        
        next unless $r->{active};

        my $done = 0;
        my $now = time();

        if ($r->{res}->bgisready($r->{socket})){
          $found=1;
          if (my $packet = $r->{res}->bgread($r->{socket})){
              if ($packet->header->ancount){
                   if ($type eq 'MX'){
                     for my $rr (sort { $a->preference <=> $b->preference }
                                   grep { $_->type eq $type } $packet->answer){
                                   
                        &print_rr($rr); 
                     }
                   }
                   else {
                      for my $rr ($packet->answer){
                        
                        if ($rr->type ne $type){
                         warn "unexpected reply type [@{[$rr->type]}] for $r->{name}\n";
                        }
                        &print_rr($rr); 
                      }
                   }
              }
          }
          else {
              print STDERR "Error:", $r->{res}->errorstring(), "\n";
          }
          $done = 1;
        }
        
        if (!$done && (($now - $r->{start_time}) > $opts{'timeout'})){
          print join(' ', $r->{name}, ('-') x (scalar(@fields) - 1)), "\n";
          $done = 1;
        }

        if ($done){
          undef $r->{$_} for qw(socket name res counter);         
          $r->{active}=0;
          $active--;
        }
     }

     #Sleep a bit if there are no further input to read and no DNS responses to active requests,
     if (!$have_lines && @active && !$found){
          sleep 1;
     }
  }
}

exit 0;

sub print_rr
{
  my ($rr) = @_;
  my $type = $rr->type;
  if (my $t = $fields{$type}){
   print join(' ', map { $rr->$_() } @$t), "\n";
  } 
}

sub print_help {
  my $field_info = join "\n", map { qq[$_ records fields are: ] . join ' ', @{$fields{$_}}} keys %fields;

  print STDERR <<EOF;
$0 -- Resolves domain names to DNS MX and A records.

Usage:

$0 --type t [ --concurrency c ]
$0 --type t --headers
$0 --help

Options:

--type t        Type of resolution desired. t is one of 'MX' or 'A'.
 -t    t        This argument is required and has no defaults.

--concurrency c Number of simultaneous active searchs.
 -c c           This argument is optional and defaults to [$c_defaults{min}].
                Maximum value is [$c_defaults{max}]

--timeout n     Maximum time, in seconds, to allow any single query.
                This argument is optional and defaults to [$opts{timeout}].

--headers       Prints fieldnames for output records and exits.
                $field_info
--help          You are reading it.
 -h 
EOF
}