# HG changeset patch
# User Matthias Förste <foerste@schlittermann.de>
# Date 1377510360 -7200
# Node ID a94c51554e8d9da78cfbcf98ae97dcb1f4ce9720

should work

diff -r 000000000000 -r a94c51554e8d dnsproxy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/dnsproxy	Mon Aug 26 11:46:00 2013 +0200
@@ -0,0 +1,140 @@
+#!/usr/bin/perl
+
+#    Copyright (C) 2013  Matthias Förste
+#
+#    This program is free software: you can redistribute it and/or modify
+#    it under the terms of the GNU General Public License as published by
+#    the Free Software Foundation, either version 3 of the License, or
+#    (at your option) any later version.
+#
+#    This program is distributed in the hope that it will be useful,
+#    but WITHOUT ANY WARRANTY; without even the implied warranty of
+#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#    GNU General Public License for more details.
+#
+#    You should have received a copy of the GNU General Public License
+#    along with this program.  If not, see <http://www.gnu.org/licenses/>.
+#
+#    Matthias Förste <foerste@schlittermann.de>
+
+=encoding utf8
+=cut
+
+use strict;
+use warnings;
+
+use Getopt::Long;
+use Pod::Usage;
+
+my $opts = {
+    listen => [ '127.0.0.2' ],
+    port   => 53
+};
+
+GetOptions(
+    "h|help" => sub { pod2usage( -verbose => 0, -exitval => 0 ) },
+    "m|man"  => sub {
+        pod2usage(
+            -verbose   => 2,
+            -exitval   => 0,
+            -noperldoc => ( `perldoc -V 2>/dev/null`, $? != 0 )[-1]
+        );
+    },
+    "l|listen=s" => $opts->{listen},
+    "p|port=i"   => \$opts->{port},
+    "v|verbose"  => \$opts->{verbose}
+) or pod2usage();
+
+#die $opts->{port};
+
+use Net::DNS::Nameserver;
+use Net::DNS::Resolver;
+
+my $res = Net::DNS::Resolver->new;
+my $ns = Net::DNS::Nameserver->new(
+    LocalAddr        => $opts->{listen},
+    LocalPort        => $opts->{port},
+    ReplyHandler     => \&reply_handler,
+    Verbose          => $opts->{verbose},
+    Truncate         => 0,
+) or die;
+$ns->main_loop;
+
+sub reply_handler {
+
+    my ($qname, $qclass, $qtype, $peerhost, $query, $conn) = @_;
+    my ($rcode, @ans, @auth, @add);
+
+    if ($opts->{verbose}) {
+        print "Received query from $peerhost to ". $conn->{"sockhost"}. "\n";
+        $query->print;
+    }
+
+    # we don't know when shell may fix their dns servers so we answer for them
+    return 'NOERROR' if ($qtype eq 'AAAA' and $qname =~ /(^|\.)shell\.com/);
+
+    # everything else is just forwarded to our regular resolver
+    my $p = $res->send($query);
+    return (
+        $p->header->rcode,
+        [$p->answer],
+        [$p->authority],
+        [$p->additional]
+    );
+
+}
+
+__END__
+
+=pod
+
+=head1 NAME
+
+dnsproxy - a simple dns proxy
+
+=head1 SYNOPSIS
+
+dnsproxy [-l|--listen address]
+         [-p|--port port]
+
+dnsproxy -m|--man
+         -h|--help
+
+=head1 DESCRIPTION
+
+This is just a very simple dns proxy to workaround a dns Problem with the
+shell.com domain. Nameservers for this domain are rfc 4074 / 4.1 'compliant' as
+they don't reply to AAAA Queries (at least not to Queries to
+www.shellcardonline.shell.com and at least 2 related names):
+
+    4.1. Ignore Queries for AAAA
+    
+    Some authoritative servers seem to ignore queries for an AAAA RR, causing a
+    delay at the stub resolver to fall back to a query for an A RR.  This
+    behavior may cause a fatal timeout at the resolver or at the application
+    that calls the resolver.  Even if the resolver eventually falls back, the
+    result can be an unacceptable delay for the application user, especially
+    with interactive applications like web browsing.
+ 
+It's not at all generalized.
+
+=head1 OPTIONS
+
+=over
+
+=item B<-l|--listen> I<ip>
+
+Listen on ip address <ip>. The default is 127.0.0.2 and not 127.0.0.1 to avoid
+conflicts with an already running resolver. Can be given multiple times.
+
+=item B<-p|--port> I<port>
+
+Listen on port <port>. The default is 53.
+
+=back
+
+=head1 AUTHOR
+
+Matthias Förste <foerste@schlittermann.de>
+
+=cut