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_config;
   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. C<global_config> loads the
configuration, ensures a persistent master secret exists and caches the
initialized object for the process.

A missing secret is generated using C<AnyEvent::MCP::random_bytes> and
appended under a file lock. Failure to save the secret is fatal, rather
than using a temporary secret that other processes cannot reproduce.
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_config (file => $file)

Return the process-global configuration object, loaded and initialized.
The first call accepts the same arguments as C<new>, and ensures that the
master secret is persistently stored. Later calls return the same object
without rereading or reinitializing it.

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

Construct an independent configuration object without reading or writing
the file. C<$file> defaults to the global configuration path.

=item $config->load

Reload the file, replacing the object's sections. A missing file yields an
empty configuration; other read and parsing errors are fatal. Sections are
available as C<< $config->{section}{$section} >>, each a hash reference of
string values. Named servers use C<[instance NAME]>. An optional raw file
handle can be supplied when the caller already holds the file lock.

=item $config->ensure_secret

Ensure that C<[global]> contains a valid persistent master secret. If
missing, lock and reread the file, generate a secret only if still absent,
and append it without changing other settings. Fail if it cannot be saved
or is invalid. Returns the configuration object.

=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_config>, 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 $user = AnyEvent::MCP::Config::user_name ($user)

Validate a managed username (ASCII letter or underscore, followed by
letters, digits, underscores or hyphens). Instance names are validated by
L<AnyEvent::MCP/SMALL UTILITIES>.

=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 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_config {
   $global //= __PACKAGE__->new (@_)->load->ensure_secret
}

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

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

sub load {
   my ($self, $fh) = @_;
   $self->{section} = {};

   unless ($fh) {
      open $fh, "<:raw", $self->{file} or do {
         die "$self->{file}: $!\n" unless $! == ENOENT;
         return $self
      };
   }

   seek $fh, 0, 0 or die "$self->{file}: $!\n";
   $self->_read ($fh);
   close $fh or die "$self->{file}: $!\n" unless @_ > 1;

   $self
}

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

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

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

   unless (exists $self->{section}{global}{secret}) {
      my $lock = AnyEvent::MCP::file_lock $self->{file};
      $self->load ($lock);

      unless (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 $@;
         seek $lock, 0, 2 or die "$self->{file}: $!\n";
         print {$lock} "\n[global]\nsecret = $secret\n" or die "$self->{file}: $!\n";
         $self->{section}{global}{secret} = $secret;
      }

      close $lock or die "$self->{file}: $!\n";
   }

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

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 = global_config () 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 user_name {
   my ($name) = @_;

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