9 require IO::Socket::INET;
10 require Net::DNS::Packet;
12 use Carp qw(cluck confess);
15 require "linux/in.ph";
24 my $opt_forward_addr="localhost";
25 my $opt_forward_port=53;
26 my $opt_spoof_ip="192.168.1.1";
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,
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";
38 my $sock_udp=IO::Socket::INET->new(
42 ) or die "socket(): $!";
43 my $sock_udp_priv=IO::Socket::INET->new(
45 ) or die "socket(): $!";
46 ###fcntl($sock_udp,F_SETFL,O_NONBLOCK) or die "fnctl(sock_udp,F_SETFL,O_NONBLOCK)";
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);
60 $id=int(rand(0x10000)) if !defined $id;
70 my($msg,$from_addr,$pktinfo_data)=@_;
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
82 "from_addr"=>$from_addr,
83 "pktinfo_data"=>$pktinfo_data,
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(): $!";
91 sub check_spoofable($$)
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;
108 my($query_from_addr,$query)=@_;
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(" ",
118 $opt_spoof_ip, # rdata
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;
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
140 sub got_forward_reply($)
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;
157 warn "Got DNS reply for unknown packet id $reply_id";
161 if (check_spoofable($reply,$query)) {
162 $reply_back=reply_spoof $query_from_addr,$query or return;
165 $reply->header()->id($query->header()->id());
166 $reply_back=$reply->data();
167 warn "passing reply back to the original query host..." if $D;
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(): $!";
176 $V and print localtime()." START\n";
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;
186 if (vec($rfds,fileno($sock_udp_priv),1)) {{
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);
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";
196 got_forward_reply $msg;
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();
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();
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);
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";
219 got_query $msg,$from_addr,$pktinfo_data;