IPC::Shareable sometimes leaks memory segments

[stevieb]

Hi all,

So I've been working on a shared memory issue I'm trying to incorporate into one of my more complex distributions, and finally decided to ask for help. I've dumbed it down the best I can to replicate the problem in the minimum amount of code possible.

Code layout. A.pm contains the creation of the shared hash, I then expose the hash with our() in A.pm (and import it into B.pm). The calling script is main.pl:

main.pl <- B.pm <- A.pm

Here's a listing of how to run the code to produce the relevant outcomes:

# normal run, will finish after 7 iterations
# 'ipcs -a' shows everything was cleaned up properly

perl main.pl 2 2

# another normal run, but this time hit CTRL-C before the last iter
# `ipcs -a` shows SIGINT handler properly cleans up

perl main.pl 2 2 # hit CTRL-C

# send in 1 as the first param to have B.pm die() after 5 iters
# 'ipcs -a' shows everything cleaned up properly

perl main.pl 1 1

# PROBLEMATIC RUN
# send in three args which will die() main.pl
# 'ipcs -a' shows a leak of a memory segment

perl main.pl 2 2 2

Here's my cobbled together example code:

A.pm

use strict;
use warnings;

package A;

use base 'Exporter';
our @EXPORT = qw(%hash);

use IPC::Shareable;

$SIG{INT}     = sub { 
    print "package A has caught the INT signal\n";
    IPC::Shareable->clean_up_all; 
    exit; 
};
$SIG{__DIE__} = sub { 
    print "package A has caught the die() signal\n";
    IPC::Shareable->clean_up_all; 
    exit; 
};

our %hash;
my $tied;

BEGIN {
    $tied = tie %hash, 'IPC::Shareable', {
        key => 'test',
        create => 1
    };
}

END {
    IPC::Shareable->clean_up_all;
}

sub run {
    print "A: ";
    print "a: $hash{a}, a: $hash{b}\n";
}

1;

B.pm

use warnings;
use strict;

package B;

use lib '.';
use A;

our %hash;
my $count = 0;

sub run {
    my ($self, $x, $y) = @_;
    $hash{a} = $x;
    $hash{b} = $y;

    while (1){
        print "B: ";
        print "a: $hash{a}, b: $hash{b}\n";
        A->run;
        die "whoops!" if $count == 4 && $x == 1;
        last if $count == 6;
        $count++;
        sleep 1;
    }
}
1;

main.pl

use warnings;
use strict;

use lib '.';

use B;

print "\nneed 2 (or 3 if die()) args...\n" and exit if @ARGV < 2;

print "procID: $$\n";

if (defined $ARGV[2]){
    die "main script has died";
}

B->run(@ARGV);

Oddly, if I run the problematic line (perl main.pl 2 2 2) more than once, only the first segment remains in ipcs -a. I would think it'd stash another entry, as it's based on procID.

In my real project, I need to catch SIGINT, die() and a myriad of other things to ensure that the shared memory segments get cleaned up appropriately in some quite complex situations, but I think if I can get help sorting out why things aren't working here, I should be able to fix the real problem.

Can anyone help me sort out why IPC::Shareable isn't cleaning up properly? If more information is needed, please don't hesitate to say so.

Note:

• Check memory segments with ipcs -a or ipcs -ap
• Manually clear leaked segments with ipcrm -a

Another note: If I run the problematic run (perl main.pl 1 1), then run a full good run (perl main.pl 2 2), the previously leaked segment is cleaned up. This is what is very confusing to me.