netdnsspoof

   1 #! /usr/bin/perl
   2 #
   3 # $Id$
   4
   5
   6 use strict;
   7 use warnings;
   8 use Getopt::Long;
   9 require IO::Socket::INET;
  10 require Net::DNS::Packet;
  11 use Fcntl;
  12 use Carp qw(cluck confess);
  13 use Socket;
  14 use Socket::MsgHdr;
  15 require "linux/in.ph";
  16
  17
  18 my $V=1;
  19 $|=1;
  20
  21 my $D;
  22 my $opt_addr;
  23 my $opt_port=5353;
  24 my $opt_forward_addr="localhost";
  25 my $opt_forward_port=53;
  26 my $opt_spoof_ip="192.168.1.1";
  27 die if !GetOptions(
  28                 "a|addr=s",\$opt_addr,
  29                 "p|port=s",\$opt_port,
  30                   "forward-addr=s",\$opt_forward_addr,
  31                   "forward-port=s",\$opt_forward_port,
  32                 "i|spoof-ip=s",\$opt_spoof_ip,
  33                 "d|debug+",\$D,
  34                 );
  35 my $forward_host=gethostbyname($opt_forward_addr) or die "resolving $opt_forward_addr: $!";
  36 my $forward_addr=sockaddr_in($opt_forward_port,$forward_host) or die "assembling $opt_forward_addr:$opt_forward_port";
  37
  38 my $sock_udp=IO::Socket::INET->new(
  39                 LocalAddr=>$opt_addr,
  40                 LocalPort=>$opt_port,
  41                 Proto=>"udp",
  42                 ) or die "socket(): $!";
  43 my $sock_udp_priv=IO::Socket::INET->new(
  44                 Proto=>"udp",
  45                 ) or die "socket(): $!";
  46 ###fcntl($sock_udp,F_SETFL,O_NONBLOCK) or die "fnctl(sock_udp,F_SETFL,O_NONBLOCK)";
  47
  48 my $ip_pktinfo_got=setsockopt $sock_udp,IPPROTO_IP(),IP_PKTINFO(),pack("i",1);
  49 # FIXME: Why Linux kernel 2.6.9-1.678_FC3 returns 1 instead of 0?
  50 confess 'setsockopt(sock_udp,IPPROTO_IP,IP_PKTINFO,&1)='.$ip_pktinfo_got
  51                 if !defined $ip_pktinfo_got || 0>$ip_pktinfo_got;
  52 my $ip_pktinfo_val=getsockopt $sock_udp,IPPROTO_IP(),IP_PKTINFO();
  53 confess 'getsockopt(sock_udp,IPPROTO_IP,IP_PKTINFO)!=1'
  54                 if 1!=unpack("i",$ip_pktinfo_val);
  55
  56
  57 sub id_next()
  58 {
  59         our $id;
  60         $id=int(rand(0x10000)) if !defined $id;
  61         $id++;
  62         $id&=0xFFFF;
  63         return $id;
  64 }
  65
  66 my %sent;
  67
  68 sub got_query($$$)
  69 {
  70 my($msg,$from_addr,$pktinfo_data)=@_;
  71
  72         my $query=Net::DNS::Packet->new(\$msg);
  73         # FIXME: It really occured on hoteltest.
  74         do { warn "Failed to parse DNS packet query: ".unpack("H*",$msg); return; } if !$query;
  75         my $query_id_orig=$query->header()->id();
  76         my $query_id=id_next();
  77         $query->header()->id($query_id);
  78         my $msg_forward=$query->data();
  79         $query->header()->id($query_id_orig);   # fix-up back
  80         $sent{$query_id}={
  81                 "msg"=>$msg,
  82                 "from_addr"=>$from_addr,
  83                 "pktinfo_data"=>$pktinfo_data,
  84                 "query"=>$query,
  85                 };
  86         warn "registered pending query id $query_id..." if $D;
  87         warn "sending forwarded DNS query (mapped id $query_id_orig -> $query_id)..." if $D;
  88         send $sock_udp_priv,$msg_forward,0,$forward_addr or cluck "send(): $!";
  89 }
  90
  91 sub check_spoofable($$)
  92 {
  93 my($reply,$query)=@_;
  94
  95         warn "checking packet spoofability from the reply... (non-spoofable if silent)" if $D;
  96         my @questions=$query->question();
  97         return 0 if 1!=@questions;
  98         my $question=$questions[0];
  99         return 0 if $question->qtype() ne "A"
 100                  && $question->qtype() ne "ANY";
 101         return 0 if $reply->header()->rcode() ne "NXDOMAIN";
 102         warn "packet considered as spoofable." if $D;
 103         return 1;
 104 }
 105
 106 sub reply_spoof($$)
 107 {
 108 my($query_from_addr,$query)=@_;
 109
 110         warn "assembling spoof reply..." if $D;
 111         my $question=($query->question())[0];
 112         my $spoof=Net::DNS::Packet->new($question->qname(),$question->qclass(),$question->qtype());
 113         $spoof->push("answer",Net::DNS::RR->new(join(" ",
 114                         $question->qname(),
 115                         3600,   # ttl
 116                         $question->qclass(),
 117                         "A",    # qtype
 118                         $opt_spoof_ip,  # rdata
 119                         )));
 120         $spoof->header()->rcode("NOERROR");
 121         $spoof->header()->aa(0);
 122         $spoof->header()->qr(1);
 123         $spoof->header()->ra(1);
 124         $spoof->header()->rd($query->header()->rd());
 125         $spoof->header()->id($query->header()->id());
 126         my $msg_spoof=$spoof->data();
 127         warn "sending spoof reply..." if $D;
 128         if ($V) {
 129                 my($query_from_addr_port,$query_from_addr_host)=sockaddr_in($query_from_addr);
 130                 my $query_from_addr_name=inet_ntoa $query_from_addr_host;
 131                 print localtime()." spoof:"
 132                                 ." from=$query_from_addr_name:$query_from_addr_port"
 133                                 ." qname=".$question->qname()
 134                                 ." ip=".$opt_spoof_ip
 135                                 ."\n";
 136                 }
 137         return $msg_spoof;
 138 }
 139
 140 sub got_forward_reply($)
 141 {
 142 my($msg)=@_;
 143
 144         warn "parsing reply from our forwarded DNS..." if $D;
 145         my $reply=Net::DNS::Packet->new(\$msg);
 146         my $reply_id=$reply->header()->id();
 147         my($query_msg,$query_from_addr,$query_pktinfo_data,$query);
 148         if (my $hash=$sent{$reply_id}) {
 149                 delete $sent{$reply_id};
 150                 $query_msg         =$hash->{"msg"};
 151                 $query_from_addr   =$hash->{"from_addr"};
 152                 $query_pktinfo_data=$hash->{"pktinfo_data"};
 153                 $query             =$hash->{"query"};
 154                 warn "deleted pending record with id $reply_id." if $D;
 155                 }
 156         else {
 157                 warn "Got DNS reply for unknown packet id $reply_id";
 158                 return;
 159                 }
 160         my $reply_back;
 161         if (check_spoofable($reply,$query)) {
 162                 $reply_back=reply_spoof $query_from_addr,$query or return;
 163                 }
 164         else {
 165                 $reply->header()->id($query->header()->id());
 166                 $reply_back=$reply->data();
 167                 warn "passing reply back to the original query host..." if $D;
 168                 }
 169         my $msghdr=Socket::MsgHdr->new();
 170         $msghdr->buf($reply_back);
 171         $msghdr->name($query_from_addr);
 172         $msghdr->cmsghdr(IPPROTO_IP(),IP_PKTINFO(),$query_pktinfo_data);
 173         sendmsg $sock_udp,$msghdr or cluck "sendmsg(): $!";
 174 }
 175
 176 $V and print localtime()." START\n";
 177 for (;;) {
 178         my $rfds="";
 179         vec($rfds,fileno($sock_udp),1)=1;
 180         vec($rfds,fileno($sock_udp_priv),1)=1;
 181         warn "select(2)..." if $D;
 182         my $got=select $rfds,undef(),undef(),undef();
 183         warn "got from select." if $D;
 184         die "Invalid select(2): ".Dumper($got) if !defined $got || $got<0;
 185
 186         if (vec($rfds,fileno($sock_udp_priv),1)) {{
 187                 my $msg;
 188                 defined(my $from_addr=recv $sock_udp_priv,$msg,0x10000,0) or do { cluck "recv(sock_udp_priv): $!"; next; };
 189                 warn "got packet from forwarding DNS..." if $D;
 190                 my($from_addr_port,$from_addr_host)=sockaddr_in($from_addr);
 191
 192                 if ($from_addr_host ne $forward_host || $from_addr_port ne $opt_forward_port) {
 193                         warn "original query forbidden from the private forwarding socket";
 194                         next;
 195                         }
 196                 got_forward_reply $msg;
 197                 }}
 198         if (vec($rfds,fileno($sock_udp),1)) {{
 199                 # "namelen"=>0x10 to prevent: Bad arg length for Socket::unpack_sockaddr_in, length is 4096, should be 16 at /usr/lib/perl5/5.8.5/i386-linux-thread-multi/Socket.pm line 370.
 200                 my $msghdr=Socket::MsgHdr->new("buflen"=>0x10000,"namelen"=>0x10,"controllen"=>0x1000);
 201                 defined(recvmsg($sock_udp,$msghdr,0)) or do { cluck "recvmsg(sock_udp): $!"; next; };
 202                 warn "got packet as original query..." if $D;
 203                 my $msg=$msghdr->buf();
 204                 my $pktinfo_data;
 205                 my @cmsg=$msghdr->cmsghdr();
 206                 while (my($level,$type,$data)=splice(@cmsg,0,3)) {
 207                         do { warn "unknown cmsg level $level"; next; } if $level!=IPPROTO_IP();
 208                         do { warn "unknown cmsg level $type";  next; } if $type !=IP_PKTINFO();
 209                         $pktinfo_data=$data;
 210                         }
 211                 do { warn "IP_PKTINFO not found for a packet"; next; } if !defined $pktinfo_data;
 212                 my $from_addr=$msghdr->name();
 213                 my($from_addr_port,$from_addr_host)=sockaddr_in($from_addr);
 214
 215                 if ($from_addr_host eq $forward_host && $from_addr_port eq $opt_forward_port) {
 216                         warn "packet returned from forwarding DNS forbidden from the main listening socket";
 217                         next;
 218                         }
 219                 got_query $msg,$from_addr,$pktinfo_data;
 220                 }}
 221         }