in reply to Re^5: Massive Perl Memory Leak
in thread Massive Perl Memory Leak

Sure. I ran this with about 1000 devices and the threaded one goes to 1.4GB. Nonthreaded stays rock steady about 32MB.

######routeleaker2.pl########

#!/usr/bin/perl require Net::SNMP; #use Data::Dump "pp"; $| = 1; $howmany = $ARGV[0] or die; $ipCidrRouteProto = "1.3.6.1.2.1.4.24.4.1.7"; $ipCidrRouteIfIndex = "1.3.6.1.2.1.4.24.4.1.5"; $ipCidrRouteType = "1.3.6.1.2.1.4.24.4.1.6"; $ipRouteMask = "1.3.6.1.2.1.4.21.1.11"; $ipRouteIfIndex = "1.3.6.1.2.1.4.21.1.2"; $ipRouteType = "1.3.6.1.2.1.4.21.1.8"; $ipRouteNextHop = "1.3.6.1.2.1.4.21.1.7"; $ipRouteProto = "1.3.6.1.2.1.4.21.1.9"; open IPFILE, "<allips.txt" or die; for $i (1 .. $howmany) { my ($host, $commstr) = split / /, <IPFILE>; chomp $commstr; print "$host, $commstr "; last unless $commstr; &poll($host, $commstr); if ($i % 5 == 0) { my $memusage = (`ps -p $$ -o vsz `)[1]; chomp $memusage; print " __${memusage}__"; } print "\n"; } print "\n"; sub poll { my ($devarg, $commstr) = @_ or die; my ($sessionO, $error) = Net::SNMP->session( -hostname => $devarg, -community => $commstr, -port => 161, -t +ranslate => 1, -version => SNMPv1, -timeout => 30, -retries => 2, -domain => "udp", -debug => +0x00 ); if (!defined($sessionO)) { print STDERR "Error making object($devarg $commstr): ", $error +, " \n"; print "Error making object($devarg $commstr): ", $error, " \n" +; die; } $sessionO->translate([-timeticks => 0]); my $session = \$sessionO; my $result6; $result6 = $$session->get_entries(-columns => [$ipCidrRouteIfIndex +, $ipCidrRouteProto, $ipCidrRouteType ]); $result6 = $$session->get_entries(-columns => [$ipRouteNextHop, $i +pRouteIfIndex, $ipRouteMask, $ipRouteProto, $ipRouteType]) unless %$r +esult6; if (!defined($result6)) { printf(" %s", $$session->error); } print "'", scalar %$result6, "' ", length join( "", %$result6); # print "\npre\n", pp($session), "\n", pp($sessionO), "\n"; $$session->close; # print "\npost\n", pp($session), "\n", pp($sessionO), "\n"; }
################routeleaker3.pl##############

#!/usr/bin/perl use threads ('stack_size' => 131072); use threads::shared; use Thread::Queue; use Thread::Semaphore; require Net::SNMP; #use Data::Dump "pp"; $| = 1; $howmany = $ARGV[0] or die; $ipCidrRouteProto = "1.3.6.1.2.1.4.24.4.1.7"; $ipCidrRouteIfIndex = "1.3.6.1.2.1.4.24.4.1.5"; $ipCidrRouteType = "1.3.6.1.2.1.4.24.4.1.6"; $ipRouteMask = "1.3.6.1.2.1.4.21.1.11"; $ipRouteIfIndex = "1.3.6.1.2.1.4.21.1.2"; $ipRouteType = "1.3.6.1.2.1.4.21.1.8"; $ipRouteNextHop = "1.3.6.1.2.1.4.21.1.7"; $ipRouteProto = "1.3.6.1.2.1.4.21.1.9"; open IPFILE, "<allips.txt" or die; @ips = <IPFILE>; close IPFILE; $howmany = $#ips if $howmany > $#ips; $queue = new Thread::Queue; $queue->enqueue(@ips[0 .. $howmany]); undef @ips; share($on); share($count); share($printlock); $semaphore = new Thread::Semaphore(0); $count = 0; for $i (0 .. 99) { $threads[$i] = threads->create("entrypoint"); } print "\n"; $semaphore->up(100); while ($on) { if ($slept % 60 == 0) { my $memusage = (`ps -p $$ -o vsz `)[1]; chomp $memusage; lock $count; lock $printlock; print "\ncount: $count, ${memusage} KB \n\n"; } sleep 1; $slept++; } print "\n"; foreach $i (@threads) { $i->join; } print "done\n"; exit; sub entrypoint { {lock $on; $on++;} { lock $printlock; print "+"; } local $mytid = threads->self->tid(); $semaphore->down; my $string; while ($string = $queue->dequeue_nb) { my ($host, $commstr) = split / /, $string; chomp $commstr; last unless $commstr; &poll($host, $commstr); { lock $count; $count++; } } {lock $on; $on--;} } sub poll { my ($devarg, $commstr) = @_ or die; my ($sessionO, $error) = Net::SNMP->session( -hostname => $devarg, -community => $commstr, -port => 161, -t +ranslate => 1, -version => SNMPv1, -timeout => 30, -retries => 2, -domain => "udp", -debug => +0x00 ); if (!defined($sessionO)) { print "Error making object($devarg $commstr): ", $error, " \n" +; die; } $sessionO->translate([-timeticks => 0]); my $session = \$sessionO; my $result6; $result6 = $$session->get_entries(-columns => [$ipCidrRouteIfIndex +, $ipCidrRouteProto, $ipCidrRouteType ]); $result6 = $$session->get_entries(-columns => [$ipRouteNextHop, $i +pRouteIfIndex, $ipRouteMask, $ipRouteProto, $ipRouteType]) unless %$r +esult6; if (!defined($result6)) { lock $printlock; print "t$mytid $devarg 'no routing table' ", "\n"; $$session->close; return; } { lock $printlock; print "t$mytid $devarg '", scalar %$result6, "' ", length join( "" +, %$result6), "\n"; } # print "\npre\n", pp($session), "\n", pp($sessionO), "\n"; $$session->close; # print "\npost\n", pp($session), "\n", pp($sessionO), "\n"; }

