AnyEvent/MCP/Config.pm

=head1 NAME

AnyEvent::MCP::Config - named servers and derived MCP credentials

=head1 SYNOPSIS

   use AnyEvent::MCP::Config;

   my $config = AnyEvent::MCP::Config->global;
   my $token = $config->user_credentials ("agni")->[0][2];
   my $url = $config->http_url ("agni", undef, path => "/");

=head1 DESCRIPTION

An MCP server and its clients often need matching credentials. Rather than
maintaining a separate password for each server and user, this module can
derive them from one private master secret. Users are defined by
C<user.NAME = GENERATION> in C<[global]>, C<[program PROGRAM]> or
C<[instance NAME]>, in that order of precedence. An absent global
C<user.default> is implicitly enabled at generation 1.

The shared file format is described in L<AnyEvent::MCP/GLOBAL CONFIGURATION>.
Loading this module does not read any files. The first call to C<global>
reads the configuration, ensures a master secret exists and caches the object
for the process.

A missing secret is generated using C<AnyEvent::MCP::random_bytes> and saved
when possible. Saving failure produces a warning; the generated secret remains
usable in this process, but another process might derive different credentials.
A supplied invalid secret is an error. Changing or losing the master secret
invalidates all credentials derived from it.

Derivation uses C<derive_secret> with the random master key.
The application namespace, purpose, program, instance name and username are
separately length-prefixed, so distinct contexts derive different credentials.
Deriving a password does not create an account or configure the server to
accept it: authentication still belongs to the server.

=head1 METHODS

=over

=item $config = AnyEvent::MCP::Config->global (file => $file)

Returns the cached global configuration. The first call accepts the same
arguments as C<new>; later calls return the same object without rereading
the file. Call this explicitly during program startup.

=item $config = AnyEvent::MCP::Config->new (file => $file)

Reads C<$file>, or the default file when omitted, and ensures a master
secret exists. Unlike C<global>, each call creates an independent object.
A missing file is allowed; other read errors are fatal. Sections are available
as C<< $config->{section}{$section} >>, each a hash reference of string
values. Named servers use C<[instance NAME]>.

=item $config = AnyEvent::MCP::Config->init (file => $file)

Explicitly creates the configuration file with a random secret, mode 0600.
Creates missing parent directories with mode 0700. Fails if the file already
exists, so it cannot accidentally replace an existing secret.

=item $bytes = $config->derive_secret ($length, @info)

=item $bytes = AnyEvent::MCP::Config->derive_secret ($length, @info)

Derive C<$length> secret bytes from the configuration's master secret and
an ordered list of context byte strings C<@info>. The class form uses
C<global>, loading the default configuration on first use and reusing it
thereafter. The object form uses that object's configuration, including
one loaded from an explicit file.

The same master secret and context always produce the same bytes. Use a
distinctive application/purpose string as the first context field, followed
by names or other values identifying the result:

   my $secret = AnyEvent::MCP::Config->derive_secret (
      32, "my application token v1", AnyEvent::MCP::utf8enc ($name)
   );

The result contains raw bytes; encode it yourself if a printable token is
needed. This method does not add the result to a server's accepted tokens.

The fixed C<anyevent-mcp> context field is prepended automatically.
Context fields are separately length-prefixed, so C<("ab", "c")> and
C<("a", "bc")> have different contexts. Encode character strings explicitly,
for example with C<AnyEvent::MCP::utf8enc>. Context arguments are left
unchanged.

C<$length> must be an integer in 0..16320; zero returns an empty string.
Shorter results are prefixes of longer results for the same master secret
and context. Use distinct context fields for different purposes, rather
than relying on different lengths to separate them.

Derivation uses HKDF-SHA512 expansion, with each context field prefixed by
its four-byte big-endian byte length. Changing or losing the master secret
changes every result derived from it.

=item $credential = $config->credential ($purpose, $name, $username)

Derives a 32-byte credential, returned as unpadded URL-safe Base64.
C<$purpose> is C<token>. C<$name> is the instance name, and C<$username>
is optional. This is the older unmanaged derivation API; its result is not
automatically accepted by a server. Managed credentials are enumerated by
C<user_credentials>.

Credentials use the context C<("anyevent-mcp", "token", PROGRAM, NAME, USER)>.
PROGRAM is the invoked basename, with a trailing C<.pl> or C<.perl> removed.
Changing the program or instance name changes the credential.
A credential derived with C<$username> is B<not> automatically accepted
by the server. This method neither requires a server section nor configures
authentication.

=item $users = $config->users ($instance, $program)

Return effective user definitions keyed by username, each with C<scope>
(global, program or instance) and signed C<generation>. Inheritance is
global, program, instance; a negative generation disables without fallback.

=item $credentials = $config->user_credentials ($instance, $program)

Return enabled users as C<[[USERNAME, PRINCIPAL, TOKEN]...]> with default
first. The principal is C<global:NAME>, C<program:NAME>, or C<instance:NAME>.
HKDF context includes program, instance, scope, user and generation. Rotating
a generation changes the token but preserves saved user permissions.

=item $user = $config->connect_user ($instance, $program)

Return the username allowed to register private Vim, browser WebSocket, or
multibroker reverse-MCP connections. C<connect_user> inherits through the
usual scopes and defaults to C<default>. Revoking that user disables these
connections until its generation is renewed or another user is selected.

=item $program = AnyEvent::MCP::Config::program_name ()

