#!/usr/bin/perl
#
# $Id$
#
# psydns.pl
# TiChou <tichou@tichou.org>
#
# server PRIVMSG * * "!dns" echo "PRIVMSG $TO :Usage: !dns [A|AAAA|PTR|NS|...] hostname/ip [nameserver]"
# server PRIVMSG * #yourchannel "!dns *" set -f; echo $P5|grep -qiE "^(A|AAAA|A6|CNAME|DNAME|PTR|NS|MX|TXT|SOA|HINFO|LOC|WKS|RP|SRV|KEY|ANY|VERSION)$" && ~/psybnc/scripts/psydns.pl -t "$P5" -s "$P7" "${P6:-yourdomain.tld}" || ~/psybnc/scripts/psydns.pl -s "$P6" "$P5"

my $version = "1.0";
my $cmdname = (split('/', $0))[-1];
$0 = $cmdname;

my $channel = $ENV{TO} || "\#psydns";

my $dig = "/usr/bin/dig";

use strict;
#use warnings;

use Getopt::Long;
use Fcntl ':flock';
use integer;
use Net::servent;

open(LOCK,">psydns.lock") or die "Can't open psydns.lock: $!\n";
flock(LOCK, LOCK_EX|LOCK_NB) or die "Can't lock psydns.lock: $!\n";

sub usage($) {
  my $usage = "Usage: $cmdname [options] host
Options:
  -t, --type=RR              specify query type
  -s, --server=HOST          specify name server (default /etc/resolv.conf)

  -h, --help                 display this help and exit
  -v, --version              display version

Report bugs to <tichou\@tichou.org>.\n";

  if (shift) {
    print STDOUT $usage;
    exit 0;
  } else {
    print STDERR $usage;
    exit 1;
  }
}

sub version {
  print "$cmdname $version\n";
  exit 0;
}

my ($host,$type,$server) = ("") x 3;

Getopt::Long::Configure ("bundling");
GetOptions("t|type=s"   => \$type,
           "s|server=s" => \$server,
           "h|help"     => \&usage,
           "v|version"  => \&version) or &usage(0);

if ($type =~ /^VERSION$/i) {
  $server = $ARGV[0];
  $type = "CH TXT";
  $host = "version.bind";
} else {
  $host = $ARGV[0] or &usage(0);
};

my (@qname,$qname,$prefix,@defaultype);

