AnyEvent/MCP/File.pm

=head1 NAME

AnyEvent::MCP::File - private state file locking and replacement

=head1 DESCRIPTION

Internal utility for small state files shared by MCP processes,
such as the workdir ID registry. C<lock> obtains a lock on the current
pathname; C<replace> writes a complete new version atomically. The caller
owns serialization, validation and the lock's lifetime.

For example, after building a new complete file body:

   use AnyEvent::MCP::File ();

   my $lock = AnyEvent::MCP::File::lock $path;
   # read and validate the current state under this lock
   AnyEvent::MCP::File::replace $path, $new_bytes;
   close $lock;

The lock protects cooperating writers, not other programs that write the
file without this protocol. Use L<AnyEvent::MCP::Workdirs> for the workdir
registry rather than implementing its update rules here.

=head1 FUNCTIONS

=over

=item $lock = AnyEvent::MCP::File::lock $file

Create the parent directory and file if necessary, and lock the current file
exclusively. Retries if an atomic replacement changed the pathname while waiting for the lock.
Keep the returned handle alive through reading, modifying and replacing
the file. All writers must use this locking protocol.

=item AnyEvent::MCP::File::replace $file, $bytes

Write bytes to a temporary file beside C<$file>, preserve the mode of an
existing file, then atomically rename over C<$file>. The caller holds the lock.
Removes the temporary file on failure. This provides atomic visibility,
not crash durability.

=back

=cut

package AnyEvent::MCP::File;

use common::sense;
use File::Path ();
use File::Basename ();
use Fcntl qw(O_RDWR O_WRONLY O_CREAT O_EXCL LOCK_EX);
use Errno qw(ENOENT EEXIST);

sub lock {
   my ($file) = @_;

   File::Path::mkpath (File::Basename::dirname ($file), 0, 0700);

   while (1) {
      my $fh;
      sysopen $fh, $file, O_RDWR | O_CREAT | O_EXCL, 0600 or do {
         die "$file: $!\n" unless $! == EEXIST;
         sysopen $fh, $file, O_RDWR or die "$file: $!\n";
      };

      my @stat = stat $fh;
      flock $fh, LOCK_EX or die "$file: $!\n";
      my @current = stat $file;

      return $fh if @current && $stat[0] == $current[0] && $stat[1] == $current[1];

      die "$file: $!\n" unless @current || $! == ENOENT;

      close $fh;
   }
}

sub replace {
   my ($file, $bytes) = @_;

   my @stat = stat $file;
   die "$file: $!\n" unless @stat || $! == ENOENT;

   my $temporary = "$file.$$~";
   sysopen my $fh, $temporary, O_WRONLY | O_CREAT | O_EXCL, 0600 or die "$temporary: $!\n";

   my $ok = eval {
      print {$fh} $bytes or die "$temporary: $!\n";
      if (@stat) {
         my $mode = $stat[2] & 07777;
         chmod $mode, $fh or die "$temporary: $!\n";
      }
      close $fh or die "$temporary: $!\n";
      rename $temporary, $file or die "$file: $!\n";
      1
   };

   my $error = $@;
   unlink $temporary unless $ok;
   die $error unless $ok;
}

1;
Revision:	1.3
Committed:	Thu Oct 22 06:31:41 2026 UTC (2 days, 3 hours ago) by root
Branch:	MAIN
CVS Tags:	rel-0_62, rel-0_61, rel-0_65, HEAD
Changes since 1.2:	+13 -8 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			AnyEvent::MCP::File - private state file locking and replacement
4
5	root	1.2	=head1 DESCRIPTION
6
7	root	1.3	Internal utility for small state files shared by MCP processes,
8	root	1.2	such as the workdir ID registry. C<lock> obtains a lock on the current
9			pathname; C<replace> writes a complete new version atomically. The caller
10			owns serialization, validation and the lock's lifetime.
11
12			For example, after building a new complete file body:
13
14			use AnyEvent::MCP::File ();
15
16			my $lock = AnyEvent::MCP::File::lock $path;
17			# read and validate the current state under this lock
18			AnyEvent::MCP::File::replace $path, $new_bytes;
19			close $lock;
20
21			The lock protects cooperating writers, not other programs that write the
22			file without this protocol. Use L<AnyEvent::MCP::Workdirs> for the workdir
23			registry rather than implementing its update rules here.
24
25	root	1.1	=head1 FUNCTIONS
26
27			=over
28
29			=item $lock = AnyEvent::MCP::File::lock $file
30
31			Create the parent directory and file if necessary, and lock the current file
32	root	1.3	exclusively. Retries if an atomic replacement changed the pathname while waiting for the lock.
33	root	1.1	Keep the returned handle alive through reading, modifying and replacing
34			the file. All writers must use this locking protocol.
35
36			=item AnyEvent::MCP::File::replace $file, $bytes
37
38	root	1.3	Write bytes to a temporary file beside C<$file>, preserve the mode of an
39			existing file, then atomically rename over C<$file>. The caller holds the lock.
40			Removes the temporary file on failure. This provides atomic visibility,
41			not crash durability.
42	root	1.1
43			=back
44
45			=cut
46
47			package AnyEvent::MCP::File;
48
49			use common::sense;
50			use File::Path ();
51			use File::Basename ();
52			use Fcntl qw(O_RDWR O_WRONLY O_CREAT O_EXCL LOCK_EX);
53			use Errno qw(ENOENT EEXIST);
54
55			sub lock {
56			my ($file) = @_;
57
58			File::Path::mkpath (File::Basename::dirname ($file), 0, 0700);
59
60			while (1) {
61			my $fh;
62			sysopen $fh, $file, O_RDWR \| O_CREAT \| O_EXCL, 0600 or do {
63			die "$file: $!\n" unless $! == EEXIST;
64			sysopen $fh, $file, O_RDWR or die "$file: $!\n";
65			};
66
67			my @stat = stat $fh;
68			flock $fh, LOCK_EX or die "$file: $!\n";
69			my @current = stat $file;
70
71			return $fh if @current && $stat[0] == $current[0] && $stat[1] == $current[1];
72
73			die "$file: $!\n" unless @current \|\| $! == ENOENT;
74
75			close $fh;
76			}
77			}
78
79			sub replace {
80			my ($file, $bytes) = @_;
81
82	root	1.3	my @stat = stat $file;
83			die "$file: $!\n" unless @stat \|\| $! == ENOENT;
84
85	root	1.1	my $temporary = "$file.$$~";
86			sysopen my $fh, $temporary, O_WRONLY \| O_CREAT \| O_EXCL, 0600 or die "$temporary: $!\n";
87
88			my $ok = eval {
89			print {$fh} $bytes or die "$temporary: $!\n";
90	root	1.3	if (@stat) {
91			my $mode = $stat[2] & 07777;
92			chmod $mode, $fh or die "$temporary: $!\n";
93			}
94	root	1.1	close $fh or die "$temporary: $!\n";
95			rename $temporary, $file or die "$file: $!\n";
96			1
97			};
98
99			my $error = $@;
100			unlink $temporary unless $ok;
101			die $error unless $ok;
102			}
103
104			1;