AnyEvent/MCP/Workdirs.pm

=head1 NAME

AnyEvent::MCP::Workdirs - persistent filesystem workdir IDs

=head1 DESCRIPTION

The registry assigns small positive integers to pathname strings.
C<mcp-fs> supplies logical absolute pathnames without following symlinks;
relative local workdir arguments are made absolute lexically. The same
logical pathname on two hosts gets the same ID even if its symlink resolves
to a different physical directory. IDs compress pathnames, not host
identities or permissions. The registry is shared by instances using the same file.
Permission-rule identities remain independent of these selectors.

It is used by C<mcp-fs> so assistants can refer to a workdir by a short,
stable-while-retained number instead of repeating its pathname. It is
not a filesystem authorization mechanism: the selected workdir and the
permission engine still determine what an operation may access.
Applications that do not expose workdirs do not need this module.

   use AnyEvent::MCP::Workdirs;

   my $registry = AnyEvent::MCP::Workdirs->new (
      file => $registry_file, paths => [$resolved_project_path],
   );
   my $id = $registry->{ids}[0];
   $registry->refresh; # repeat periodically while the server runs

See L<mcp-fs/SANDBOX GRANTS> for how the server interprets these IDs,
and L<AnyEvent::MCP::File> for the locked state-file operations.

=head1 METHODS

=over

=item $registry = AnyEvent::MCP::Workdirs->new (file => $file, paths => [$path...], expiry => $seconds)

Resolve IDs for the supplied pathnames, reserving new allocations under
the file lock. C<expiry> defaults to seven days. C<ids> contains the assigned
IDs in path order and stays fixed for this object's lifetime. The caller
refreshes immediately and periodically while its server is running.

=item $registry->refresh

Lock and reread the JSON registry, overwrite this server's assigned IDs with
their paths and the current C<last_use>, expire old entries after C<expiry>
seconds, and atomically replace the file. This never resolves or reallocates
the server's IDs. Startup allocations reuse the smallest available positive
IDs; configured paths retain their previous IDs if nobody reused them.

Entries are C<ID =E<gt> [workdir, last_use]>. The JSON uses UTF-8 with pretty printing.
Manual changes require restarting filesystem servers using the registry.

=back

=cut

package AnyEvent::MCP::Workdirs;

use common::sense;
use AnyEvent::MCP ();
use AnyEvent::MCP::File ();
use JSON::XS ();

our @ISA = qw(AnyEvent::MCP::Base);

my $json = JSON::XS->new->utf8->canonical->pretty;

sub _read {
   my ($self, $lock) = @_;

   local $/;
   my $text = <$lock>;
   my $entries = length $text ? $json->decode ($text) : {};
   ref $entries eq "HASH" or die "$self->{file}: expected workdir ID object\n";

   for my $id (keys %$entries) {
      my $entry = $entries->{$id};
      $id =~ /\A[1-9][0-9]*\z/ && ref $entry eq "ARRAY" && @$entry == 2
         && defined $entry->[0] && !ref $entry->[0] && length $entry->[0] && $entry->[0] !~ /\0/
         && defined $entry->[1] && !ref $entry->[1] && $entry->[1] =~ /\A[0-9]+\z/
         or die "$self->{file}: invalid workdir entry '$id'\n";
   }

   $entries
}

sub new {
   my ($class, %kv) = @_;

   my $self = $class->SUPER::new (expiry => 7 * 86400, %kv);
   my $lock = AnyEvent::MCP::File::lock $self->{file};
   my $entries = $self->_read ($lock);
   my $now = time;
   my %active = map { $_ => 1 } @{$self->{paths}};

   for my $id (keys %$entries) {
      delete $entries->{$id}
         unless $active{$entries->{$id}[0]} || $entries->{$id}[1] > $now - $self->{expiry};
   }

   my %id = map { $entries->{$_}[0] => $_ } keys %$entries;
   my @ids;
   my $next = 1;

   for my $path (@{$self->{paths}}) {
      unless (exists $id{$path}) {
         ++$next while exists $entries->{$next};
         $id{$path} = $next++;
         $entries->{$id{$path}} = [$path, $now];
      }

      push @ids, 0 + $id{$path};
   }

   # reserve allocations before another server can choose the same IDs.
   AnyEvent::MCP::File::replace $self->{file}, $json->encode ($entries);
   $self->{ids} = \@ids;

   $self
}

sub refresh {
   my ($self) = @_;

   my $lock = AnyEvent::MCP::File::lock $self->{file};
   my $entries = $self->_read ($lock);
   my $now = time;

   for (0 .. $#{$self->{paths}}) {
      $entries->{$self->{ids}[$_]} = [$self->{paths}[$_], $now];
   }

   for my $id (keys %$entries) {
      delete $entries->{$id} if $entries->{$id}[1] <= $now - $self->{expiry};
   }

   AnyEvent::MCP::File::replace $self->{file}, $json->encode ($entries);
}

