| 1 |
root |
1.1 |
=head1 NAME |
| 2 |
|
|
|
| 3 |
|
|
AnyEvent::MCP::File - private state file locking and replacement |
| 4 |
|
|
|
| 5 |
|
|
=head1 FUNCTIONS |
| 6 |
|
|
|
| 7 |
|
|
=over |
| 8 |
|
|
|
| 9 |
|
|
=item $lock = AnyEvent::MCP::File::lock $file |
| 10 |
|
|
|
| 11 |
|
|
Create the parent directory and file if necessary, and lock the current file |
| 12 |
|
|
exclusively. The file must be private and owned by this user. Retries if an |
| 13 |
|
|
atomic replacement changed the pathname while waiting for the lock. |
| 14 |
|
|
Keep the returned handle alive through reading, modifying and replacing |
| 15 |
|
|
the file. All writers must use this locking protocol. |
| 16 |
|
|
|
| 17 |
|
|
=item AnyEvent::MCP::File::replace $file, $bytes |
| 18 |
|
|
|
| 19 |
|
|
Write bytes to a private temporary file beside C<$file>, then atomically |
| 20 |
|
|
rename it over C<$file>. The caller holds the lock. Removes the temporary |
| 21 |
|
|
file on failure. This provides atomic visibility, not crash durability. |
| 22 |
|
|
|
| 23 |
|
|
=back |
| 24 |
|
|
|
| 25 |
|
|
=cut |
| 26 |
|
|
|
| 27 |
|
|
package AnyEvent::MCP::File; |
| 28 |
|
|
|
| 29 |
|
|
use common::sense; |
| 30 |
|
|
use File::Path (); |
| 31 |
|
|
use File::Basename (); |
| 32 |
|
|
use Fcntl qw(O_RDWR O_WRONLY O_CREAT O_EXCL LOCK_EX); |
| 33 |
|
|
use Errno qw(ENOENT EEXIST); |
| 34 |
|
|
|
| 35 |
|
|
sub lock { |
| 36 |
|
|
my ($file) = @_; |
| 37 |
|
|
|
| 38 |
|
|
File::Path::mkpath (File::Basename::dirname ($file), 0, 0700); |
| 39 |
|
|
|
| 40 |
|
|
while (1) { |
| 41 |
|
|
my $fh; |
| 42 |
|
|
sysopen $fh, $file, O_RDWR | O_CREAT | O_EXCL, 0600 or do { |
| 43 |
|
|
die "$file: $!\n" unless $! == EEXIST; |
| 44 |
|
|
sysopen $fh, $file, O_RDWR or die "$file: $!\n"; |
| 45 |
|
|
}; |
| 46 |
|
|
|
| 47 |
|
|
my @stat = stat $fh; |
| 48 |
|
|
die "$file: file must be private and owned by this user\n" if $stat[4] != $< || $stat[2] & 077; |
| 49 |
|
|
|
| 50 |
|
|
flock $fh, LOCK_EX or die "$file: $!\n"; |
| 51 |
|
|
my @current = stat $file; |
| 52 |
|
|
|
| 53 |
|
|
return $fh if @current && $stat[0] == $current[0] && $stat[1] == $current[1]; |
| 54 |
|
|
|
| 55 |
|
|
die "$file: $!\n" unless @current || $! == ENOENT; |
| 56 |
|
|
|
| 57 |
|
|
close $fh; |
| 58 |
|
|
} |
| 59 |
|
|
} |
| 60 |
|
|
|
| 61 |
|
|
sub replace { |
| 62 |
|
|
my ($file, $bytes) = @_; |
| 63 |
|
|
|
| 64 |
|
|
my $temporary = "$file.$$~"; |
| 65 |
|
|
sysopen my $fh, $temporary, O_WRONLY | O_CREAT | O_EXCL, 0600 or die "$temporary: $!\n"; |
| 66 |
|
|
|
| 67 |
|
|
my $ok = eval { |
| 68 |
|
|
print {$fh} $bytes or die "$temporary: $!\n"; |
| 69 |
|
|
close $fh or die "$temporary: $!\n"; |
| 70 |
|
|
rename $temporary, $file or die "$file: $!\n"; |
| 71 |
|
|
1 |
| 72 |
|
|
}; |
| 73 |
|
|
|
| 74 |
|
|
my $error = $@; |
| 75 |
|
|
unlink $temporary unless $ok; |
| 76 |
|
|
die $error unless $ok; |
| 77 |
|
|
} |
| 78 |
|
|
|
| 79 |
|
|
1; |
