Bloehdian has asked for the wisdom of the Perl Monks concerning the following question:

Hello Monks,

this is the second time I encounter problems with IPC::Shareable and I have no clue, what the reason might be:

I do not present the complete code overhere (it's just too big), but only the relevant parts.

I have a prog which runs four parallel processes, a parent (parallel process (PP) #1) launching two childs, on of them being a tcp-listener (#2), the other one (#3) forks a process (#4) which runs a BGP Process (see Net::BGP::Process) which registers BGP peers (the latter fork() being necessary since the BGP Process will finally remain in an event loop and the loop in PP #3 must not be blocked).

PP #2 should have access to one of the Peers (an object in Perl lingo) in PP #4. Therefore I tried to use IPC::Shareable to share this object amongst both PPs.

Here are the code fragments relevant:

PP #2:

sub run_ssl {
   
   my $heartbeat;
   my $parent_msg;
   my $sub = 'run_ssl()';
   my $test;
   my $mesg;
   my $flags = '';
   my $sock;
   my $client_socket;
   my $sel;
   my $ext_mesg;
   my $peer_ref;
   my $answer;
   
   #$sock = IO::Socket::SSL->new(
   #   LocalAddr => $ssl_addr,
   #   LocalPort => $ssl_port,
   #   Listen => 5,
   #   Reuse => 1,
   #   Proto => 'tcp',
   #   SSL_cert_file => 'server.crt',
   #   SSL_key_file => 'server.key',
   #) || die "Can't bind TCP SSL port";
   
   $sock = new IO::Socket::INET (
    LocalHost => $ssl_addr,
    LocalPort => $ssl_port,
    Proto => 'tcp',
    Listen => 5,
    Reuse => 1,
   # Timeout => 1,
   );
   
   if ( defined $sock ) {
      
      dbg( "${sub}: (Re-)Started SSL Socket Process" );
      
   }
   else {
   
      dbg( "${sub}: IO::Socket::INET->new: $!" );
      
   }
   $sock->timeout( 1 );

   $sel = IO::Select->new( $sock );
   
   $flags = fcntl( $from_parent_ssl, F_GETFL, 0 )
      or die( "${sub}:  Could not get flags for \$from_parent_ssl: $!\
+n" );

   fcntl( $from_parent_ssl, F_SETFL, $flags | O_NONBLOCK )
      or die( "${sub}:  Could not set flags for \$from_parent_ssl: $!\
+n" );
   
   if ( ! defined ( $pid = fork() ) ) { die( "${sub}: $@\n" ) }
   
   return $pid if ( $pid );

   tie( $peer_ref, 'IPC::Shareable', 'glue', \%shareable_opts );

[download]

PP #4:

   sub launch_bgp_proc {
   
   # Runs Net::BGP::Process in a separate process
   #
   my $pid;
   my $sub = 'launch_bgp_proc()';
   my $peer;
   my $peer_ref;
   #my %peers;
   my $bgp;
   
   if ( ! defined ( $pid = fork() ) ) { die( "${sub}: $@\n" ) }
   
   return $pid if ( $pid );
   
   tie( $peer_ref , 'IPC::Shareable', 'glue', \%shareable_opts);
   
   $bgp = Net::BGP::Process->new();

   if ( defined $bgp ) {
      
      dbg( "${sub}: (Re-)Started BGP Process" );
      
   }
   else {
   
      dbg( "${sub}: Net::BGP::Process: $!" );
      
   }
   
   $peer = Net::BGP::Peer->new(
      Start       => 1,
      ... [REMOVED TO HIDE IP ADRESSES]
      ResetCallback     => \&bgp_callback_reset
   );

   $peer_ref = $peer;

[download]

When I run this I get the error message (as far as I could analyze this it is thrown when trying to assign $peer to $peer_ref):

 at /usr/lib/x86_64-linux-gnu/perl/5.22/Storable.pm line 341, at /usr/local/share/perl/5.22.1/IPC/Shareable.pm line 524.

The documentation says that it should be possible to share objects via shared memory by assigning the object (or better: a non-tied referénce) to a tied variable.

Lincoln Stein in his book mentions that it should be possible to store a reference object in a tied/shared hash, so I tried this (only showing code for PP #4 which is currently the trouble maker, made appropriate changes to PP 2):

sub launch_bgp_proc {
   
   # Runs Net::BGP::Process in a separate process
   #
   my $pid;
   my $sub = 'launch_bgp_proc()';
   my $peer;
   #my $peer_ref;
   my %peers;
   my $bgp;
   
   if ( ! defined ( $pid = fork() ) ) { die( "${sub}: $@\n" ) }
   
   return $pid if ( $pid );
   
   tie( %peers , 'IPC::Shareable', 'glue', \%shareable_opts);
   
   $bgp = Net::BGP::Process->new();

   if ( defined $bgp ) {
      
      dbg( "${sub}: (Re-)Started BGP Process" );
      
   }
   else {
   
      dbg( "${sub}: Net::BGP::Process: $!" );
      
   }
   
   $peer = Net::BGP::Peer->new(
      Start       => 1,
      ... [REMOVED TO HIDE IP ADRESSES]
      ResetCallback     => \&bgp_callback_reset
   );


   $peers{ 'peer' } = $peer;
   ...

[download]

On running this variant, I get the same mess, i.e. the same error message (Can't store CODE items)

Any idea what the problem is here? Any suggestions how to share an object between the two processes?

Cheers

Bloehdian

Replies are listed 'Best First'.
Re: IPC:Shareable: Sharing an object between parallel processes
by stevieb (Canon) on Oct 27, 2016 at 19:45 UTC

    I believe the problem here is the multiple calls to tie() within the same file. I, too, have been struggling to use IPC::Shareable with fork(), but I thought I'd revisit it since it came up here.

    This code, refactored from a very old version of the Perl Cookbook, does what you want (I believe). Notice that there's only one call to tie(). The only places I can find that there are multiple calls is when each process is created within a different file. I'm not entirely certain yet.

    Also note that I tested this with hashes, arrays and scalars along with the hash reference I've left in, and it also works with subroutines, which I left out. One last thing... the 'glue' appears to require undef when using it in this way. When I try a named glue, it fails (without the 'create' param set to true, which technically isn't needed unless an external process is using the var... again, at least from what I can tell.

    use warnings;
use strict;

use IPC::Shareable;

$SIG{INT} = sub { exit; };

my $href = {count => 0};

my $ipc = tie 
            $href, 
            'IPC::Shareable', 
            undef, 
            { destroy => 1 };

for (1 .. 3) { 
    unless (fork()){
        while (1){
            $ipc->shlock();
            $href->{count}++;
            $href->{pid} = $$;
            $ipc->shunlock();
        }
        exit;
    } 
}

while (1) {
    next if ! defined $href->{pid};
    print "pid: $href->{pid}, count: $href->{count}\n";
    sleep 1;
}

    [download]

    Output:

    pid: 19062, count: 1
pid: 19062, count: 1472
pid: 19063, count: 3070
pid: 19063, count: 4771
pid: 19062, count: 6548
pid: 19062, count: 8179
pid: 19062, count: 10070
pid: 19064, count: 11817
^C

    [download]
[reply]
[d/l]
[select]

      No, that does not work for me.

      I put a single tie in the parent process, tried different things (tying $peer directly, tie()ing a hash and a hash reference whereby the object reference was stored as hash value.

      To no avail.

[reply]

        Can you please post the full code? I'd love to take a crack at it. Perhaps here in <readmore></readmore> tags, or perhaps a github gist or something.

        ps. Former Internet network engineer here, so the BGP stuff grabbed my interest as much as the actual problem did.

[reply]
[d/l]

Back to Seekers of Perl Wisdom