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

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 ] );

[download]

but there you are using it inside the thread subroutine: 

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

[download]

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;

[download]
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.
"Too many [] have been sedated by an oppressive environment of political correctness and risk aversion."

Replies are listed 'Best First'.
Re^10: Massive Perl Memory Leak
by wagnerc (Sexton) on Jun 19, 2007 at 00:48 UTC
    I started ur script. I'm not sure what it'll show but it's running and I'm monitoring it. :) I added a printlock and made the processResults() just print a status message. There is one problem with ur code, the second SNMP call will never be made. Nonblocking calls always return true. That would be a big problem in production code since we don't know which one we need ahead of time. I would have to spin the dispatcher, see if the oids were defined, and then spin it again possibly. The other major problem with the spin dispatcher method is that I don't know what IP's to poll ahead of time. That's one of the reasons I did it as stand alone threads with blocking SNMP. I wouldn't be able to queue up tons of SNMP calls and then spin the dispatcher and wait for the data. I'ld have to queue up small bits of calls and spin the thing over and over again. So it doesn't really buy me anything. :)

    Ok the script completed. It only used about 300 MB of memory. As I expected the non CIDR devices returned nothing. :) I'ld be interested to see how the nonblocking calls behave within worker threads.. Hmm.

    Another thing I tried. In my leaker3 I moved the require Net::SNMP down into the entrypoint as eval "require Net::SNMP"; figuring that way there would be *no* objects to clone since the entire module wasn't instantiated yet. Doing that used up even more memory than require'ing it at the top of the script. :P

[reply]
      Just for the sake of the search engines and future Perl monks, I'll post the resolution to this. The problem is that Perl cannot free() memory. So as threads polled devices with large result sets, each one's memory footprint would get larger and larger. Once enough threads had their memory allocation ballooned to silly levels, the whole process would exceed the maximum process size. The solution is to keep closing and respawning threads to allow free() to happen or move the polling heavy lifting into a subprocess so that memory could be freed when the subprocess terminates.
[reply]

      Duh! I'm being dense. Simply defer the non-CIDR attempt until the CIDR attempt fails. Right there in the callback for the first attempt we have all the information available to make the re-attempts. How does this go? 

      #! 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 session handle--the rest whatever we asked for
    my( $session, $host, $commstr, try ) = @_;
    my $result = $session->var_bind_list();         ## Get the results
+ hash

#    unless( $result or $try ) ## Some people find that hard to unders
+tand.    
    if( not $result and not $try ) {
        $session->get_entries(
            -columns => [
                ipRouteNextHop,
                ipRouteIfIndex,
                ipRouteMask,
                ipRouteProto,
                ipRouteType
            ]
            ## Have host and commstr passed back to the callback
            ## Indicate this is our second attempt
            -callback => [ \&enqueue, $host, $commstr, 1 ],
        );
    }
    else {
        warnf "Failed to get_entries for $host/$commstr: reason %s\n",
            $session->error();
        $session->close;
        return;
    }
    $result->{ _my_private_host_key } = $host;      ## Tack on some ex
+tras
    $result->{ _my_private_commstr_key } = $commstr;
    $Q->enqueue( freeze $result );                  ## And serialise i
+t for queuing
    $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;
    }
    $session->get_entries(
        -columns => [
            ipCidrRouteIfIndex,
            ipCidrRouteProto,
            ipCidrRouteType
        ],
        ## Have host and commstr passed back to the callback
        ## first try CIDR (whatever that is?)
        -callback => [ \&enqueue, $host, $commstr, 0 ],
    );
}
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;

      [download]
      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.
[reply]
[d/l]

      Darn. Didn't think of that. Looks like you're back to one of the other two options ;(

      Or, you could try NSNMP::Simple with your threaded/synchronous requests approach. A quick look at the source shows it be be pure perl and doesn't use any globals. There are a couple of lexical globals used via closure, but they should be relatively safe. The author says it's not ready for prime time, but maybe it will just work for you. Worth a shot.

      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.
[reply]

In Section Seekers of Perl Wisdom