shell bypass 403
package Test::SharedFork::Store;
use strict;
use warnings;
use Storable ();
use Fcntl ':seek', ':DEFAULT', ':flock';
use File::Temp ();
use IO::Handle;
sub new {
my $class = shift;
my %args = @_;
my $filename = File::Temp::tmpnam();
my $init = Storable::dclone($args{init} || +{});
my $self = bless {
callback_on_open => $args{cb},
filename => $filename,
lock => 0,
pid => $$,
ppid => $$,
}, $class;
$self->open();
# initialize
Storable::nstore_fd($init, $self->{fh}) or die "Cannot write initialize data to $filename";
return $self;
}
sub open {
my $self = shift;
if (my $cb = $self->{callback_on_open}) {
$cb->($self);
}
sysopen my $fh, $self->{filename}, O_RDWR|O_CREAT or die $!;
$fh->autoflush(1);
$self->{fh} = $fh;
}
sub close {
my $self = shift;
close $self->{fh};
undef $self->{fh};
}
sub get {
my ($self, $key) = @_;
$self->_reopen_if_needed;
seek $self->{fh}, 0, SEEK_SET or die $!;
Storable::fd_retrieve($self->{fh})->{$key};
}
sub set {
my ($self, $key, $val) = @_;
$self->_reopen_if_needed;
seek $self->{fh}, 0, SEEK_SET or die $!;
my $dat = Storable::fd_retrieve($self->{fh});
$dat->{$key} = $val;
truncate $self->{fh}, 0;
seek $self->{fh}, 0, SEEK_SET or die $!;
Storable::nstore_fd($dat => $self->{fh}) or die "Cannot store data to $self->{filename}";
}
sub get_lock {
my ($self, ) = @_;
Test::SharedFork::Store::Locker->new($self);
}
sub _reopen_if_needed {
my $self = shift;
if ($self->{pid} != $$) { # forked, and I'm just a child.
$self->{pid} = $$;
if ($self->{lock} > 0) { # unlock! I'm not owner!
flock $self->{fh}, LOCK_UN or die $!;
$self->{lock} = 0;
}
$self->close();
$self->open();
}
}
sub DESTROY {
my $self = shift;
if ($self->{ppid} eq $$) { # cleanup method only run on original process.
unlink $self->{filename};
}
}
package # hide from pause
Test::SharedFork::Store::Locker;
use Fcntl ':flock';
sub new {
my ($class, $store) = @_;
$store->_reopen_if_needed;
if ($store->{lock}++ == 0) {
flock $store->{fh}, LOCK_EX or die $!;
}
bless { store => $store }, $class;
}
sub DESTROY {
my ($self) = @_;
$self->{store}->{lock}--;
if ($self->{store}->{lock} == 0) {
flock $self->{store}->{fh}, LOCK_UN or die $!;
}
}
1;