# HG changeset patch
# User Matthias Förste <foerste@schlittermann.de>
# Date 1377515825 -7200
# Node ID b888e5e9ae4df45f0395069eb3ef7d19d875a35a
# Parent  a94c51554e8d9da78cfbcf98ae97dcb1f4ce9720
rewritten to use "Net::Server" because we need a forking server

diff -r a94c51554e8d -r b888e5e9ae4d dnsproxy
--- a/dnsproxy	Mon Aug 26 11:46:00 2013 +0200
+++ b/dnsproxy	Mon Aug 26 13:17:05 2013 +0200
@@ -1,4 +1,4 @@
-#!/usr/bin/perl
+#!/usr/bin/perl -w -T
 
 #    Copyright (C) 2013  Matthias Förste
 #
@@ -23,6 +23,8 @@
 use strict;
 use warnings;
 
+package dnsproxy;
+
 use Getopt::Long;
 use Pod::Usage;
 
@@ -42,45 +44,56 @@
     },
     "l|listen=s" => $opts->{listen},
     "p|port=i"   => \$opts->{port},
-    "v|verbose"  => \$opts->{verbose}
+    "v|verbose=i"  => \$opts->{verbose}
 ) or pod2usage();
 
-#die $opts->{port};
+use File::Basename;
+my $ME = basename $0;
+
+use Net::DNS::Resolver;
+use Net::DNS::Packet;
+use base qw(Net::Server::Fork);
 
-use Net::DNS::Nameserver;
-use Net::DNS::Resolver;
+my $resolver = Net::DNS::Resolver->new;
+my %args = (
+    host => $opts->{listen},
+    port => "$opts->{port}/udp",
+    log_file => 'Sys::Syslog',
+    syslog_ident => $ME
+);
+$args{log_level} = $opts->{verbose} if defined $opts->{verbose};
+dnsproxy->run(%args);
+
+sub process_request {
 
-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;
+    my $self = shift;	
+    my $prop = $self->{server};
+
+    die 'Sorry, udp only!' unless $prop->{udp_true};
+
+    my ($q, $e) = Net::DNS::Packet->new(\$prop->{udp_data});
+    die "Sorry: $e" unless defined $q;
 
-sub reply_handler {
+    my $r;
+    my @q = $q->question;
+    die 'Sorry, single question only!' unless @q == 1;
 
-    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
+    if ($q[0]->qtype eq 'AAAA' and $q[0]->qname =~ /(^|\.)shell\.com/) {
+        $r = $q;
+        $r->header->qr(1);
+        $r->header->ra(1);
+        # everything else is just forwarded to our regular resolver
+    } else {
+        $r = $resolver->send($q);
     }
 
-    # 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/);
+    # trigger parsing of nonquestion sections because 'data' would return only
+    # the question section(s) otherwise (TODO: Bug report against
+    # Net::DNS::Packet)
+    $r->string;
 
-    # everything else is just forwarded to our regular resolver
-    my $p = $res->send($query);
-    return (
-        $p->header->rcode,
-        [$p->answer],
-        [$p->authority],
-        [$p->additional]
-    );
+    $prop->{client}->send($r->data, 0);
 
 }
 
@@ -96,6 +109,7 @@
 
 dnsproxy [-l|--listen address]
          [-p|--port port]
+         [-v|--verbose level]
 
 dnsproxy -m|--man
          -h|--help
@@ -131,6 +145,10 @@
 
 Listen on port <port>. The default is 53.
 
+=item B<-v|--verbose> I<level>
+
+Verbosity level. Passed to Net::Server.
+
 =back
 
 =head1 AUTHOR