Skip Menu |
 

This queue is for tickets about the Net-DNS CPAN distribution.

Report information
The Basics
Id: 84601
Status: resolved
Priority: 0/
Queue: Net-DNS

People
Owner: Nobody in particular
Requestors: hendrik.schumacher [...] meetrics.de
jared [...] puck.nether.net
jfesler [...] gigo.com
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in: (no value)
Fixed in: (no value)



Subject: Memory Leak in query after version 0.68
Date: Sat, 13 Apr 2013 00:08:47 +0200
To: bug-Net-DNS [...] rt.cpan.org
From: Hendrik Schumacher <hendrik.schumacher [...] meetrics.de>
Download (untitled) / with headers
text/plain 514b
The following code is leaking memory with versions 0.69 to 0.72 while its working fine in 0.68: #!/usr/bin/perl use Net::DNS; use Devel::Leak; for (my $i = 0; $i < 30; $i++) { my $dns_resolver = Net::DNS::Resolver->new; my $dns_packet = $dns_resolver->query('www.google.de', 'A'); my $handle; print Devel::Leak::NoteSV($handle)."\n"; } Output for 0.68: 21579 21579 21579 21579 21579 21579 21579 21578 ... Output for 0.69 and above: 23305 23404 23507 23610 23713 23816 23919 24022 24125 ... Hendrik
Subject: Re: [rt.cpan.org #84601] AutoReply: Memory Leak in query after version 0.68
Date: Mon, 15 Apr 2013 11:13:11 +0200
To: bug-Net-DNS [...] rt.cpan.org
From: Hendrik Schumacher <hendrik.schumacher [...] meetrics.de>
Download (untitled) / with headers
text/plain 578b
Hi, short follow-up to this issue. Using Devel::Cycle shows the following cyclic reference: Cycle (1): $Net::DNS::Packet::A->{'header'} => \%Net::DNS::Header::B $Net::DNS::Header::B->{'xbody'} => \%Net::DNS::Packet::A This seems to be the same as Fix rt.cpan.org #81942 Fix memory leak on packet cleanup. The back-reference via the header attribute (with xbody) caused the garbage collector not to clean a packet. Header is now explicitly cleaned via Net::DNS::Packet::DESTROY. that should have been fixed in 0.71. Thanks for looking into this.
Subject: Net::DNS::Nameserver / Net::DNS::Packet leak and workaround
Date: Sun, 2 Jun 2013 09:13:58 -0700
To: bug-Net-DNS [...] rt.cpan.org
From: Jason Fesler <jfesler [...] gigo.com>
Hello, I have found this to be leaky: while ( 1) { my $packet = new Net::DNS::Packet; } Put that in a loop, and the host goes towards the land of the Big Swap in no time. To quantify it: jfesler 15828 1.7 0.3 34544 8060 pts/1 S+ 09:09 0:00 perl -d -e 1 main::(-e:1): 1 DB<1> use Net::DNS::Packet DB<2> $i = 0; while ($i++ < 100000) { my $x = new Net::DNS::Packet ; } DB<3> while ($i++ < 1000000) { my $x = new Net::DNS::Packet ; } After #2 and #3 above: jfesler 15828 16.4 5.6 147484 116876 pts/1 S+ 09:09 0:04 perl -d -e 1 jfesler 15828 42.2 52.0 1097488 1067012 pts/1 S+ 09:09 0:46 perl -d -e 1 150 megs after the first 100k instances; A gig of ram after a million local instances. Normally, this is probably not a problem. Unless you're trying to do something long-lived. Like a DNS server. cpan[2]> i /Net::DNS::Packet/ Module id = Net::DNS::Packet CPAN_USERID NLNETLABS (NLnet Labs <cpan@nlnetlabs.nl>) CPAN_VERSION 1086 CPAN_FILE N/NL/NLNETLABS/Net-DNS-0.72.tar.gz UPLOAD_DATE 2012-12-28 MANPAGE Net::DNS::Packet - DNS protocol packet INST_FILE /usr/local/lib/perl/5.14.2/Net/DNS/Packet.pm INST_VERSION 1086 This is what I had to do to Nameserver.pm to get it to be memory-stable under load. jfesler@geolb1:~/geolb$ grep Id: Nameserver.pm.orig # $Id: Nameserver.pm 1096 2012-12-28 13:35:15Z willem $ jfesler@geolb1:~/geolb$ diff -c Nameserver.pm.orig Nameserver.pm *** Nameserver.pm.orig 2013-06-02 08:19:04.267667483 -0700 --- Nameserver.pm 2013-06-02 08:53:51.355663620 -0700 *************** *** 373,378 **** --- 373,384 ---- # We are done. $self->{_tcp}{$sock}{state} = STATE_SENDING; + + # Explicitly clean up after Net::DNS::Packet + # to work around a memory leak + $query->DESTROY; + $reply->DESTROY; + } } } *************** *** 421,426 **** --- 427,437 ---- } else { print "failed to send reply: $!\n" if $self->{Verbose}; } + + # Explicitly clean up after Net::DNS::Packet + # to work around a memory leak + $query->DESTROY; + $reply->DESTROY; } -jason
Subject: Re: [rt.cpan.org #85802] AutoReply: Net::DNS::Nameserver / Net::DNS::Packet leak and workaround
Date: Sun, 2 Jun 2013 09:17:10 -0700
To: bug-Net-DNS [...] rt.cpan.org
From: Jason Fesler <jfesler [...] gigo.com>
Download (untitled) / with headers
text/plain 639b
Btw, looking at a fresh Packet: main::(-e:1): 1 DB<1> use Net::DNS::Packet DB<2> $x = new Net::DNS::Packet DB<3> x $x 0 Net::DNS::Packet=HASH(0x1572900) 'additional' => ARRAY(0x156d4c0) empty array 'answer' => ARRAY(0x1586ba0) empty array 'authority' => ARRAY(0x1572bd0) empty array 'header' => Net::DNS::Header=HASH(0x19037d8) 'count' => ARRAY(0x1904718) empty array 'id' => 2497 'status' => 256 'xbody' => Net::DNS::Packet=HASH(0x1572900) -> REUSED_ADDRESS <------------------------ 'question' => ARRAY(0x1573020) empty array
Subject: Memory Leak in 0.72 Net::DNS
Date: Tue, 25 Jun 2013 15:24:49 -0400
To: bug-Net-DNS [...] rt.cpan.org
From: Jared Mauch <jared [...] puck.nether.net>
Download (untitled) / with headers
text/plain 655b
in Header.pm line 550 ($self->{count} = [unpack 'x4 n6', $$data];) seems to cause a memory leak. When decoding a large dataset, eg: data file from here - http://puck.nether.net/~jared/raw-dns-scan/ with the dns-decode.pl script included, I easily see the script become 20GB resident in memory and slowly consume all available swap space. These data files are part of the OpenResolverProject and being used for research purposes. I am unsure how to avoid the leak other than commenting out that line. We have seen this both using the Fedora-19 package and a self-installed version of the package. Let me know if you have further questions. - Jared
From: rwfranks [...] acm.org
Same issue as RT#84601 and RT#85802
Download (untitled) / with headers
text/plain 128b
Hi Hendrik, Jared and Jason, Thanks for reporting this. Attached patch against Net::DNS 0.72 resolves the issue. Best regards,
Subject: net-dns-0.72-mem-leak.patch
Index: lib/Net/DNS/Packet.pm =================================================================== --- lib/Net/DNS/Packet.pm (revision 1099) +++ lib/Net/DNS/Packet.pm (working copy) @@ -30,7 +30,6 @@ use base Exporter; @EXPORT_OK = qw(dn_expand); -use strict; use integer; use Carp; @@ -67,7 +66,8 @@ authority => [], additional => []}, $class; - $self->{question} = [Net::DNS::Question->new(@_)] if @_; + $self->{question} = [Net::DNS::Question->new(@_)] if scalar @_; + $self->{header} = {}; # For compatibility with Net::DNS::SEC $self->header->rd(1); return $self; @@ -114,20 +114,23 @@ eval { die 'corrupt wire-format data' if length($$data) < HEADER_LENGTH; + # header section + my ( $id, $status, @count ) = unpack 'n6', $$data; + my ( $qd, $an, $ns, $ar ) = @count; + $offset = HEADER_LENGTH; + $self = bless { + id => $id, + status => $status, + count => [@count], question => [], answer => [], authority => [], additional => [], - answersize => length $$data + answersize => length $$data, + header => {} # Compatibility with Net::DNS::SEC }, $class; - # header section - my $header = $self->header; - $header->decode($data); - my ( $qd, $an, $ns, $ar ) = map { $header->$_ } qw(qdcount ancount nscount arcount); - $offset = HEADER_LENGTH; - # question/zone section my $hash = {}; my $record; @@ -178,18 +181,21 @@ sub data { my $self = shift; - for ( my $edns = $self->edns ) { # EDNS support + my $header = $self->header; # packet header + my $ident = $header->id; + + for ( my $edns = $header->edns ) { # EDNS support my @xopt = grep { $_->type ne 'OPT' } @{$self->{additional}}; $self->{additional} = $edns->default ? [@xopt] : [$edns, @xopt]; } - my $data = $self->header->encode; # packet header + my @part = qw(question answer authority additional); + my @size = map scalar( @{$self->{$_}} ), @part; + my $data = pack 'n6', $ident, $self->{status}, @size; + $self->{count} = []; my $hash = {}; # packet body - foreach my $component ( @{$self->{question}}, - @{$self->{answer}}, - @{$self->{authority}}, - @{$self->{additional}} ) { + foreach my $component ( map @{$self->{$_}}, @part ) { $data .= $component->encode( length $data, $hash, $self ); } @@ -208,8 +214,7 @@ =cut sub header { - my $self = shift; - $self->{header} ||= new Net::DNS::Header($self); + return new Net::DNS::Header(shift); } @@ -243,19 +248,20 @@ sub reply { my $query = shift; my $UDPmax = shift; - die 'erroneous qr flag in query packet' if $query->header->qr; + my $qheadr = $query->header; + die 'erroneous qr flag in query packet' if $qheadr->qr; my $reply = new Net::DNS::Packet(); - my $header = $reply->header; - $header->qr(1); # reply with same id, opcode and question - $header->id( $query->header->id ); - $header->opcode( $query->header->opcode ); - $reply->{question} = [$query->question]; + my $rheadr = $reply->header; + $rheadr->qr(1); # reply with same id, opcode and question + $rheadr->id( $qheadr->id ); + $rheadr->opcode( $qheadr->opcode ); + $reply->{question} = $query->{question}; - $header->rcode('FORMERR'); # failure to provide RCODE is sinful! + $rheadr->rcode('FORMERR'); # failure to provide RCODE is sinful! - $header->rd( $query->header->rd ); # copy these flags into reply - $header->cd( $query->header->cd ); + $rheadr->rd( $qheadr->rd ); # copy these flags into reply + $rheadr->cd( $qheadr->cd ); $reply->edns->size($UDPmax) unless $query->edns->default; return $reply; @@ -405,7 +411,7 @@ sub answerfrom { my $self = shift; - return $self->{answerfrom} = shift if @_; + return $self->{answerfrom} = shift if scalar @_; return $self->{answerfrom}; } @@ -778,7 +784,7 @@ my $i=0; my @stripped_additonal; - while ($i< @{$self->{'additional'}}){ + while ( $i < scalar @{$self->{'additional'}} ) { #remove all of these same RRtypes if ( ${$self->{'additional'}}[$i]->type eq $popped->type && @@ -814,21 +820,16 @@ use vars qw($AUTOLOAD); -sub AUTOLOAD { ## Default method +sub AUTOLOAD { ## Default method no strict; @_ = ("method $AUTOLOAD undefined"); goto &{'Carp::confess'}; } -sub DESTROY { ## object destructor - my $self = shift; - my $header = $self->header; # invalidate Header object - %$header = (); - undef $self->{header}; # unlink defunct header -} +sub DESTROY { } ## Avoid tickling AUTOLOAD (in cleanup) -sub dump { ## print internal data structure +sub dump { ## print internal data structure use Data::Dumper; $Data::Dumper::Sortkeys = sub { return [sort keys %{$_[0]}] }; my $self = shift; Index: lib/Net/DNS/Header.pm =================================================================== --- lib/Net/DNS/Header.pm (revision 1099) +++ lib/Net/DNS/Header.pm (working copy) @@ -51,56 +51,10 @@ croak 'object model violation' unless $packet->isa(qw(Net::DNS::Packet)); - my $self = bless { - status => 0, - count => [], - xbody => $packet - }, $class; - - $self->id(undef); - - return $self; + bless { xbody => $packet }, $class; } -=head2 decode - - $header->decode(\$data); - -Decodes the header record at the start of a DNS packet. -The argument is a reference to the packet data. - -=cut - -sub decode { - my $self = shift; - my $data = shift; - - @{$self}{qw(id status)} = unpack 'n2', $$data; - $self->{count} = [unpack 'x4 n6', $$data]; -} - - -=head2 encode - - $header->encode(\$data); - -Returns the header data in binary format, appropriate for use in a -DNS packet. - -=cut - -sub encode { - my $self = shift; - - $self->{count} = []; - - my @count = map { $self->$_ } qw(qdcount ancount nscount arcount); - - return pack 'n6', $self->{id}, $self->{status}, @count; -} - - =head2 string print $packet->header->string; @@ -121,11 +75,15 @@ my $ns = $self->nscount; my $ar = $self->arcount; + my $opt = $self->edns; + my $edns = ( $opt->isa(qw(Net::DNS::RR::OPT)) && not $opt->default ) ? $opt->string : ''; + my $retval; return $retval = <<EOF if $opcode eq 'UPDATE'; ;; id = $id ;; qr = $qr opcode = $opcode rcode = $rcode ;; zocount = $qd prcount = $an upcount = $ns adcount = $ar +$edns EOF my $aa = $self->aa; @@ -137,9 +95,6 @@ my $cd = $self->cd; my $do = $self->do; - my $opt = $self->edns; - my $edns = ( $opt->isa(qw(Net::DNS::RR::OPT)) && not $opt->default ) ? $opt->string : ''; - return $retval = <<EOF; ;; id = $id ;; qr = $qr aa = $aa tc = $tc rd = $rd opcode = $opcode @@ -166,8 +121,9 @@ sub id { my $self = shift; - return $self->{id} unless @_; - return $self->{id} = shift || int rand(0xffff); + my $xpkt = $self->{xbody}; + $xpkt->{id} = shift if scalar @_; + $xpkt->{id} ||= int rand(0xffff); } @@ -182,8 +138,9 @@ sub opcode { my $self = shift; - for ( $self->{status} ) { - return opcodebyval( ( $_ >> 11 ) & 0x0f ) unless @_; + my $xpkt = $self->{xbody}; + for ( $xpkt->{status} ||= 0 ) { + return opcodebyval( ( $_ >> 11 ) & 0x0f ) unless scalar @_; my $opcode = opcodebyname(shift); $_ = ( $_ & 0x87ff ) | ( $opcode << 11 ); return $opcode; @@ -202,7 +159,8 @@ sub rcode { my $self = shift; - for ( $self->{status} ) { + my $xpkt = $self->{xbody}; + for ( $xpkt->{status} ||= 0 ) { my $arg = shift; my $opt = $self->edns; unless ( defined $arg ) { @@ -335,7 +293,7 @@ print "# of question records: ", $packet->header->qdcount, "\n"; -Gets the number of records in the question section of the packet. +Returns the number of records in the question section of the packet. In dynamic update packets, this field is known as C<zocount> and refers to the number of RRs in the zone section. @@ -346,7 +304,7 @@ sub qdcount { my $self = shift; my $xpkt = $self->{xbody}; - return $self->{count}[0] || scalar @{$xpkt->{question}} unless @_; + return $xpkt->{count}[0] || scalar @{$xpkt->{question}} unless scalar @_; carp 'header->qdcount attribute is read-only' unless $warned; } @@ -366,7 +324,7 @@ sub ancount { my $self = shift; my $xpkt = $self->{xbody}; - return $self->{count}[1] || scalar @{$xpkt->{answer}} unless @_; + return $xpkt->{count}[1] || scalar @{$xpkt->{answer}} unless scalar @_; carp 'header->ancount attribute is read-only' unless $warned; } @@ -386,7 +344,7 @@ sub nscount { my $self = shift; my $xpkt = $self->{xbody}; - return $self->{count}[2] || scalar @{$xpkt->{authority}} unless @_; + return $xpkt->{count}[2] || scalar @{$xpkt->{authority}} unless scalar @_; carp 'header->nscount attribute is read-only' unless $warned; } @@ -405,7 +363,7 @@ sub arcount { my $self = shift; my $xpkt = $self->{xbody}; - return $self->{count}[3] || scalar @{$xpkt->{additional}} unless @_; + return $xpkt->{count}[3] || scalar @{$xpkt->{additional}} unless scalar @_; carp 'header->arcount attribute is read-only' unless $warned; } @@ -469,11 +427,11 @@ =cut sub edns { - my $self = shift; - my $xpkt = $self->{xbody}; - my $xtender = \$self->{xtender}; - ($$xtender) = grep { $_->type eq 'OPT' } @{$xpkt->{additional}} unless $$xtender; - return $$xtender ||= new Net::DNS::RR('. OPT'); + my $self = shift; + my $xpkt = $self->{xbody}; + my $link = \$xpkt->{xedns}; + ($$link) = grep { $_->type eq 'OPT' } @{$xpkt->{additional}} unless $$link; + return $$link ||= new Net::DNS::RR('. OPT'); } @@ -481,31 +439,23 @@ use vars qw($AUTOLOAD); -sub AUTOLOAD { ## Default method +sub AUTOLOAD { ## Default method no strict; @_ = ("method $AUTOLOAD undefined"); goto &{'Carp::confess'}; } -sub DESTROY { } ## Avoid tickling AUTOLOAD (in cleanup) +sub DESTROY { } ## Avoid tickling AUTOLOAD (in cleanup) -sub dump { ## print internal data structure - use Data::Dumper; - $Data::Dumper::Sortkeys = sub { return [sort keys %{$_[0]}] }; - my $self = shift; - return Dumper($self) if defined wantarray; - print Dumper($self); -} - - sub _dnsflag { my $self = shift; my $flag = shift; - for ( $self->{status} ) { + my $xpkt = $self->{xbody}; + for ( $xpkt->{status} ||= 0 ) { my $set = $_ | $flag; my $not = $set - $flag; - $_ = (shift) ? $set : $not if @_; + $_ = (shift) ? $set : $not if scalar @_; return ( $_ & $flag ) ? 1 : 0; } } @@ -515,7 +465,7 @@ my $self = shift; my $flag = shift; my $edns = eval { $self->edns->flags } || 0; - return $flag & $edns ? 1 : 0 unless @_; + return $flag & $edns ? 1 : 0 unless scalar @_; my $set = $flag | $edns; my $not = $set - $flag; my $new = (shift) ? $set : $not;
Subject: Re: [rt.cpan.org #84601] Resolved: Memory Leak in query after version 0.68
Date: Tue, 30 Jul 2013 00:45:26 -0400
To: bug-Net-DNS [...] rt.cpan.org
From: Jared Mauch <jared [...] puck.nether.net>
Download (untitled) / with headers
text/plain 329b
Any plans to rev 0.73 to pick up this fix? On Jul 19, 2013, at 5:14 AM, NLnet Labs via RT <bug-Net-DNS@rt.cpan.org> wrote: Show quoted text
> <URL: https://rt.cpan.org/Ticket/Display.html?id=84601 > > > According to our records, your request has been resolved. If you have any > further questions or concerns, please respond to this message.


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.