Returns the invoked program basename, stripping C<.pl> or C<.perl>.
An inline Perl invocation uses C<perl>. This identity also selects the
C<[program PROGRAM]> configuration section; it is independent of routing aliases.

=item $name = AnyEvent::MCP::Config::server_name ($name)

Validate a service-instance name, or use C<default> if undefined.
Names consist of an ASCII letter or underscore followed by letters, digits,
underscores or hyphens.

=item @options = AnyEvent::MCP::Config::http_getopt (\$name, \$bind, \$print_url, \@tokens)

Return standard C<Getopt::Long> options referring to the caller's scalars.

=item $port = $config->server_port ($name)

Derive a stable default port in 16384..32767 from the master secret and
program basename and service-instance name. Collisions produce ordinary listener bind errors.

=item %settings = $config->http_settings ($name, $bind)

Resolve HTTP settings from C<[instance NAME]> and an optional command-line
C<bind> override. The default is IPv4 loopback and the name-derived port.
The bind setting accepts C<ADDRESS:PORT>, C<[IPv6]:PORT>, C<ADDRESS>,
and C<:PORT> (which keeps the default loopback address).
Hostnames are resolved once when settings are obtained; their original
spelling is advertised unless C<url_host> overrides it. The returned options
include C<name>, C<host>, C<port> and C<tokens>, plus configured C<path>,
C<url_host> and C<url_scheme>. This does not start a listener.

=item @rules = $config->auto_rules ($name)

Return ordered automatic permission rules from C<[program PROGRAM]> and
C<[instance NAME]>. C<auto-rule.SUFFIX = allow|deny TOOL[,ACTION[,CAPABILITY]]>
entries are sorted by key. The suffix is an arbitrary ordering label; instance
entries override matching program entries, and an empty value disables an
inherited entry. Command-line rules take precedence over these defaults.

=item $url = $config->http_url ($name, $bind, %options)

Format a URL containing the first accepted token, without listening.
Port zero cannot be used because the kernel has not yet selected a port.
When the token is derived, the master secret must be persistently stored,
so the next process derives the same URL. Explicit static tokens and
C<auth =E<gt> "none"> do not require that persistence check.

=back

=cut

package AnyEvent::MCP::Config;

use common::sense;

use Digest::SHA ();
use MIME::Base64 ();
use File::Basename ();
use File::Path ();
use Fcntl qw(O_WRONLY O_RDWR O_CREAT O_EXCL LOCK_EX);
use Errno qw(ENOENT);

use AnyEvent::Socket ();
use AnyEvent::MCP ();

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

sub _file {
   my $dir = $ENV{XDG_CONFIG_HOME}
      || ($ENV{HOME} || die "HOME is not set\n") . "/.config";

   "$dir/anyevent-mcp/global.ini"
}

my $global;

sub global {
   my $class = shift;

   $global ||= $class->new (@_)
}

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

   my $self = $class->SUPER::new (section => {}, %kv);
   $self->{file} = _file unless exists $self->{file};

   if (open my $fh, "<:encoding(UTF-8)", $self->{file}) {
      $self->_read ($fh);
      close $fh or die "$self->{file}: $!\n";
   } else {
      die "$self->{file}: $!\n" unless $! == ENOENT;
   }

   $self->_ensure_secret;

   $self->{section}{global}{secret} =~ /\A[0-9a-fA-F]{128}\z/
      or die "$self->{file}: invalid secret; supply 128 hexadecimal digits\n";

   $self
}

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

   local $/;
   AnyEvent::MCP::parse_ini scalar (<$fh>), sub {
      my ($name, $kv) = @_;
      my $section = $self->{section}{$name || "global"} ||= {};
      %$section = (%$section, %$kv);
   }, $self->{file};
}

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

   return if exists $self->{section}{global}{secret};

   my $secret = eval { unpack "H*", AnyEvent::MCP::random_bytes 64 };
   die "$@Supply a securely generated 128-digit hexadecimal secret in $self->{file}\n"
      if $@;

   eval {
      File::Path::mkpath (File::Basename::dirname ($self->{file}), 0, 0700);
      sysopen my $fh, $self->{file}, O_RDWR | O_CREAT, 0600
         or die "$self->{file}: $!\n";
      flock $fh, LOCK_EX or die "$self->{file}: $!\n";
      binmode $fh, ":encoding(UTF-8)";

      my $disk = bless { file => $self->{file}, section => {} }, ref $self;
      $disk->_read ($fh);

      unless (exists $disk->{section}{global}{secret}) {
         seek $fh, 0, 2 or die "$self->{file}: $!\n";
         print {$fh} "\n[global]\nsecret = $secret\n"
            or die "$self->{file}: $!\n";
         $disk->{section}{global}{secret} = $secret;
      }

      close $fh or die "$self->{file}: $!\n";
      $self->{section} = $disk->{section};
      1
   } or warn "Cannot save MCP master secret; credentials may only be stable for this process: $@";

   $self->{section}{global}{secret} = $secret
      unless exists $self->{section}{global}{secret};
}

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

   my $file = exists $kv{file} ? $kv{file} : _file;

   my $secret = AnyEvent::MCP::random_bytes 64;

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

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

   print {$fh} "[global]\nsecret = ", unpack ("H*", $secret), "\n"
      or die "$file: $!\n";
   close $fh or die "$file: $!\n";

   $class->new (file => $file)
}

