Release of flock in case of errors?

随声附和 提交于 2019-11-29 13:33:56

In that case, is the lock ever released by the operating system?
Does it see "hey, the script that acquired the lock crashed" and release the lock?
Does it release the lock immediately?

All of these questions are system dependent. Perl 5 does not implement a file locking function, it just provides a common interface to flock(2), fcntl(2) locking, or lockf(3) (depending on what is available in the OS). There may also be a difference between what happens when a program exits, segfaults, or is killed with a sigkill.

A quick test under Linux shows that a lock is removed under normal exit conditions:

$ perl -le 'open my $fh, ">", "f" or die $!; print flock($fh, 6) ? "got lock" : "was already locked", "\n"'
got lock
$ perl -le 'open my $fh, ">", "f" or die $!; print flock($fh, 6) ? "got lock" : "was already locked", "\n"'
got lock

Let's see what happens when we die:

$ perl -le 'open my $fh, ">", "f" or die $!; print flock($fh, 6) ? "got lock" : "was already locked", "\n"; die "died"'
got lock
died at -e line 1.
$ perl -le 'open my $fh, ">", "f" or die $!; print flock($fh, 6) ? "got lock" : "was already locked", "\n"; die "died"'
got lock
died at -e line 1.

To get a segfault, we will need access to C, I am using Inline to get it:

$ cat segfault.pl
#!/usr/bin/perl

use strict;
use warnings;

use Inline "C";

open my $fh, ">", "f" or die $!;

print flock($fh, 6) ? "got lock" : "was already locked", "\n";

crash();

__DATA__
__C__

void crash() {
    int* ptr = NULL;
    *ptr = 5;
}
$ perl segfault.pl
got lock
Segmentation fault
$ perl segfault.pl
got lock
Segmentation fault

And finally, here is what happens when a program is sent SIGKILL:

$ cat fork.pl
#!/usr/bin/perl

use strict;
use warnings;

$SIG{CHLD} = "IGNORE"; #auto-reap children

die "could not fork: $!" unless defined(my $pid = fork);
unless ($pid) {
    #child
    open my $fh, ">", "f" or die $!;
    print flock($fh, 6) ? "got lock" : "was already locked", "\n";
    sleep(100);
    exit;
}

kill 9, $pid;

die "could not fork: $!" unless defined($pid = fork);
unless ($pid) {
    #child
    open my $fh, ">", "f" or die $!;
    print flock($fh, 6) ? "got lock" : "was already locked", "\n";
    exit;
}
$ perl fork.pl
got lock
got lock

From these experiments, we can see that the lock is released in Linux for each of the cases you were concerned with.

Also, is there one perl instance running for each script, so that it's clear which script crashed/stopped without releasing the lock?

Yes, Perl 5 has one perl process per script. Even if you fork, the child gets its own perl process. Threading does not provide a separate perl process.

Note: if a parent process gets a lock and does not give it up before locking, then the child will have the same lock even if the parent exits.

When the program exits, the OS automatically releases all locks acquired by the program and closes all files opened by the program.

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!