1;
Revision:	1.4
Committed:	Thu Nov 5 03:52:35 2026 UTC (45 hours, 6 minutes ago) by root
Branch:	MAIN
CVS Tags:	rel-0_81, rel-0_82, HEAD
Changes since 1.3:	+7 -5 lines
Log Message:	0.81
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			AnyEvent::MCP::Workdirs - persistent filesystem workdir IDs
4
5			=head1 DESCRIPTION
6
7	root	1.4	The registry assigns small positive integers to pathname strings.
8			C<mcp-fs> supplies logical absolute pathnames without following symlinks;
9			relative local workdir arguments are made absolute lexically. The same
10			logical pathname on two hosts gets the same ID even if its symlink resolves
11			to a different physical directory. IDs compress pathnames, not host
12			identities or permissions. The registry is shared by instances using the same file.
13	root	1.1	Permission-rule identities remain independent of these selectors.
14
15	root	1.2	It is used by C<mcp-fs> so assistants can refer to a workdir by a short,
16			stable-while-retained number instead of repeating its pathname. It is
17			not a filesystem authorization mechanism: the selected workdir and the
18			permission engine still determine what an operation may access.
19			Applications that do not expose workdirs do not need this module.
20
21			use AnyEvent::MCP::Workdirs;
22
23			my $registry = AnyEvent::MCP::Workdirs->new (
24			file => $registry_file, paths => [$resolved_project_path],
25			);
26			my $id = $registry->{ids}[0];
27			$registry->refresh; # repeat periodically while the server runs
28
29			See L<mcp-fs/SANDBOX GRANTS> for how the server interprets these IDs,
30			and L<AnyEvent::MCP::File> for the locked state-file operations.
31
32	root	1.1	=head1 METHODS
33
34			=over
35
36			=item $registry = AnyEvent::MCP::Workdirs->new (file => $file, paths => [$path...], expiry => $seconds)
37
38	root	1.4	Resolve IDs for the supplied pathnames, reserving new allocations under
39	root	1.1	the file lock. C<expiry> defaults to seven days. C<ids> contains the assigned
40			IDs in path order and stays fixed for this object's lifetime. The caller
41			refreshes immediately and periodically while its server is running.
42
43			=item $registry->refresh
44
45			Lock and reread the JSON registry, overwrite this server's assigned IDs with
46			their paths and the current C<last_use>, expire old entries after C<expiry>
47			seconds, and atomically replace the file. This never resolves or reallocates
48			the server's IDs. Startup allocations reuse the smallest available positive
49			IDs; configured paths retain their previous IDs if nobody reused them.
50
51			Entries are C<ID =E<gt> [workdir, last_use]>. The JSON uses UTF-8 with pretty printing.
52			Manual changes require restarting filesystem servers using the registry.
53
54			=back
55
56			=cut
57
58			package AnyEvent::MCP::Workdirs;
59
60			use common::sense;
61			use AnyEvent::MCP ();
62			use AnyEvent::MCP::File ();
63			use JSON::XS ();
64
65			our @ISA = qw(AnyEvent::MCP::Base);
66
67			my $json = JSON::XS->new->utf8->canonical->pretty;
68
69			sub _read {
70			my ($self, $lock) = @_;
71
72			local $/;
73			my $text = <$lock>;
74			my $entries = length $text ? $json->decode ($text) : {};
75			ref $entries eq "HASH" or die "$self->{file}: expected workdir ID object\n";
76
77			for my $id (keys %$entries) {
78			my $entry = $entries->{$id};
79			$id =~ /\A[1-9][0-9]*\z/ && ref $entry eq "ARRAY" && @$entry == 2
80	root	1.3	&& defined $entry->[0] && !ref $entry->[0] && length $entry->[0] && $entry->[0] !~ /\0/
81	root	1.1	&& defined $entry->[1] && !ref $entry->[1] && $entry->[1] =~ /\A[0-9]+\z/
82			or die "$self->{file}: invalid workdir entry '$id'\n";
83			}
84
85			$entries
86			}
87
88			sub new {
89			my ($class, %kv) = @_;
90
91			my $self = $class->SUPER::new (expiry => 7 * 86400, %kv);
92			my $lock = AnyEvent::MCP::File::lock $self->{file};
93			my $entries = $self->_read ($lock);
94			my $now = time;
95			my %active = map { $_ => 1 } @{$self->{paths}};
96
97			for my $id (keys %$entries) {
98			delete $entries->{$id}
99			unless $active{$entries->{$id}[0]} \|\| $entries->{$id}[1] > $now - $self->{expiry};
100			}
101
102			my %id = map { $entries->{$_}[0] => $_ } keys %$entries;
103			my @ids;
104			my $next = 1;
105
106			for my $path (@{$self->{paths}}) {
107			unless (exists $id{$path}) {
108			++$next while exists $entries->{$next};
109			$id{$path} = $next++;
110			$entries->{$id{$path}} = [$path, $now];
111			}
112
113			push @ids, 0 + $id{$path};
114			}
115
116			# reserve allocations before another server can choose the same IDs.
117			AnyEvent::MCP::File::replace $self->{file}, $json->encode ($entries);
118			$self->{ids} = \@ids;
119
120			$self
121			}
122
123			sub refresh {
124			my ($self) = @_;
125
126			my $lock = AnyEvent::MCP::File::lock $self->{file};
127			my $entries = $self->_read ($lock);
128			my $now = time;
129
130			for (0 .. $#{$self->{paths}}) {
131			$entries->{$self->{ids}[$_]} = [$self->{paths}[$_], $now];
132			}
133
134			for my $id (keys %$entries) {
135			delete $entries->{$id} if $entries->{$id}[1] <= $now - $self->{expiry};
136			}
137
138			AnyEvent::MCP::File::replace $self->{file}, $json->encode ($entries);
139			}
140
141			1;