use Fcntl;
use Carp qw(cluck confess);
use Socket;
+use Socket::MsgHdr;
+require "linux/in.ph";
my $V=1;
) or die "socket(): $!";
###fcntl($sock_udp,F_SETFL,O_NONBLOCK) or die "fnctl(sock_udp,F_SETFL,O_NONBLOCK)";
+my $ip_pktinfo_got=setsockopt $sock_udp,IPPROTO_IP(),IP_PKTINFO(),pack("i",1);
+# FIXME: Why Linux kernel 2.6.9-1.678_FC3 returns 1 instead of 0?
+confess 'setsockopt(sock_udp,IPPROTO_IP,IP_PKTINFO,&1)='.$ip_pktinfo_got
+ if !defined $ip_pktinfo_got || 0>$ip_pktinfo_got;
+my $ip_pktinfo_val=getsockopt $sock_udp,IPPROTO_IP(),IP_PKTINFO();
+confess 'getsockopt(sock_udp,IPPROTO_IP,IP_PKTINFO)!=1'
+ if 1!=unpack("i",$ip_pktinfo_val);
+
+
sub id_next()
{
our $id;
my %sent;
-sub got_query($$)
+sub got_query($$$)
{
-my($msg,$from_addr)=@_;
+my($msg,$from_addr,$pktinfo_data)=@_;
my $query=Net::DNS::Packet->new(\$msg);
my $query_id_orig=$query->header()->id();
$sent{$query_id}={
"msg"=>$msg,
"from_addr"=>$from_addr,
+ "pktinfo_data"=>$pktinfo_data,
"query"=>$query,
};
warn "registered pending query id $query_id..." if $D;
$spoof->header()->id($query->header()->id());
my $msg_spoof=$spoof->data();
warn "sending spoof reply..." if $D;
- send $sock_udp,$msg_spoof,0,$query_from_addr or cluck "send(): $!";
+ return $msg_spoof;
if ($V) {
my($query_from_addr_port,$query_from_addr_host)=sockaddr_in($query_from_addr);
my $query_from_addr_name=inet_ntoa $query_from_addr_host;
warn "parsing reply from our forwarded DNS..." if $D;
my $reply=Net::DNS::Packet->new(\$msg);
my $reply_id=$reply->header()->id();
- my($query_msg,$query_from_addr,$query);
+ my($query_msg,$query_from_addr,$query_pktinfo_data,$query);
if (my $hash=$sent{$reply_id}) {
delete $sent{$reply_id};
- $query_msg =$hash->{"msg"};
- $query_from_addr=$hash->{"from_addr"};
- $query =$hash->{"query"};
+ $query_msg =$hash->{"msg"};
+ $query_from_addr =$hash->{"from_addr"};
+ $query_pktinfo_data=$hash->{"pktinfo_data"};
+ $query =$hash->{"query"};
warn "deleted pending record with id $reply_id." if $D;
}
else {
warn "Got DNS reply for unknown packet id $reply_id";
return;
}
+ my $reply_back;
if (check_spoofable($reply,$query)) {
- reply_spoof $query_from_addr,$query;
- return;
+ $reply_back=reply_spoof $query_from_addr,$query or return;
}
- $reply->header()->id($query->header()->id());
- my $reply_back=$reply->data();
- warn "passing reply back to the original query host..." if $D;
- send $sock_udp,$reply_back,0,$query_from_addr or cluck "send(): $!";
+ else {
+ $reply->header()->id($query->header()->id());
+ $reply_back=$reply->data();
+ warn "passing reply back to the original query host..." if $D;
+ }
+ my $msghdr=Socket::MsgHdr->new();
+ $msghdr->buf($reply_back);
+ $msghdr->name($query_from_addr);
+ $msghdr->cmsghdr(IPPROTO_IP(),IP_PKTINFO(),$query_pktinfo_data);
+ sendmsg $sock_udp,$msghdr or cluck "sendmsg(): $!";
}
$V and print localtime()." START\n";
warn "got from select." if $D;
die "Invalid select(2): ".Dumper($got) if !defined $got || $got<0;
- for my $sock ($sock_udp,$sock_udp_priv) {
- next if !vec($rfds,fileno($sock),1);
+ if (vec($rfds,fileno($sock_udp_priv),1)) {{
my $msg;
- defined(my $from_addr=recv $sock,$msg,0x1000,0) or do { cluck "recv(): $!"; next; };
- warn "got packet." if $D;
+ defined(my $from_addr=recv $sock_udp_priv,$msg,0x10000,0) or do { cluck "recv(sock_udp_priv): $!"; next; };
+ warn "got packet from forwarding DNS..." if $D;
my($from_addr_port,$from_addr_host)=sockaddr_in($from_addr);
- if ($from_addr_host eq $forward_host && $from_addr_port eq $opt_forward_port) {
- warn "packet returned from forwarding DNS..." if $D;
- if ($sock eq $sock_udp) {
- warn "packet returned from forwarding DNS forbidden from the main listening socket";
- next;
- }
- got_forward_reply $msg;
+ if ($from_addr_host ne $forward_host || $from_addr_port ne $opt_forward_port) {
+ warn "original query forbidden from the private forwarding socket";
+ next;
}
- else {
- warn "original query..." if $D;
- if ($sock eq $sock_udp_priv) {
- warn "original query forbidden from the private forwarding socket";
- next;
- }
- got_query $msg,$from_addr;
+ got_forward_reply $msg;
+ }}
+ if (vec($rfds,fileno($sock_udp),1)) {{
+ # "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.
+ my $msghdr=Socket::MsgHdr->new("buflen"=>0x10000,"namelen"=>0x10,"controllen"=>0x1000);
+ defined(recvmsg($sock_udp,$msghdr,0)) or do { cluck "recvmsg(sock_udp): $!"; next; };
+ warn "got packet as original query..." if $D;
+ my $msg=$msghdr->buf();
+ my $pktinfo_data;
+ my @cmsg=$msghdr->cmsghdr();
+ while (my($level,$type,$data)=splice(@cmsg,0,3)) {
+ do { warn "unknown cmsg level $level"; next; } if $level!=IPPROTO_IP();
+ do { warn "unknown cmsg level $type"; next; } if $type !=IP_PKTINFO();
+ $pktinfo_data=$data;
}
- }
+ do { warn "IP_PKTINFO not found for a packet"; next; } if !defined $pktinfo_data;
+ my $from_addr=$msghdr->name();
+ my($from_addr_port,$from_addr_host)=sockaddr_in($from_addr);
+
+ if ($from_addr_host eq $forward_host && $from_addr_port eq $opt_forward_port) {
+ warn "packet returned from forwarding DNS forbidden from the main listening socket";
+ next;
+ }
+ got_query $msg,$from_addr,$pktinfo_data;
+ }}
}