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