sub _prk_derive_secret($$@) {
   my ($prk, $length, @info) = @_;

   64 == length $prk
      or die "derive_secret: key length must be 64 octets\n";
   $length =~ /\A[0-9]+\z/ && $length <= 255 * 64
      or die "derive_secret: length must be an integer in 0..16320\n";

   my $info = pack "(N/a*)*", "anyevent-mcp", @info;
   my $t   = "";
   my $okm = "";
   my $i   = 0;

   while ($length > length $okm) {
      $t = Digest::SHA::hmac_sha512 $t . $info . chr ++$i, $prk;
      $okm .= $t;
   }

   substr $okm, 0, $length
}

sub derive_secret {
   my ($self, $length, @info) = @_;

   $self = $self->global unless ref $self;

   my $secret = $self->{section}{global}{secret};
   $secret =~ /\A[0-9a-fA-F]{128}\z/
      or die "$self->{file}: missing or invalid secret\n";

   _prk_derive_secret (pack ("H*", $secret), $length, @info)
}

sub program_name {
   my $name = File::Basename::basename ($0);
   $name =~ s/\.(?:pl|perl)\z//;
   $name eq "-e" ? "perl" : $name
}

sub server_name {
   my ($name) = @_;

   $name = "default" unless defined $name;

   $name =~ /\A[A-Za-z_][A-Za-z0-9_-]*\z/
      or die "Invalid MCP server name '$name'\n";

   $name
}

sub credential {
   my ($self, $purpose, $name, $username) = @_;

   $username = "" unless defined $username;

   $purpose eq "token"
      or die "Unknown credential purpose '$purpose'\n";

   my $credential = MIME::Base64::encode_base64 (
      $self->derive_secret (
         32,
         $purpose,
         (AnyEvent::MCP::utf8enc program_name),
         (AnyEvent::MCP::utf8enc $name),
         (AnyEvent::MCP::utf8enc $username)
      ), ""
   );
   $credential =~ y!+/=!-_!d;

   $credential
}

sub users {
   my ($self, $name, $program) = @_;

   $name = server_name $name;
   $program //= program_name;
   my %users = (default => { scope => "global", generation => 1 });

   for my $entry (
      ["global", $self->{section}{global}],
      ["program", $self->{section}{"program $program"}],
      ["instance", $self->{section}{"instance $name"}],
   ) {
      my ($scope, $section) = @$entry;
      next unless $section;

      for my $key (grep /\Auser\./, keys %$section) {
         my ($user) = $key =~ /\Auser\.([A-Za-z_][A-Za-z0-9_-]*)\z/
            or die "Invalid MCP user '$key'\n";
         my $generation = $section->{$key};
         $generation =~ /\A-?[1-9][0-9]*\z/ && length $generation < 18
            or die "Invalid MCP user generation for '$key'\n";
         $users{$user} = { scope => $scope, generation => $generation };
      }
   }

   \%users
}

sub user_credentials {
   my ($self, $name, $program) = @_;

   $name = server_name $name;
   $program //= program_name;
   my $users = $self->users ($name, $program);
   my @credentials;

   for my $user (sort { ($a ne "default") <=> ($b ne "default") || $a cmp $b } keys %$users) {
      my $info = $users->{$user};
      next unless $info->{generation} > 0;
      my $token = MIME::Base64::encode_base64 ($self->derive_secret (
         32, "user-token-v1", AnyEvent::MCP::utf8enc ($program),
         AnyEvent::MCP::utf8enc ($name), $info->{scope},
         AnyEvent::MCP::utf8enc ($user), "$info->{generation}"
      ), "");
      $token =~ y!+/=!-_!d;
      push @credentials, [$user, "$info->{scope}:$user", $token];
   }

   \@credentials
}

sub connect_user {
   my ($self, $name, $program) = @_;

   $name = server_name $name;
   $program //= program_name;
   my $user = $self->{section}{"instance $name"}{connect_user}
      // $self->{section}{"program $program"}{connect_user}
      // $self->{section}{global}{connect_user} // "default";
   server_name $user
}

sub http_getopt {
   my ($name, $bind, $print_url, $tokens) = @_;

   "name=s" => $name, "bind=s" => $bind, "print-url|print-urls:s" => $print_url, "token=s@" => $tokens
}

sub auto_rules {
   my ($self, $name) = @_;
   my %settings = (
      %{$self->{section}{"program " . program_name ()} || {}},
      %{$self->{section}{"instance " . server_name ($name)} || {}},
   );
   my @rules;

   for my $key (sort grep /\Aauto-rule\./, keys %settings) {
      $key =~ /\Aauto-rule\.(.+)\z/
         or die "Invalid automatic permission rule key '$key'\n";
      my $value = $settings{$key};
      next unless length $value;
      my ($decision, $spec) = $value =~ /\A(allow|deny)\s+(\S+)\z/
         or die "Invalid configured automatic permission rule '$key'\n";
      push @rules, [$decision, $spec];
   }

   @rules
}

sub server_port {
   my ($self, $name) = @_;

   $name = server_name $name;

   16384 + (
      (unpack "n", $self->derive_secret (
         2,
         "port",
         (AnyEvent::MCP::utf8enc program_name),
         (AnyEvent::MCP::utf8enc $name))
   ) & 16383)
}