for ($host) {
  /^([[:xdigit:]]{2})([[:xdigit:]]{2})([[:xdigit:]]{2})([[:xdigit:]]{2})$/ && ($_ = ($host = sprintf("%d.%d.%d.%d", hex("0x$1"),hex("0x$2"),hex("0x$3"),hex("0x$4"))));
  if (/^((\d+)\.(\d+)\.(\d+)\.(\d+))(\/(\d+))?$/ && !($2>>8|$3>>8|$4>>8|$5>>8) && (defined $7 ? ($7 > 0 && $7 < 32 && not $7 % 8) : 1)) {
    @qname = split(/\./, $1);
    $qname = join('.',reverse(@qname[0..(defined $7 ? $7/8-1 : 3)])).".in-addr.arpa.";
    @defaultype = (defined $7 ? "NS" : "PTR");
  } elsif (/^(([[:xdigit:]]{0,4}:){0,7}[[:xdigit:]]{0,4})(\/(\d+))?$/ && (defined $4 ? ($4 > 0 && $4 <= 128 && not $4 % 4) : 1) && not /:::/) {
    $prefix = $4 if $4;
    ($qname = $1) =~ s/^:/0000:/;
    $qname =~ s/:$/:0000/;
    $qname =~ s/(^|:)([[:xdigit:]]+)(?=:|$)/$1."0"x(4-length($2)).$2.$3/eg;
    $qname =~ s/::/":".join(":",("0000")x(8-($qname=~tr#:##))).":"/e;
    $qname =~ s/://g;
    $qname = reverse($qname);
    $qname =~ s/(.)/$1./g;
    $qname = substr($qname,$prefix/-2,$prefix/2) if $prefix;
    $qname .= "ip6.".(($qname =~ /e\.f\.f\.3\.$/i) ? "int" : "arpa").".";
    @defaultype = ($prefix ? "NS" : "PTR");
  } else {
    $qname = $_;
    @defaultype = ("A","AAAA");
  };
};

my (@rname,$rname,$rtype,$ttl,$rdata,$rcode,$answer,$RR);

sub sec2wdhms {
  local $_ = shift;
  $_ = ($_/604800)."w ".($_/86400%7)."d ".($_/3600%24)."h ".($_/60%60)."m ".($_%60)."s";
  $_ =~ s/^(0[wdhm] )*//;
  $_ =~ s/^(\d+[wdhm])( 0[dhms])*$/$1/;
  return $_;
};

DIG: foreach my $qtype ($type ? $type : @defaultype) {
  open(DIG,"$dig +noall +comments +answer +search +ndots=2 -t $qtype ".($server ? "\@$server " : "")."\"$qname\" 2>&1 |") or die "Can't open dig : $!\n";
  while (<DIG>) {
    /^;; ->>HEADER<<- opcode: \w+, status: (NOERROR|SERVFAIL|NXDOMAIN|REFUSED), id: \d+$/ && ($rcode = $1);
    /^;; flags:( \w+)+; QUERY: \d+, ANSWER: (\d+), AUTHORITY: \d+, ADDITIONAL: \d+$/ && ($answer += $2);
    /^;; connection timed out; no servers could be reached$/ && print "PRIVMSG $channel :".($type eq "CH TXT" ? "Version on $server" : "$host \U$qtype\E record").": no servers could be reached\n";
    if (/Couldn't find server '$server'/) {
      print "PRIVMSG $channel :Name server $server not known.\n";
      last DIG;
    };
    /version\.bind\.\s+\d+\s+CH\s+TXT\s+"(.+)"$/i && print "PRIVMSG $channel :Version of BIND running".($server ? " on $server" : "").": \002$1\002\n";
    if (/^(\S+)\.\s+(\d+)\s+IN\s+(A|AAAA|A6|CNAME|DNAME|PTR|NS|MX|TXT|SOA|HINFO|LOC|WKS|RP|SRV|KEY|ANY|VERSION)\s+(.+)$/ && !$RR->{$3}->{$1}->{$4} && ++$RR->{$3}->{$1}->{$4}) {
      $rname = $1;
      $ttl= $2;
      $rtype = $3;
      $rdata = $4;
      $rdata =~ s/\.$//;
      for ($rname) {
        if (/^((\d+\.){1,4})in-addr\.arpa$/i) {
          $prefix = (@rname=split(/\./,$1));
          $rname = join(".",reverse(@rname));
          $rname .= ".0"x(4-$prefix)."/".$prefix*8 if ($prefix < 4);
        } elsif (/^(([[:xdigit:]]\.){1,32})ip6\.(arpa|int)$/i) {
          $prefix = (@rname=split(/\./,$1));
          $rname = reverse(@rname)."0"x(32-$prefix);
          $rname =~ s/((?!....$)....)/$1:/g;
          $rname =~ s/(^|:)(?!0$)0{1,3}/$1/g;
          $rname =~ s/
                      ^((0:){2,}(0$)?)?
                      (((?!(0(:|$)){2,})[[:xdigit:]]+:)*)
                      ((0(:|$)){2,})?
                      (((?!0)[[:xdigit:]]+(:|$))*)
                      ((0(:|$)){2,})?
                     /
                      my ($x,$y,$z) = (length($1)-1,length($8),length($14));
                      if ($y>=$x && $y>$z) { "$1$4:$11$14" }
                      elsif ($x>$y && $x>$z) { "::$4$8$11$14" }
                      elsif ($z>$y && $y>=$x) { "$1$4$8$11:" }
                      else { "$1$4$8$11$14" };
                     /ex;
          $rname .= "/".$prefix*4 if ($prefix < 32);
        };
      };
      $ttl = sec2wdhms($ttl);
      for ($rtype) {
        if (/^HINFO$/) {
          $rdata =~ s/(debian)/$1 (sux !)/i;
          $rdata =~ s/^(\S+)\s+(\S+)$/cpu=\002$1\002 os=\002$2\002/;
          $rdata =~ s/^\"([^\"]+)\"\s+\"([^\"]+)\"$/cpu=\002$1\002 os=\002$2\002/;
        } elsif (/^SOA$/) {
          $rdata =~ /^(\S+)\.\s+((\\\.|[^\.])+)\.(\S+)\.\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)/;
          $rdata = "nspri=\002$1\002 mail=\002$2\@$4\002 serial=\002$5\002 refresh=".sec2wdhms($6)." retry=".sec2wdhms($7)." expire=".sec2wdhms($8)." minimum=".sec2wdhms($9);
          $rdata =~ s/\\\././g;
        } elsif (/^MX$/) {
          $rdata =~ s/^(\d+)\s+(.+)/\002$2\002 pref=$1/;
        } elsif(/^WKS$/) {
          $rdata =~ s/\"//g;
          $rdata =~ s/^(\S+) (\d+)(( \d+)+)$/$1 /;
          if (my $proto = getprotobynumber($2)) {
            $rdata .= "$proto (";
            my @services = ();
            foreach ($3 =~ /\d+/g) {
              if (my $service = getservbyport($_,$proto)) {
                push(@services,$service->name);
              } else {
                push(@services,$_);
              }
            };
            $rdata .= join(" ",@services).")";
          } else {
            $rdata .= "$2 (".join(" ",split(/ /,$3)).")";
          }
        } else {
          $rdata =~ s/\"//g;
          $rdata = "\002$rdata\002";
        };
      };
      print "PRIVMSG $channel :$rname $rtype record: $rdata [ttl=$ttl]\n";
    };
  };
  close(DIG);
}

if ($rcode eq "NOERROR" && (not $answer or $rtype eq "CNAME")) {
  print "PRIVMSG $channel :No \U".join("\E and \U",$type ? $type : @defaultype)."\E records exist for ".($rtype eq "CNAME" ? "$rdata" : "$host").($server ? " on $server.\n" : ".\n");
} elsif ($rcode eq "NXDOMAIN") {
  print "PRIVMSG $channel :Name ".($rtype eq "CNAME" ? "$rdata" : "$host")." doesn't exist.\n";
} elsif ($rcode eq "SERVFAIL") {
  print "PRIVMSG $channel :Failure on remote server.\n";
} elsif ($rcode eq "REFUSED") {
  print "PRIVMSG $channel :Query refused by remote server.\n";
} elsif ($type eq "CH TXT" && not $answer) {
  print "PRIVMSG $channel :No version available on $server.\n";
}

flock(LOCK,LOCK_UN);
close(LOCK);
unlink("psydns.lock") or die "Can't delete psydns.lock: $!\n";