Replies are listed 'Best First'.
Re^7: Massive Perl Memory Leak
by BrowserUk (Patriarch) on Jun 16, 2007 at 13:50 UTC

    I don't see anything dramatically wrong with your threading code. There are some anomalies, like why you take a reference $session to the session object $session0, and then indirect through that instead of using the latter directly--but I'll put that down to artifacts of trimming your real code down for test purposes.

    I'm also personally uncomfortable with code that doesn't use strict, and relies on package globals for communications between subs, but it's your code. There are a few errors that would show up were you using strict and warnings. For example, you have

    my $result6; $result6 = $$session->get_entries(-columns => [ $ipCidrRouteIfIndex, $ipCidrRouteProto, $ipCidrRouteType ]); $result6 = $$session->get_entries(-columns => [ $ipRouteNextHop, $ipRouteIfIndex, $ipRouteMask, $ipRouteProto, $ip +RouteType ]) unless %$result6;

    If the first call fails and returns undef, then %$result6; would produce a warning Use of uninitialized value in hash dereference ... if they were enabled. Better to use just unless $result6 or as you have on the next line unless defined $result6;, but it probably doesn't affect the result.

    More important is what goes on under the covers of Net::SNMP--though take anything I say with a handful of salt as I have no devices to run it against and it's a huge amount of complicated code to run in your head.

    The main comment I have is that it is never intended for use with threads. A large part of what makes it so complex, is that it has it's own built in select-based, event driven, multiprocessing model.

    Ostensibly, you only need to add -nonblocking   => 1, to the constructor, and -callback => \&somesub, to the get_entries() calls, and you can overlap all your requests without using threads.

    Of course, with your program being 100,000 lines, it indicates that you are doing some pretty complex and probably time consuming processing of the data you are getting back. If you just stuck all that into the callback, the timeliness of the event-driven model will go right out the window and the performance will suck. And trying to break your code up into small chunks to maintain the responsiveness of the event loop, without your being able to register your own code with their internal event queues, means that you would effectively have to build a second event-loop model on top, within your code.

    The problem of the memory growth arises because they are using several 'singleton' instances internally.

    • There's one, $DISPATCHER in SNMP.pm.
    • Another, $MESSAGE_PROCESSING; inside Dispatcher.pm.
    • There's $INSTANCE and a global hash $MSG_HANDLES to hold all it's messages, in MessageProcessing.pm.

    And there are no less that 12 packages in the suite, and many of these load others--often large--packages, Math::BigInt, Digest::MD5 etc. And all of these, and all of the global data represented by the singleton objects and global tables above are being loaded and duplicated into every one of your 100 threads.

    In essence, you are building a program that contains 100 event-loops, and then running each as a 1-shot event.

    I also suspect, but cannot confirm from a dry run analysis, that the memory growth occurs because global data-structures get built and then replicated across 100 threads, but that the clean-up of the memory associated with any single request will only happen in the thread that processes it. Ie. Each request causes 100 copies of the data structures required to service it, but only one of those copies gets cleaned up upon completion, leaving 99 dead copies of everything from your 1000 requests kicking around doing nothing but taking up space.

    It would certainly explain the growth.

    The upshot.

    You either need to forget using threads, use the built-in non-blocking multi-processing model, with all the inherent difficulties of trying to break your extensive post-processing into bite-size chunks to maintain the responsiveness of the internal event loop. Which probably means building a second event-loop mechanism in your own code.

    Or, entreat on the authors to move away from using singletons, global data structures and the (redundant) event loop comms model, when running in blocking mode.

    Neither is a particularly enticing decision.

    Update: There is another alternative. Run the Net::SNMP event loop in non-blocking mode in the base thread. Have the callbacks simply queue the returned data and return. Start a number of threads reading from the queue of response data to do the time consuming processing. It would be important to ensure that your processing threads were started before you loaded Net:SNMP and all it's dependancies in the main thread, to avoid all the code being replicated into the worker threads. Ie. require not use.

    This represents a fairly major restructuring of your existing code, but far less than either of the alternatives above.


    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.
      Fascinating. But what I don't get is why any of the singleton objects would survive (to do bad things) thread creation, since each thread is supposed to have its own compartmentalized copy of the interpretor. No thread is supposed to "know" anything about any of the data in the other threads or be able to do anything to another thread without an explicit share(). The singleton's should as well be cloned and not be able to touch each other. That's the definition of the threading model.

      I was saying that the script is 100 KB, not 100 K-lines. :P And ur right about the trim down artifacts. $session is a ref to the object as created in another namespace. I moved that into main for the test script. %$result6 is another experiment. The original code is || seperated.

        The singleton's should as well be cloned and not be able to touch each other.

        I said I suspect but cannot prove. Without 1000 SNMP devices (or even one I could call 1000 times) all I can do is speculate. I agree it shouldn't happen, but are there any occasions or circumstances where a variable becomes shared without explicit sharing?

        Well, take the example of any parameters you pass to your thread code on the threads->create(), you don't need to share those. But that's a special case. How about your leaker3.pl above. You create your queue in the main thread and never share it:

        my $queue = new Thread::Queue; $queue->enqueue( @ips[ 0 .. $howmany ] );

        but there you are using it inside the thread subroutine:

        while( my $string = $queue->dequeue_nb ) {

        If that was shared without explicit instruction, what else was?

        Do me a favour and try this. All the non-blocking SNMP code is derived purely from the docs, which I may have misundertood. It compiles clean but is otherwise untested so it may require a few tweaks. It is basically the third option I mentioned above that use threads to rescue the calling code from the binds of the underlying event-driven state machine.

        #! perl -slw use strict; use threads; use Thread::Queue; use Storable qw[ freeze thaw ]; use constant { ipCidrRouteProto => "1.3.6.1.2.1.4.24.4.1.7", ipCidrRouteIfIndex => "1.3.6.1.2.1.4.24.4.1.5", ipCidrRouteType => "1.3.6.1.2.1.4.24.4.1.6", ipRouteMask => "1.3.6.1.2.1.4.21.1.11", ipRouteIfIndex => "1.3.6.1.2.1.4.21.1.2", ipRouteType => "1.3.6.1.2.1.4.21.1.8", ipRouteNextHop => "1.3.6.1.2.1.4.21.1.7", ipRouteProto => "1.3.6.1.2.1.4.21.1.9", }; sub warnf{ warn sprintf $_[0], @_ } my $THREADS = $ARGV[ 0 ] || 100; my $Q = new Thread::Queue; ## The main processing goes here sub processResults{ my( $host, $commstr, $result ) = @_; ## do your heavy stuff here } ## simple worker thread sub worker { while( my $result = $Q->dequeue ) { my $result = thaw $result; my $host = delete $result->{ _my_private_host_key }; my $commstr = delete $result->{ _my_private_commstr_key }; processResult( $host, $commstr, $result ); } } ## Callback sub enqueue { ## First arg is the seesion handle--the rest whatever we asked for my( $session, $host, $commstr ) = @_; my $result = $session->var_bind_list(); ## Get the results + hash $result->{ _my_private_host_key } = $host; ## Tack on some ex +tras $result->{ _my_private_commstr_key } = $commstr; $Q->enqueue( freeze $result ); ## And serialise it for qu +euing $session->close; } my @workers = map{ threads->create( \&worker ); } 1 .. $THREADS; ## Avoid loading the heavy stuff until after we've spawned out threads +; require Net::SNMP; open my $ipsFH, '<', 'allips.txt' or die $!; while( my( $host, $commstr ) = split ' ', <$ipsFH> ) { my( $session, $error ) = Net::SNMP->session( -hostname => $host, -community => $commstr, -port => 161, -version => 'SNMPv1', -translate => 1, -debug => 0x00, -nonblocking => 1, -timeout => 30, -retries => 3, ); unless( defined $session ) { warn "Couldn't create session for $host/$commstr: reason: $err +or\n"; next; } my $success = $session->get_entries( -columns => [ ipCidrRouteIfIndex, ipCidrRouteProto, ipCidrRouteType ], ## Have host and commstr passed back to the callback -callback => [ \&enqueue, $host, $commstr ], ) and next; $success = $session->get_entries( -columns => [ ipRouteNextHop, ipRouteIfIndex, ipRouteMask, ipRouteProto, ipRouteType ] ## Have host and commstr passed back to the callback -callback => [ \&enqueue, $host, $commstr ], ) or warnf "Failed to get_entries for $host/$commstr: reason %s\n" +, $session->error(); } close $ipsFH; ## Run the event loop Net::SNMP->snmp_dispatcher(); ## Wait for the work to be done sleep 1 while $Q->pending; ## signal workers to die $Q->enqueue( ( undef ) x $THREADS ); ## And bury them $_->join for @workers;

        Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
        "Science is about questioning the status quo. Questioning authority".
        In the absence of evidence, opinion is indistinguishable from prejudice.