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