Как заставить perl заблокировать файл в неблокирующем режиме в NFS

#linux #perl #nfs

Вопрос:

fcntl в perl может блокировать в NFS, режим по умолчанию — режим блокировки. Как сделать его неблокирующим режимом? Я попробовал следующий код, но он не работает

 sub lock_file {
    my ($lock_file, $block) = @_;
    return unless defined $lock_file;
    my $LOCKFH;
    if (file_exist($lock_file)) {
        sysopen($LOCKFH, "$lock_file", O_RDWR) || return undef;
    } else {
        sysopen($LOCKFH, "$lock_file", O_RDWR|O_CREAT|O_EXCL) || return undef;
    }
    my $lock_ret = 0;
    my $pack;
    if ($block) {
        my $flags;
        fcntl($LOCKFH, F_GETFL, $flags);
        $flags amp;= !O_NONBLOCK;
        my $fail_block = fcntl($LOCKFH, F_SETFL, $flags);
        print "failed to set the lock to block mode.$!n" if !$fail_block;
    }
    $pack = pack('ssqql', F_WRLCK, SEEK_SET, 0, 0, 0);
    $lock_ret = fcntl($LOCKFH, F_SETLK, $pack);
    if (!$lock_ret) {
        close $LOCKFH;
        return undef;
    }
    return $LOCKFH;
}

1. Не if (file_exist($lock_file)) { sysopen($LOCKFH, "$lock_file", O_RDWR) || return undef; } else { sysopen($LOCKFH, "$lock_file", O_RDWR|O_CREAT|O_EXCL) || return undef; } ли это долгий и ненадежный способ записи sysopen($LOCKFH, "$lock_file", O_RDWR|O_CREAT) || return undef; ?

Ответ №1:

Попробуйте использовать flock с LOCK_NB, например

 use Fcntl qw(:DEFAULT :flock);
flock( $fh, LOCK_EX|LOCK_NB ) or die "failed to get lock";
... do code while having the lock ...
flock( $fh, LOCK_UN);

Кроме того, я помню из старых времен, что блокировка с помощью NFS всегда была немного особенной и не всегда делала то, что вы ожидали. Вот почему существовали специальные схемы блокировки с использованием вспомогательных файлов при совместном использовании почтовых ящиков через NFS. Я не уверен, что это все еще применимо к текущим реализациям NFS.