sub http_settings {
   my ($self, $name, $bind) = @_;

   $name = server_name $name;
   my $settings = {
      %{ $self->{section}{"program " . program_name ()} },
      %{ $self->{section}{"instance $name"} },
   };
   my $port = $self->server_port ($name);
   my $configured = $settings->{bind} // "127.0.0.1:$port";
   $configured = "127.0.0.1$configured" if $configured =~ /\A:[0-9]+\z/;
   my ($configured_host, $configured_port) = AnyEvent::Socket::parse_hostport $configured, $port;
   defined $configured_host && defined $configured_port
      && $configured_port =~ /\A[0-9]+\z/ && $configured_port <= 65535
      or die "Invalid MCP bind address '$configured'\n";

   $bind = $configured unless defined $bind;
   $bind = "127.0.0.1$bind" if $bind =~ /\A:[0-9]+\z/;

   my ($host, $service) = AnyEvent::Socket::parse_hostport $bind, $configured_port;
   defined $host && defined $service && $service =~ /\A[0-9]+\z/ && $service <= 65535
      or die "Invalid MCP bind address '$bind'\n";

   my %kv = (
      (map { exists $settings->{$_} ? ($_ => $settings->{$_}) : () }
         qw(path url_host url_scheme tls_cert tls_key)),
      name => $name,
      host => $host,
      port => $service,
   );

   unless (AnyEvent::Socket::parse_address $host) {
      my $cv = AnyEvent->condvar;
      AnyEvent::Socket::resolve_sockaddr $host, $service, "tcp", 0, 0, $cv;
      my ($resolved) = $cv->recv;
      $resolved or die "Cannot resolve MCP bind host '$host'\n";

      my (undef, $address) = AnyEvent::Socket::unpack_sockaddr $resolved->[3];
      $kv{url_host} //= $host;
      $kv{host} = AnyEvent::Socket::format_address $address;
   }

   if (exists $settings->{tokens}) {
      $kv{tokens} = [split /\s*,\s*/, $settings->{tokens}, -1];
      $kv{connect_tokens} = $kv{tokens};
   } else {
      my $credentials = $self->user_credentials ($name);
      $kv{tokens} = [map $_->[2], @$credentials];
      $kv{token_users} = { map { $_->[2] => $_->[1] } @$credentials };
      my $connect = $self->connect_user ($name);
      $kv{connect_tokens} = [map $_->[2], grep $_->[0] eq $connect, @$credentials];
   }

   %kv
}

sub http_url {
   my ($self, $name, $bind, %options) = @_;

   $name = server_name $name;

   # only a derived token depends on the master secret surviving this process.
   if (($options{auth} || "") ne "none"
      && !exists $options{tokens}
      && !exists $self->{section}{"instance $name"}{tokens}
      && !exists $self->{section}{"program " . program_name ()}{tokens}
      && !exists $self->{section}{global}{tokens}) {
      my $stored = (ref $self)->new (file => $self->{file});
      $stored->{section}{global}{secret} eq $self->{section}{global}{secret}
         or die "MCP master secret is not persistently stored in $self->{file}\n";
   }

   require AnyEvent::MCP::Server::HTTP;
   my %http = $self->http_settings ($name, $bind);
   delete $http{tokens} if ($options{auth} || "") eq "none";

   AnyEvent::MCP::Server::HTTP->new (%http, %options)->url
}


