| Subject: | Protocol specific (TCP or UDP) Nameserver objects (patch included) |
Under high load, the CORE::select() call eats 50% of the total consumed CPU.
The attached patch will
I have been able to work around this by modifying Net::DNS::Nameserver to
open up just a UDP socket or just a TCP socket. When opening just a single
UDP socket, and calling loop_once with 0 timeout, I skip select() entirely
and go straight to read. This very much doubled my load capacity for the
Net::DNS::Nameserver based application.
Calls with either TCP or with multiple LocalAddr values will still require IO::Select.
I'm submitting this hoping you'll accept it upstream.
| Subject: | single-proto-patch.txt |
*** /usr/local/lib/perl/5.14.2/Net/DNS/Nameserver.pm 2014-05-23 14:41:23.000000000 -0700
--- lib/Net/DNS/Nameserver.pm 2014-05-29 20:34:25.736867551 -0700
***************
*** 18,23 ****
--- 18,24 ----
$nameserver = new Net::DNS::Nameserver(
LocalAddr => ['::1' , '127.0.0.1' ],
LocalPort => "5353",
+ Proto => "both",
ReplyHandler => \&reply_handler,
Verbose => 1,
Truncate => 0
***************
*** 95,100 ****
--- 96,102 ----
my $port = $self{LocalPort} || DEFAULT_PORT;
$self{Truncate} = 1 unless defined( $self{Truncate} );
$self{IdleTimeout} = 120 unless defined( $self{IdleTimeout} );
+ $self{Proto} = "both" unless (defined $self{Proto} );
my @sock_tcp; # All the TCP sockets we will listen to.
my @sock_udp; # All the UDP sockets we will listen to.
***************
*** 107,113 ****
#--------------------------------------------------------------------------
# Create the TCP socket.
#--------------------------------------------------------------------------
!
print "\nCreating TCP socket $addr#$port - " if $self{Verbose};
my $sock_tcp = inet_new(
--- 109,115 ----
#--------------------------------------------------------------------------
# Create the TCP socket.
#--------------------------------------------------------------------------
! if ($self{Proto} =~ /^(both|tcp)$/) {
print "\nCreating TCP socket $addr#$port - " if $self{Verbose};
my $sock_tcp = inet_new(
***************
*** 124,135 ****
} else {
cluck "Couldn't create TCP socket: $!";
}
#--------------------------------------------------------------------------
# Create the UDP Socket.
#--------------------------------------------------------------------------
! print "Creating UDP socket $addr#$port - " if $self{Verbose};
my $sock_udp = inet_new(
LocalAddr => $addr,
--- 126,139 ----
} else {
cluck "Couldn't create TCP socket: $!";
}
+ }
#--------------------------------------------------------------------------
# Create the UDP Socket.
#--------------------------------------------------------------------------
! if ($self{Proto} =~ /^(both|udp)$/) {
! print "Creating UDP socket $addr#$port - " if $self{Verbose};
my $sock_udp = inet_new(
LocalAddr => $addr,
***************
*** 143,149 ****
} else {
cluck "Couldn't create UDP socket: $!";
}
!
}
#--------------------------------------------------------------------------
--- 147,153 ----
} else {
cluck "Couldn't create UDP socket: $!";
}
! }
}
#--------------------------------------------------------------------------
***************
*** 158,163 ****
--- 162,175 ----
return undef unless $select->count;
#--------------------------------------------------------------------------
+ # Optimize for single-UDP-only case
+ #--------------------------------------------------------------------------
+ if ($self{Proto} =~ /^(both|udp)$/) {
+ if (scalar @sock_udp == 1) {
+ $self{"SingleUDPSocket"}=$sock_udp[0];
+ }
+ }
+ #--------------------------------------------------------------------------
# Return the object.
#--------------------------------------------------------------------------
***************
*** 448,453 ****
--- 460,473 ----
print ";loop_once called with timeout: " . ( defined($timeout) ? $timeout : "undefined" ) . "\n"
if $self->{Verbose} && $self->{Verbose} > 4;
+
+ # Optimize for single UDP socket case.
+ # Eliminates a large cost from CORE::select()
+ if ($self->{SingleUDPSocket}) {
+ $self->udp_connection($self->{SingleUDPSocket});
+ return;
+ }
+
foreach my $sock ( keys %{$self->{_tcp}} ) {
# There is TCP traffic to handle
***************
*** 561,566 ****
--- 581,594 ----
Verbose => 1
);
+ my $ns = new Net::DNS::Nameserver(
+ LocalAddr => "10.1.2.3",
+ LocalPort => "5353",
+ ReplyHandler => \&reply_handler,
+ Verbose => 1,
+ Proto => 'udp'
+ );
+
my $ns = new Net::DNS::Nameserver(
***************
*** 572,577 ****
--- 600,606 ----
);
+
Returns a Net::DNS::Nameserver object, or undef if the object
could not be created.
***************
*** 579,584 ****
--- 608,615 ----
LocalAddr IP address on which to listen. Defaults to INADDR_ANY.
LocalPort Port on which to listen. Defaults to 53.
+ Proto Protocol to use; tcp, udp, Defaults to "both"
+ or both.
ReplyHandler Reference to reply-handling
subroutine Required.
NotifyHandler Reference to reply-handling
***************
*** 599,604 ****
--- 630,637 ----
also list IPv6 addresses and the default is '0' (listen on all interfaces on
IPv6 and IPv4);
+ The Proto setting, if specified, allows for the ability to bind
+ only a single protocol. See L</OPTIMIZATIONS>.
The ReplyHandler subroutine is passed the query name, query class,
query type and optionally an argument containing the peerhost, the
***************
*** 732,737 ****
--- 765,797 ----
$ns->main_loop;
+ =head1 OPTIMIZATIONS
+
+ Normally, Net::DNS::Nameserver will bind to both UDP and TCP;
+ and can bind to multiple LocalAddr. IO::Select is automatically
+ used to respond to the appropriate sockets. Under high load,
+ CORE::select() can chew significant CPU.
+
+ If you open just a single socket, for a single address,
+ for only UDP, then calls to loop_once(0) or main_loop()
+ will skip the select() call, and go straight to read();
+
+ Keep in mind, you may need to have a seperate process
+ that handles TCP; and/or seperate processes for IPv4 vs IPv6.
+
+ my $ns = new Net::DNS::Nameserver(
+ LocalAddr => "0.0.0.0",
+ LocalPort => 53,
+ Proto => "udp",
+ ReplyHandler => \&reply_handler,
+ Verbose => 1
+ ) || die "couldn't create nameserver object\n";
+
+ while(1) {
+ $ns->loop_once(0);
+ }
+
+
=head1 BUGS
Limitations in perl 5.8.6 makes it impossible to guarantee that