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 //= do {
      my $config = __PACKAGE__->new (@_);
      $config->load;
      $config->ensure_secret;
      $config
   }
}

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