1
Revision:	1.25
Committed:	Tue Nov 3 17:38:28 2026 UTC (2 days, 16 hours ago) by root
Branch:	MAIN
CVS Tags:	rel-0_81, rel-0_8, HEAD
Changes since 1.24:	+3 -2 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			AnyEvent::MCP::Config - named servers and derived MCP credentials
4
5			=head1 SYNOPSIS
6
7	root	1.12	use AnyEvent::MCP::Config;
8
9	root	1.1	my $config = AnyEvent::MCP::Config->global;
10	root	1.24	my $token = $config->user_credentials ("agni")->[0][2];
11	root	1.6	my $url = $config->http_url ("agni", undef, path => "/");
12	root	1.1
13			=head1 DESCRIPTION
14
15	root	1.3	An MCP server and its clients often need matching credentials. Rather than
16			maintaining a separate password for each server and user, this module can
17	root	1.24	derive them from one private master secret. Users are defined by
18			C<user.NAME = GENERATION> in C<[global]>, C<[program PROGRAM]> or
19			C<[instance NAME]>, in that order of precedence. An absent global
20			C<user.default> is implicitly enabled at generation 1.
21	root	1.3
22			The shared file format is described in L<AnyEvent::MCP/GLOBAL CONFIGURATION>.
23			Loading this module does not read any files. The first call to C<global>
24			reads the configuration, ensures a master secret exists and caches the object
25			for the process.
26	root	1.1
27			A missing secret is generated using C<AnyEvent::MCP::random_bytes> and saved
28			when possible. Saving failure produces a warning; the generated secret remains
29	root	1.3	usable in this process, but another process might derive different credentials.
30			A supplied invalid secret is an error. Changing or losing the master secret
31			invalidates all credentials derived from it.
32	root	1.1
33	root	1.13	Derivation uses C<derive_secret> with the random master key.
34	root	1.14	The application namespace, purpose, program, instance name and username are
35			separately length-prefixed, so distinct contexts derive different credentials.
36	root	1.3	Deriving a password does not create an account or configure the server to
37			accept it: authentication still belongs to the server.
38	root	1.1
39			=head1 METHODS
40
41	root	1.12	=over
42
43			=item $config = AnyEvent::MCP::Config->global (file => $file)
44	root	1.1
45			Returns the cached global configuration. The first call accepts the same
46			arguments as C<new>; later calls return the same object without rereading
47			the file. Call this explicitly during program startup.
48
49	root	1.12	=item $config = AnyEvent::MCP::Config->new (file => $file)
50	root	1.1
51			Reads C<$file>, or the default file when omitted, and ensures a master
52			secret exists. Unlike C<global>, each call creates an independent object.
53			A missing file is allowed; other read errors are fatal. Sections are available
54			as C<< $config->{section}{$section} >>, each a hash reference of string
55	root	1.10	values. Named servers use C<[instance NAME]>.
56	root	1.1
57	root	1.12	=item $config = AnyEvent::MCP::Config->init (file => $file)
58	root	1.1
59			Explicitly creates the configuration file with a random secret, mode 0600.
60			Creates missing parent directories with mode 0700. Fails if the file already
61			exists, so it cannot accidentally replace an existing secret.
62
63	root	1.13	=item $bytes = $config->derive_secret ($length, @info)
64
65			=item $bytes = AnyEvent::MCP::Config->derive_secret ($length, @info)
66
67			Derive C<$length> secret bytes from the configuration's master secret and
68			an ordered list of context byte strings C<@info>. The class form uses
69			C<global>, loading the default configuration on first use and reusing it
70			thereafter. The object form uses that object's configuration, including
71			one loaded from an explicit file.
72
73			The same master secret and context always produce the same bytes. Use a
74			distinctive application/purpose string as the first context field, followed
75			by names or other values identifying the result:
76
77			my $secret = AnyEvent::MCP::Config->derive_secret (
78			32, "my application token v1", AnyEvent::MCP::utf8enc ($name)
79			);
80
81			The result contains raw bytes; encode it yourself if a printable token is
82			needed. This method does not add the result to a server's accepted tokens.
83
84	root	1.14	The fixed C<anyevent-mcp> context field is prepended automatically.
85	root	1.13	Context fields are separately length-prefixed, so C<("ab", "c")> and
86			C<("a", "bc")> have different contexts. Encode character strings explicitly,
87			for example with C<AnyEvent::MCP::utf8enc>. Context arguments are left
88			unchanged.
89
90			C<$length> must be an integer in 0..16320; zero returns an empty string.
91			Shorter results are prefixes of longer results for the same master secret
92			and context. Use distinct context fields for different purposes, rather
93			than relying on different lengths to separate them.
94
95			Derivation uses HKDF-SHA512 expansion, with each context field prefixed by
96			its four-byte big-endian byte length. Changing or losing the master secret
97			changes every result derived from it.
98
99	root	1.12	=item $credential = $config->credential ($purpose, $name, $username)
100	root	1.1
101			Derives a 32-byte credential, returned as unpadded URL-safe Base64.
102	root	1.14	C<$purpose> is C<token>. C<$name> is the instance name, and C<$username>
103	root	1.24	is optional. This is the older unmanaged derivation API; its result is not
104			automatically accepted by a server. Managed credentials are enumerated by
105			C<user_credentials>.
106	root	1.1
107	root	1.14	Credentials use the context C<("anyevent-mcp", "token", PROGRAM, NAME, USER)>.
108			PROGRAM is the invoked basename, with a trailing C<.pl> or C<.perl> removed.
109	root	1.18	Changing the program or instance name changes the credential.
110	root	1.12	A credential derived with C<$username> is B<not> automatically accepted
111			by the server. This method neither requires a server section nor configures
112			authentication.
113	root	1.1
114	root	1.24	=item $users = $config->users ($instance, $program)
115
116			Return effective user definitions keyed by username, each with C<scope>
117			(global, program or instance) and signed C<generation>. Inheritance is
118			global, program, instance; a negative generation disables without fallback.
119
120			=item $credentials = $config->user_credentials ($instance, $program)
121
122			Return enabled users as C<[[USERNAME, PRINCIPAL, TOKEN]...]> with default
123			first. The principal is C<global:NAME>, C<program:NAME>, or C<instance:NAME>.
124			HKDF context includes program, instance, scope, user and generation. Rotating
125			a generation changes the token but preserves saved user permissions.
126
127			=item $user = $config->connect_user ($instance, $program)
128
129			Return the username allowed to register private Vim, browser WebSocket, or
130			multibroker reverse-MCP connections. C<connect_user> inherits through the
131			usual scopes and defaults to C<default>. Revoking that user disables these
132			connections until its generation is renewed or another user is selected.
133
134	root	1.14	=item $program = AnyEvent::MCP::Config::program_name ()
135
136			Returns the invoked program basename, stripping C<.pl> or C<.perl>.
137			An inline Perl invocation uses C<perl>. This identity also selects the
138			C<[program PROGRAM]> configuration section; it is independent of routing aliases.
139
140	root	1.12	=item $name = AnyEvent::MCP::Config::server_name ($name)
141	root	1.4
142	root	1.14	Validate a service-instance name, or use C<default> if undefined.
143	root	1.4	Names consist of an ASCII letter or underscore followed by letters, digits,
144			underscores or hyphens.
145
146	root	1.12	=item @options = AnyEvent::MCP::Config::http_getopt (\$name, \$bind, \$print_url, \@tokens)
147	root	1.4
148			Return standard C<Getopt::Long> options referring to the caller's scalars.
149
150	root	1.12	=item $port = $config->server_port ($name)
151	root	1.4
152			Derive a stable default port in 16384..32767 from the master secret and
153	root	1.14	program basename and service-instance name. Collisions produce ordinary listener bind errors.
154	root	1.4
155	root	1.12	=item %settings = $config->http_settings ($name, $bind)
156	root	1.4
157	root	1.10	Resolve HTTP settings from C<[instance NAME]> and an optional command-line
158	root	1.4	C<bind> override. The default is IPv4 loopback and the name-derived port.
159			The bind setting accepts C<ADDRESS:PORT>, C<[IPv6]:PORT>, C<ADDRESS>,
160			and C<:PORT> (which keeps the default loopback address).
161	root	1.12	Hostnames are resolved once when settings are obtained; their original
162			spelling is advertised unless C<url_host> overrides it. The returned options
163			include C<name>, C<host>, C<port> and C<tokens>, plus configured C<path>,
164			C<url_host> and C<url_scheme>. This does not start a listener.
165	root	1.4
166	root	1.17	=item @rules = $config->auto_rules ($name)
167
168			Return ordered automatic permission rules from C<[program PROGRAM]> and
169			C<[instance NAME]>. C<auto-rule.SUFFIX = allow\|deny TOOL[,ACTION[,CAPABILITY]]>
170			entries are sorted by key. The suffix is an arbitrary ordering label; instance
171			entries override matching program entries, and an empty value disables an
172			inherited entry. Command-line rules take precedence over these defaults.
173
174	root	1.12	=item $url = $config->http_url ($name, $bind, %options)
175	root	1.4
176	root	1.8	Format a URL containing the first accepted token, without listening.
177			Port zero cannot be used because the kernel has not yet selected a port.
178			When the token is derived, the master secret must be persistently stored,
179			so the next process derives the same URL. Explicit static tokens and
180			C<auth =E<gt> "none"> do not require that persistence check.
181	root	1.4
182	root	1.12	=back
183
184	root	1.1	=cut
185
186			package AnyEvent::MCP::Config;
187
188			use common::sense;
189	root	1.25
190	root	1.13	use Digest::SHA ();
191	root	1.1	use MIME::Base64 ();
192			use File::Basename ();
193			use File::Path ();
194			use Fcntl qw(O_WRONLY O_RDWR O_CREAT O_EXCL LOCK_EX);
195			use Errno qw(ENOENT);
196	root	1.25
197	root	1.4	use AnyEvent::Socket ();
198	root	1.25	use AnyEvent::MCP ();
199	root	1.1
200			our @ISA = qw(AnyEvent::MCP::Base);
201
202			sub _file {
203			my $dir = $ENV{XDG_CONFIG_HOME}
204			\|\| ($ENV{HOME} \|\| die "HOME is not set\n") . "/.config";
205
206			"$dir/anyevent-mcp/global.ini"
207			}
208
209			my $global;
210
211			sub global {
212			my $class = shift;
213
214			$global \|\|= $class->new (@_)
215			}
216
217	root	1.16	sub new {
218	root	1.1	my ($class, %kv) = @_;
219	root	1.11
220	root	1.1	my $self = $class->SUPER::new (section => {}, %kv);
221			$self->{file} = _file unless exists $self->{file};
222
223			if (open my $fh, "<:encoding(UTF-8)", $self->{file}) {
224			$self->_read ($fh);
225			close $fh or die "$self->{file}: $!\n";
226			} else {
227			die "$self->{file}: $!\n" unless $! == ENOENT;
228			}
229
230			$self->_ensure_secret;
231
232	root	1.11	$self->{section}{global}{secret} =~ /\A[0-9a-fA-F]{128}\z/
233			or die "$self->{file}: invalid secret; supply 128 hexadecimal digits\n";
234	root	1.1
235			$self
236			}
237
238			sub _read {
239			my ($self, $fh) = @_;
240
241	root	1.15	local $/;
242			AnyEvent::MCP::parse_ini scalar (<$fh>), sub {
243			my ($name, $kv) = @_;
244			my $section = $self->{section}{$name \|\| "global"} \|\|= {};
245			%$section = (%$section, %$kv);
246			}, $self->{file};
247	root	1.1	}
248
249			sub _ensure_secret {
250			my ($self) = @_;
251
252			return if exists $self->{section}{global}{secret};
253
254			my $secret = eval { unpack "H*", AnyEvent::MCP::random_bytes 64 };
255			die "$@Supply a securely generated 128-digit hexadecimal secret in $self->{file}\n"
256			if $@;
257
258			eval {
259			File::Path::mkpath (File::Basename::dirname ($self->{file}), 0, 0700);
260			sysopen my $fh, $self->{file}, O_RDWR \| O_CREAT, 0600
261			or die "$self->{file}: $!\n";
262			flock $fh, LOCK_EX or die "$self->{file}: $!\n";
263			binmode $fh, ":encoding(UTF-8)";
264
265			my $disk = bless { file => $self->{file}, section => {} }, ref $self;
266			$disk->_read ($fh);
267
268			unless (exists $disk->{section}{global}{secret}) {
269			seek $fh, 0, 2 or die "$self->{file}: $!\n";
270			print {$fh} "\n[global]\nsecret = $secret\n"
271			or die "$self->{file}: $!\n";
272			$disk->{section}{global}{secret} = $secret;
273			}
274
275			close $fh or die "$self->{file}: $!\n";
276			$self->{section} = $disk->{section};
277			1
278			} or warn "Cannot save MCP master secret; credentials may only be stable for this process: $@";
279
280			$self->{section}{global}{secret} = $secret
281			unless exists $self->{section}{global}{secret};
282			}
283
284			sub init {
285			my ($class, %kv) = @_;
286	root	1.11
287	root	1.1	my $file = exists $kv{file} ? $kv{file} : _file;
288
289			my $secret = AnyEvent::MCP::random_bytes 64;
290
291			File::Path::mkpath (File::Basename::dirname ($file), 0, 0700);
292
293			sysopen my $fh, $file, O_WRONLY \| O_CREAT \| O_EXCL, 0600
294			or die "$file: $!\n";
295
296			print {$fh} "[global]\nsecret = ", unpack ("H*", $secret), "\n"
297			or die "$file: $!\n";
298			close $fh or die "$file: $!\n";
299
300			$class->new (file => $file)
301			}
302
303	root	1.13	sub _prk_derive_secret($$@) {
304			my ($prk, $length, @info) = @_;
305
306			64 == length $prk
307			or die "derive_secret: key length must be 64 octets\n";
308			$length =~ /\A[0-9]+\z/ && $length <= 255 * 64
309			or die "derive_secret: length must be an integer in 0..16320\n";
310
311	root	1.14	my $info = pack "(N/a)", "anyevent-mcp", @info;
312	root	1.13	my $t = "";
313			my $okm = "";
314			my $i = 0;
315
316			while ($length > length $okm) {
317			$t = Digest::SHA::hmac_sha512 $t . $info . chr ++$i, $prk;
318			$okm .= $t;
319			}
320
321			substr $okm, 0, $length
322			}
323
324			sub derive_secret {
325			my ($self, $length, @info) = @_;
326
327			$self = $self->global unless ref $self;
328
329			my $secret = $self->{section}{global}{secret};
330			$secret =~ /\A[0-9a-fA-F]{128}\z/
331			or die "$self->{file}: missing or invalid secret\n";
332
333			_prk_derive_secret (pack ("H*", $secret), $length, @info)
334			}
335
336	root	1.21	sub program_name {
337			my $name = File::Basename::basename ($0);
338			$name =~ s/\.(?:pl\|perl)\z//;
339			$name eq "-e" ? "perl" : $name
340			}
341
342			sub server_name {
343			my ($name) = @_;
344
345			$name = "default" unless defined $name;
346
347			$name =~ /\A[A-Za-z_][A-Za-z0-9_-]*\z/
348			or die "Invalid MCP server name '$name'\n";
349
350			$name
351			}
352
353	root	1.1	sub credential {
354			my ($self, $purpose, $name, $username) = @_;
355
356			$username = "" unless defined $username;
357
358	root	1.11	$purpose eq "token"
359			or die "Unknown credential purpose '$purpose'\n";
360	root	1.1
361			my $credential = MIME::Base64::encode_base64 (
362	root	1.13	$self->derive_secret (
363	root	1.21	32,
364			$purpose,
365			(AnyEvent::MCP::utf8enc program_name),
366			(AnyEvent::MCP::utf8enc $name),
367			(AnyEvent::MCP::utf8enc $username)
368	root	1.13	), ""
369	root	1.1	);
370			$credential =~ y!+/=!-_!d;
371
372			$credential
373			}
374
375	root	1.24	sub users {
376			my ($self, $name, $program) = @_;
377
378			$name = server_name $name;
379			$program //= program_name;
380			my %users = (default => { scope => "global", generation => 1 });
381
382			for my $entry (
383			["global", $self->{section}{global}],
384			["program", $self->{section}{"program $program"}],
385			["instance", $self->{section}{"instance $name"}],
386			) {
387			my ($scope, $section) = @$entry;
388			next unless $section;
389
390			for my $key (grep /\Auser\./, keys %$section) {
391			my ($user) = $key =~ /\Auser\.([A-Za-z_][A-Za-z0-9_-]*)\z/
392			or die "Invalid MCP user '$key'\n";
393			my $generation = $section->{$key};
394			$generation =~ /\A-?[1-9][0-9]*\z/ && length $generation < 18
395			or die "Invalid MCP user generation for '$key'\n";
396			$users{$user} = { scope => $scope, generation => $generation };
397			}
398			}
399
400			\%users
401			}
402
403			sub user_credentials {
404			my ($self, $name, $program) = @_;
405
406			$name = server_name $name;
407			$program //= program_name;
408			my $users = $self->users ($name, $program);
409			my @credentials;
410
411			for my $user (sort { ($a ne "default") <=> ($b ne "default") \|\| $a cmp $b } keys %$users) {
412			my $info = $users->{$user};
413			next unless $info->{generation} > 0;
414			my $token = MIME::Base64::encode_base64 ($self->derive_secret (
415			32, "user-token-v1", AnyEvent::MCP::utf8enc ($program),
416			AnyEvent::MCP::utf8enc ($name), $info->{scope},
417			AnyEvent::MCP::utf8enc ($user), "$info->{generation}"
418			), "");
419			$token =~ y!+/=!-_!d;
420			push @credentials, [$user, "$info->{scope}:$user", $token];
421			}
422
423			\@credentials
424			}
425
426			sub connect_user {
427			my ($self, $name, $program) = @_;
428
429			$name = server_name $name;
430			$program //= program_name;
431			my $user = $self->{section}{"instance $name"}{connect_user}
432			// $self->{section}{"program $program"}{connect_user}
433			// $self->{section}{global}{connect_user} // "default";
434			server_name $user
435			}
436
437	root	1.4	sub http_getopt {
438	root	1.5	my ($name, $bind, $print_url, $tokens) = @_;
439	root	1.4
440	root	1.24	"name=s" => $name, "bind=s" => $bind, "print-url\|print-urls:s" => $print_url, "token=s@" => $tokens
441	root	1.4	}
442
443	root	1.17	sub auto_rules {
444			my ($self, $name) = @_;
445			my %settings = (
446			%{$self->{section}{"program " . program_name ()} \|\| {}},
447			%{$self->{section}{"instance " . server_name ($name)} \|\| {}},
448			);
449			my @rules;
450
451			for my $key (sort grep /\Aauto-rule\./, keys %settings) {
452			$key =~ /\Aauto-rule\.(.+)\z/
453			or die "Invalid automatic permission rule key '$key'\n";
454			my $value = $settings{$key};
455			next unless length $value;
456			my ($decision, $spec) = $value =~ /\A(allow\|deny)\s+(\S+)\z/
457			or die "Invalid configured automatic permission rule '$key'\n";
458			push @rules, [$decision, $spec];
459			}
460
461			@rules
462			}
463
464	root	1.4	sub server_port {
465			my ($self, $name) = @_;
466
467			$name = server_name $name;
468
469	root	1.21	16384 + (
470			(unpack "n", $self->derive_secret (
471			2,
472			"port",
473			(AnyEvent::MCP::utf8enc program_name),
474			(AnyEvent::MCP::utf8enc $name))
475			) & 16383)
476	root	1.4	}
477
478			sub http_settings {
479			my ($self, $name, $bind) = @_;
480
481			$name = server_name $name;
482	root	1.14	my $settings = {
483			%{ $self->{section}{"program " . program_name ()} },
484			%{ $self->{section}{"instance $name"} },
485			};
486	root	1.4	my $port = $self->server_port ($name);
487			my $configured = $settings->{bind} // "127.0.0.1:$port";
488			$configured = "127.0.0.1$configured" if $configured =~ /\A:[0-9]+\z/;
489			my ($configured_host, $configured_port) = AnyEvent::Socket::parse_hostport $configured, $port;
490			defined $configured_host && defined $configured_port
491			&& $configured_port =~ /\A[0-9]+\z/ && $configured_port <= 65535
492			or die "Invalid MCP bind address '$configured'\n";
493
494			$bind = $configured unless defined $bind;
495			$bind = "127.0.0.1$bind" if $bind =~ /\A:[0-9]+\z/;
496
497			my ($host, $service) = AnyEvent::Socket::parse_hostport $bind, $configured_port;
498			defined $host && defined $service && $service =~ /\A[0-9]+\z/ && $service <= 65535
499			or die "Invalid MCP bind address '$bind'\n";
500
501			my %kv = (
502			(map { exists $settings->{$_} ? ($_ => $settings->{$_}) : () }
503	root	1.23	qw(path url_host url_scheme tls_cert tls_key)),
504	root	1.4	name => $name,
505			host => $host,
506			port => $service,
507			);
508
509			unless (AnyEvent::Socket::parse_address $host) {
510	root	1.20	my $cv = AnyEvent->condvar;
511			AnyEvent::Socket::resolve_sockaddr $host, $service, "tcp", 0, 0, $cv;
512			my ($resolved) = $cv->recv;
513			$resolved or die "Cannot resolve MCP bind host '$host'\n";
514	root	1.4
515	root	1.20	my (undef, $address) = AnyEvent::Socket::unpack_sockaddr $resolved->[3];
516	root	1.4	$kv{url_host} //= $host;
517	root	1.9	$kv{host} = AnyEvent::Socket::format_address $address;
518	root	1.4	}
519
520	root	1.24	if (exists $settings->{tokens}) {
521			$kv{tokens} = [split /\s,\s/, $settings->{tokens}, -1];
522			$kv{connect_tokens} = $kv{tokens};
523			} else {
524			my $credentials = $self->user_credentials ($name);
525			$kv{tokens} = [map $_->[2], @$credentials];
526			$kv{token_users} = { map { $_->[2] => $_->[1] } @$credentials };
527			my $connect = $self->connect_user ($name);
528			$kv{connect_tokens} = [map $_->[2], grep $_->[0] eq $connect, @$credentials];
529			}
530	root	1.4
531			%kv
532			}
533
534			sub http_url {
535			my ($self, $name, $bind, %options) = @_;
536
537	root	1.14	$name = server_name $name;
538
539	root	1.11	# only a derived token depends on the master secret surviving this process.
540	root	1.8	if (($options{auth} \|\| "") ne "none"
541			&& !exists $options{tokens}
542	root	1.14	&& !exists $self->{section}{"instance $name"}{tokens}
543	root	1.24	&& !exists $self->{section}{"program " . program_name ()}{tokens}
544			&& !exists $self->{section}{global}{tokens}) {
545	root	1.22	my $stored = (ref $self)->new (file => $self->{file});
546	root	1.8	$stored->{section}{global}{secret} eq $self->{section}{global}{secret}
547			or die "MCP master secret is not persistently stored in $self->{file}\n";
548			}
549	root	1.4
550			require AnyEvent::MCP::Server::HTTP;
551	root	1.8	my %http = $self->http_settings ($name, $bind);
552			delete $http{tokens} if ($options{auth} \|\| "") eq "none";
553	root	1.11
554			AnyEvent::MCP::Server::HTTP->new (%http, %options)->url
555	root	1.4	}
556
557	root	1.1
558			1