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 AnyEvent::MCP ();
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 ();

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.24
Committed:	Tue Nov 3 08:45:31 2026 UTC (11 days, 8 hours ago) by root
Branch:	MAIN
Changes since 1.23:	+103 -11 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			use AnyEvent::MCP ();
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.4	use AnyEvent::Socket ();
197	root	1.1
198			our @ISA = qw(AnyEvent::MCP::Base);
199
200			sub _file {
201			my $dir = $ENV{XDG_CONFIG_HOME}
202			\|\| ($ENV{HOME} \|\| die "HOME is not set\n") . "/.config";
203
204			"$dir/anyevent-mcp/global.ini"
205			}
206
207			my $global;
208
209			sub global {
210			my $class = shift;
211
212			$global \|\|= $class->new (@_)
213			}
214
215	root	1.16	sub new {
216	root	1.1	my ($class, %kv) = @_;
217	root	1.11
218	root	1.1	my $self = $class->SUPER::new (section => {}, %kv);
219			$self->{file} = _file unless exists $self->{file};
220
221			if (open my $fh, "<:encoding(UTF-8)", $self->{file}) {
222			$self->_read ($fh);
223			close $fh or die "$self->{file}: $!\n";
224			} else {
225			die "$self->{file}: $!\n" unless $! == ENOENT;
226			}
227
228			$self->_ensure_secret;
229
230	root	1.11	$self->{section}{global}{secret} =~ /\A[0-9a-fA-F]{128}\z/
231			or die "$self->{file}: invalid secret; supply 128 hexadecimal digits\n";
232	root	1.1
233			$self
234			}
235
236			sub _read {
237			my ($self, $fh) = @_;
238
239	root	1.15	local $/;
240			AnyEvent::MCP::parse_ini scalar (<$fh>), sub {
241			my ($name, $kv) = @_;
242			my $section = $self->{section}{$name \|\| "global"} \|\|= {};
243			%$section = (%$section, %$kv);
244			}, $self->{file};
245	root	1.1
246			}
247
248			sub _ensure_secret {
249			my ($self) = @_;
250
251			return if exists $self->{section}{global}{secret};
252
253			my $secret = eval { unpack "H*", AnyEvent::MCP::random_bytes 64 };
254			die "$@Supply a securely generated 128-digit hexadecimal secret in $self->{file}\n"
255			if $@;
256
257			eval {
258			File::Path::mkpath (File::Basename::dirname ($self->{file}), 0, 0700);
259			sysopen my $fh, $self->{file}, O_RDWR \| O_CREAT, 0600
260			or die "$self->{file}: $!\n";
261			flock $fh, LOCK_EX or die "$self->{file}: $!\n";
262			binmode $fh, ":encoding(UTF-8)";
263
264			my $disk = bless { file => $self->{file}, section => {} }, ref $self;
265			$disk->_read ($fh);
266
267			unless (exists $disk->{section}{global}{secret}) {
268			seek $fh, 0, 2 or die "$self->{file}: $!\n";
269			print {$fh} "\n[global]\nsecret = $secret\n"
270			or die "$self->{file}: $!\n";
271			$disk->{section}{global}{secret} = $secret;
272			}
273
274			close $fh or die "$self->{file}: $!\n";
275			$self->{section} = $disk->{section};
276			1
277			} or warn "Cannot save MCP master secret; credentials may only be stable for this process: $@";
278
279			$self->{section}{global}{secret} = $secret
280			unless exists $self->{section}{global}{secret};
281			}
282
283			sub init {
284			my ($class, %kv) = @_;
285	root	1.11
286	root	1.1	my $file = exists $kv{file} ? $kv{file} : _file;
287
288			my $secret = AnyEvent::MCP::random_bytes 64;
289
290			File::Path::mkpath (File::Basename::dirname ($file), 0, 0700);
291
292			sysopen my $fh, $file, O_WRONLY \| O_CREAT \| O_EXCL, 0600
293			or die "$file: $!\n";
294
295			print {$fh} "[global]\nsecret = ", unpack ("H*", $secret), "\n"
296			or die "$file: $!\n";
297			close $fh or die "$file: $!\n";
298
299			$class->new (file => $file)
300			}
301
302	root	1.13	sub _prk_derive_secret($$@) {
303			my ($prk, $length, @info) = @_;
304
305			64 == length $prk
306			or die "derive_secret: key length must be 64 octets\n";
307			$length =~ /\A[0-9]+\z/ && $length <= 255 * 64
308			or die "derive_secret: length must be an integer in 0..16320\n";
309
310	root	1.14	my $info = pack "(N/a)", "anyevent-mcp", @info;
311	root	1.13	my $t = "";
312			my $okm = "";
313			my $i = 0;
314
315			while ($length > length $okm) {
316			$t = Digest::SHA::hmac_sha512 $t . $info . chr ++$i, $prk;
317			$okm .= $t;
318			}
319
320			substr $okm, 0, $length
321			}
322
323			sub derive_secret {
324			my ($self, $length, @info) = @_;
325
326			$self = $self->global unless ref $self;
327
328			my $secret = $self->{section}{global}{secret};
329			$secret =~ /\A[0-9a-fA-F]{128}\z/
330			or die "$self->{file}: missing or invalid secret\n";
331
332			_prk_derive_secret (pack ("H*", $secret), $length, @info)
333			}
334
335	root	1.21	sub program_name {
336			my $name = File::Basename::basename ($0);
337			$name =~ s/\.(?:pl\|perl)\z//;
338			$name eq "-e" ? "perl" : $name
339			}
340
341			sub server_name {
342			my ($name) = @_;
343
344			$name = "default" unless defined $name;
345
346			$name =~ /\A[A-Za-z_][A-Za-z0-9_-]*\z/
347			or die "Invalid MCP server name '$name'\n";
348
349			$name
350			}
351
352	root	1.1	sub credential {
353			my ($self, $purpose, $name, $username) = @_;
354
355			$username = "" unless defined $username;
356
357	root	1.11	$purpose eq "token"
358			or die "Unknown credential purpose '$purpose'\n";
359	root	1.1
360			my $credential = MIME::Base64::encode_base64 (
361	root	1.13	$self->derive_secret (
362	root	1.21	32,
363			$purpose,
364			(AnyEvent::MCP::utf8enc program_name),
365			(AnyEvent::MCP::utf8enc $name),
366			(AnyEvent::MCP::utf8enc $username)
367	root	1.13	), ""
368	root	1.1	);
369			$credential =~ y!+/=!-_!d;
370
371			$credential
372			}
373
374	root	1.24	sub users {
375			my ($self, $name, $program) = @_;
376
377			$name = server_name $name;
378			$program //= program_name;
379			my %users = (default => { scope => "global", generation => 1 });
380
381			for my $entry (
382			["global", $self->{section}{global}],
383			["program", $self->{section}{"program $program"}],
384			["instance", $self->{section}{"instance $name"}],
385			) {
386			my ($scope, $section) = @$entry;
387			next unless $section;
388
389			for my $key (grep /\Auser\./, keys %$section) {
390			my ($user) = $key =~ /\Auser\.([A-Za-z_][A-Za-z0-9_-]*)\z/
391			or die "Invalid MCP user '$key'\n";
392			my $generation = $section->{$key};
393			$generation =~ /\A-?[1-9][0-9]*\z/ && length $generation < 18
394			or die "Invalid MCP user generation for '$key'\n";
395			$users{$user} = { scope => $scope, generation => $generation };
396			}
397			}
398
399			\%users
400			}
401
402			sub user_credentials {
403			my ($self, $name, $program) = @_;
404
405			$name = server_name $name;
406			$program //= program_name;
407			my $users = $self->users ($name, $program);
408			my @credentials;
409
410			for my $user (sort { ($a ne "default") <=> ($b ne "default") \|\| $a cmp $b } keys %$users) {
411			my $info = $users->{$user};
412			next unless $info->{generation} > 0;
413			my $token = MIME::Base64::encode_base64 ($self->derive_secret (
414			32, "user-token-v1", AnyEvent::MCP::utf8enc ($program),
415			AnyEvent::MCP::utf8enc ($name), $info->{scope},
416			AnyEvent::MCP::utf8enc ($user), "$info->{generation}"
417			), "");
418			$token =~ y!+/=!-_!d;
419			push @credentials, [$user, "$info->{scope}:$user", $token];
420			}
421
422			\@credentials
423			}
424
425			sub connect_user {
426			my ($self, $name, $program) = @_;
427
428			$name = server_name $name;
429			$program //= program_name;
430			my $user = $self->{section}{"instance $name"}{connect_user}
431			// $self->{section}{"program $program"}{connect_user}
432			// $self->{section}{global}{connect_user} // "default";
433			server_name $user
434			}
435
436	root	1.4	sub http_getopt {
437	root	1.5	my ($name, $bind, $print_url, $tokens) = @_;
438	root	1.4
439	root	1.24	"name=s" => $name, "bind=s" => $bind, "print-url\|print-urls:s" => $print_url, "token=s@" => $tokens
440	root	1.4	}
441
442	root	1.17	sub auto_rules {
443			my ($self, $name) = @_;
444			my %settings = (
445			%{$self->{section}{"program " . program_name ()} \|\| {}},
446			%{$self->{section}{"instance " . server_name ($name)} \|\| {}},
447			);
448			my @rules;
449
450			for my $key (sort grep /\Aauto-rule\./, keys %settings) {
451			$key =~ /\Aauto-rule\.(.+)\z/
452			or die "Invalid automatic permission rule key '$key'\n";
453			my $value = $settings{$key};
454			next unless length $value;
455			my ($decision, $spec) = $value =~ /\A(allow\|deny)\s+(\S+)\z/
456			or die "Invalid configured automatic permission rule '$key'\n";
457			push @rules, [$decision, $spec];
458			}
459
460			@rules
461			}
462
463	root	1.4	sub server_port {
464			my ($self, $name) = @_;
465
466			$name = server_name $name;
467
468	root	1.21	16384 + (
469			(unpack "n", $self->derive_secret (
470			2,
471			"port",
472			(AnyEvent::MCP::utf8enc program_name),
473			(AnyEvent::MCP::utf8enc $name))
474			) & 16383)
475	root	1.4	}
476
477			sub http_settings {
478			my ($self, $name, $bind) = @_;
479
480			$name = server_name $name;
481	root	1.14	my $settings = {
482			%{ $self->{section}{"program " . program_name ()} },
483			%{ $self->{section}{"instance $name"} },
484			};
485	root	1.4	my $port = $self->server_port ($name);
486			my $configured = $settings->{bind} // "127.0.0.1:$port";
487			$configured = "127.0.0.1$configured" if $configured =~ /\A:[0-9]+\z/;
488			my ($configured_host, $configured_port) = AnyEvent::Socket::parse_hostport $configured, $port;
489			defined $configured_host && defined $configured_port
490			&& $configured_port =~ /\A[0-9]+\z/ && $configured_port <= 65535
491			or die "Invalid MCP bind address '$configured'\n";
492
493			$bind = $configured unless defined $bind;
494			$bind = "127.0.0.1$bind" if $bind =~ /\A:[0-9]+\z/;
495
496			my ($host, $service) = AnyEvent::Socket::parse_hostport $bind, $configured_port;
497			defined $host && defined $service && $service =~ /\A[0-9]+\z/ && $service <= 65535
498			or die "Invalid MCP bind address '$bind'\n";
499
500			my %kv = (
501			(map { exists $settings->{$_} ? ($_ => $settings->{$_}) : () }
502	root	1.23	qw(path url_host url_scheme tls_cert tls_key)),
503	root	1.4	name => $name,
504			host => $host,
505			port => $service,
506			);
507
508			unless (AnyEvent::Socket::parse_address $host) {
509	root	1.20	my $cv = AnyEvent->condvar;
510			AnyEvent::Socket::resolve_sockaddr $host, $service, "tcp", 0, 0, $cv;
511			my ($resolved) = $cv->recv;
512			$resolved or die "Cannot resolve MCP bind host '$host'\n";
513	root	1.4
514	root	1.20	my (undef, $address) = AnyEvent::Socket::unpack_sockaddr $resolved->[3];
515	root	1.4	$kv{url_host} //= $host;
516	root	1.9	$kv{host} = AnyEvent::Socket::format_address $address;
517	root	1.4	}
518
519	root	1.24	if (exists $settings->{tokens}) {
520			$kv{tokens} = [split /\s,\s/, $settings->{tokens}, -1];
521			$kv{connect_tokens} = $kv{tokens};
522			} else {
523			my $credentials = $self->user_credentials ($name);
524			$kv{tokens} = [map $_->[2], @$credentials];
525			$kv{token_users} = { map { $_->[2] => $_->[1] } @$credentials };
526			my $connect = $self->connect_user ($name);
527			$kv{connect_tokens} = [map $_->[2], grep $_->[0] eq $connect, @$credentials];
528			}
529	root	1.4
530			%kv
531			}
532
533			sub http_url {
534			my ($self, $name, $bind, %options) = @_;
535
536	root	1.14	$name = server_name $name;
537
538	root	1.11	# only a derived token depends on the master secret surviving this process.
539	root	1.8	if (($options{auth} \|\| "") ne "none"
540			&& !exists $options{tokens}
541	root	1.14	&& !exists $self->{section}{"instance $name"}{tokens}
542	root	1.24	&& !exists $self->{section}{"program " . program_name ()}{tokens}
543			&& !exists $self->{section}{global}{tokens}) {
544	root	1.22	my $stored = (ref $self)->new (file => $self->{file});
545	root	1.8	$stored->{section}{global}{secret} eq $self->{section}{global}{secret}
546			or die "MCP master secret is not persistently stored in $self->{file}\n";
547			}
548	root	1.4
549			require AnyEvent::MCP::Server::HTTP;
550	root	1.8	my %http = $self->http_settings ($name, $bind);
551			delete $http{tokens} if ($options{auth} \|\| "") eq "none";
552	root	1.11
553			AnyEvent::MCP::Server::HTTP->new (%http, %options)->url
554	root	1.4	}
555
556	root	1.1
557			1