#!/afs/athena/contrib/perl5/perl

# RFC821 is the SMTP RFC

# $Id: expn.pl,v 1.23 1996/07/20 21:28:13 marc Exp $

use lib ("/afs/athena.mit.edu/user/m/a/marc/perl",
	 "/afs/athena.mit.edu/user/b/e/bert/PERL",
	 "/afs/athena.mit.edu/contrib/perl/lib");

require 'resolv.pl';
use DataDump;

my $debug = 1;
my (@auth, @soa, @ns, @domains, @servers, @primary, @authmail);

sub uniq (@) {
  my (@data) = sort(@_);
  my ($i, $j);
  for ($i=0; $i<$#data; $i++) {
    $j = $i;
    while ( ($j < $#data) && ($data[$j+1] eq $data[$i]) ) { $j++; }
    splice @data, $i+1, $j-$i  if ($j > $i);
  }
  @data;
}

sub authority ($@) {
  my $qtype = shift;
  my($name) = join('.', reverse(@_), 'in-addr.arpa.');
  my(@ans) = &res_search($name, $qtype, 'IN');
  print STDERR "$name: $ans[3]\n" if ($ans[3] && $debug);
  @ans[$ans[8]..($ans[8]+$ans[9]-1)];
}

sub query ($$) {
  my ($qtype, $name) = @_;
  my (@ans) = &res_search($name, $qtype, 'IN');
  @ans[$ans[6]..($ans[6]+$ans[7]-1)];
}

sub type ($@) {
  my ($type, @records) = @_;
  grep { $_->[1] eq $type } (map { [ split(/\s+/) ] } @records);
}

# selectors
sub server ($) { $_[0]->[4]; }
sub domain ($) { $_[0]->[0]; }
sub soa_owner ($) { my $x = $_[0]->[5]; $x =~ s/([^\\])\./$1@/; $x }

print "\n" if @ARGV;

  ARG:
    foreach $arg (@ARGV) {
      @auth = authority 'PTR', split(/\./, $arg);
      @auth || do { print STDERR "No data for $arg\n"; next ARG };

      @soa = type 'SOA', @auth;
      @ns  = type 'NS', @auth;
      @soa || @ns || do { print STDERR "No useful data for $arg\n"; next ARG };

      print STDERR "Found nameserver/authority records for $arg\n" if $debug;
      @domains = uniq map { domain $_ } (@ns, @soa);

      unless (@ns) {
	@ns  = type 'NS',  map { query 'NS', $_ }  @domains;
	print STDERR "Found NS records for $arg\n"  if ($debug && @ns);
      }
      unless (@soa) {
	@soa = type 'SOA', map { query 'SOA', $_ } @domains;
	print STDERR "Found SOA records for $arg\n" if ($debug && @soa);
      }

      @servers  = uniq map { server $_ } @ns;
      @primary  = uniq map { server $_ } @soa;
      @authmail = uniq map { soa_owner $_ } @soa;

      print <<"EndOfData";
$arg falls in the domain @domains
  Nameservers:  @servers
  Primary:      @primary
  Domain owner: @authmail

EndOfData
    }

# response format:
# [0] = id
# [1] = authoritative
# [2] = recursion available
# [3] = response code
# [4] = start of questions
# [5] = number of questions
# [6] = start of answers
# [7] = number of answers
# [8] = start of authority records
# [9] = number of authority records
# [10] = start of add'l records
# [11] = number of add'l records
# [12] ... query and resource records