Skip Menu |
 

This queue is for tickets about the IPC-Shareable CPAN distribution.

Report information
The Basics
Id: 120996
Status: new
Priority: 0/
Queue: IPC-Shareable

People
Owner: Nobody in particular
Requestors: CHOLT [...] cpan.org
Cc:
AdminCc:

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



Subject: Tied arrays and hashes can fail when not initialized and a stability modification
From: CHOLT [...] cpan.org
Download (untitled) / with headers
text/plain 2.1k
If you tie a hash or array, but never insert anything into either before accessing them, you can get a failure on accessing them because the internal {_data} value has not been predeclared to be an empty hash or array. Also If you perform thaw operations in an eval statement, you can safely read values without locking the variable each time. You then only need to lock on write. Here is some patch text --> --- Shareable.pm.1 2012-10-12 19:35:32.000000000 -0600 +++ Shareable.pm 2017-04-06 10:26:24.000000000 -0600 @@ -315,7 +315,8 @@ my $key = shift; $self->{_data} = _thaw($self->{_shm}) unless $self->{_lock}; - return exists $self->{_data}->{$key}; + return (ref($self->{_data}) eq 'ARRAY') ? + exists($self->{_data}->[$key]) : exists($self->{_data}->{$key}); } sub FIRSTKEY { @@ -543,7 +544,23 @@ my $tag = substr $ice, 0, 14, ''; if ($tag eq 'IPC::Shareable') { - my $water = thaw $ice; + my $water; + eval '$water = thaw $ice;'; + + #thaw failed for some reason + if($@){ + if($@ =~ /corrupt|binary/i){ #perhaps storable string is partial + my $time = time(); + while(abs(time() - $time) < 5){ + sleep 1; + $ice = $s->shmread; + eval '$water = thaw $ice;'; + last if(!$@); + } + } + die $@ if($@); + } + defined($water) or do { require Carp; Carp::croak "Munged shared memory segment (size exceeded?)"; @@ -592,7 +609,16 @@ _type => $type, _was_changed => 0, }; - $sh->{_data} = _thaw($s), + $sh->{_data} = _thaw($s); + + #fix for uninitialized shared memory and complex datatypes + if($type ne 'SCALAR' && !defined($sh->{_data})){ + $sh->{_data} = ($type eq 'ARRAY') ? [] : {}; + defined _freeze($sh->{_shm} => $sh->{_data}) or do { + require Carp; + Carp::croak "Could not write to shared memory: $!\n"; + }; + } my $there = $sem->getval(SEM_MARKER); if ($there == SHM_EXISTS) {


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.