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->credential ("token", "agni");
   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. A server name, optional username
and credential purpose each contribute to the result. A password derived for
one server is therefore not the password for another.

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.
Server name, username and credential purpose are separately length-prefixed,
so credentials for different servers, users or authentication methods differ.
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.

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 server name, and C<$username>
is optional. The default server credential is derived with no username.

Older versions used the HKDF purpose C<cookie>. Switching from those
versions changes derived credentials; update stored client URLs.
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 $name = AnyEvent::MCP::Config::server_name ($name)

Validate a service-instance name, or use the program basename 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
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 $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 ();
use 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) = @_;

   my @stat = stat $fh;
   die "$self->{file}: configuration must be private and owned by this user\n"
      if $stat[4] != $< || $stat[2] & 077;

   my $section = $self->{section}{global} ||= {};

   while (<$fh>) {
      next if /\A\s*(?:[#;]|\z)/;

      if (/\A\s*\[([^\]\r\n]+)\]\s*\z/) {
         $section = $self->{section}{$1} ||= {};
      } elsif (/\A\s*([^=\s]+)\s*=\s*(.*?)\s*\z/) {
         $section->{$1} = $2;
      } else {
         die "$self->{file}:$.: invalid configuration line\n";
      }
   }

}

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*)*", @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 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, "AnyEvent::MCP credential v1", $purpose,
         AnyEvent::MCP::utf8enc ($name), AnyEvent::MCP::utf8enc ($username)
      ), ""
   );
   $credential =~ y!+/=!-_!d;

   $credential
}

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

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

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

   $name
}

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

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

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

   $name = server_name $name;

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

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

   $name = server_name $name;
   my $settings = $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)),
      name => $name,
      host => $host,
      port => $service,
   );

   unless (AnyEvent::Socket::parse_address $host) {
      my ($error, @addresses) = Socket::getaddrinfo ($host, undef, { socktype => Socket::SOCK_STREAM () });
      !$error && @addresses
         or die "Cannot resolve MCP bind host '$host': $error\n";

      my (undef, $address) = AnyEvent::Socket::unpack_sockaddr $addresses[0]{addr};

      $kv{url_host} //= $host;
      $kv{host} = AnyEvent::Socket::format_address $address;
   }

   $kv{tokens} = [exists $settings->{tokens}
      ? split /\s*,\s*/, $settings->{tokens}, -1
      : $self->credential ("token", $name)];

   %kv
}

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

   # 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}) {
      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.13
Committed:	Wed Oct 14 08:27:45 2026 UTC (4 weeks, 2 days ago) by root
Branch:	MAIN
Changes since 1.12:	+75 -14 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.8	my $token = $config->credential ("token", "agni");
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			derive them from one private master secret. A server name, optional username
18			and credential purpose each contribute to the result. A password derived for
19			one server is therefore not the password for another.
20
21			The shared file format is described in L<AnyEvent::MCP/GLOBAL CONFIGURATION>.
22			Loading this module does not read any files. The first call to C<global>
23			reads the configuration, ensures a master secret exists and caches the object
24			for the process.
25	root	1.1
26			A missing secret is generated using C<AnyEvent::MCP::random_bytes> and saved
27			when possible. Saving failure produces a warning; the generated secret remains
28	root	1.3	usable in this process, but another process might derive different credentials.
29			A supplied invalid secret is an error. Changing or losing the master secret
30			invalidates all credentials derived from it.
31	root	1.1
32	root	1.13	Derivation uses C<derive_secret> with the random master key.
33	root	1.1	Server name, username and credential purpose are separately length-prefixed,
34			so credentials for different servers, users or authentication methods differ.
35	root	1.3	Deriving a password does not create an account or configure the server to
36			accept it: authentication still belongs to the server.
37	root	1.1
38			=head1 METHODS
39
40	root	1.12	=over
41
42			=item $config = AnyEvent::MCP::Config->global (file => $file)
43	root	1.1
44			Returns the cached global configuration. The first call accepts the same
45			arguments as C<new>; later calls return the same object without rereading
46			the file. Call this explicitly during program startup.
47
48	root	1.12	=item $config = AnyEvent::MCP::Config->new (file => $file)
49	root	1.1
50			Reads C<$file>, or the default file when omitted, and ensures a master
51			secret exists. Unlike C<global>, each call creates an independent object.
52			A missing file is allowed; other read errors are fatal. Sections are available
53			as C<< $config->{section}{$section} >>, each a hash reference of string
54	root	1.10	values. Named servers use C<[instance NAME]>.
55	root	1.1
56	root	1.12	=item $config = AnyEvent::MCP::Config->init (file => $file)
57	root	1.1
58			Explicitly creates the configuration file with a random secret, mode 0600.
59			Creates missing parent directories with mode 0700. Fails if the file already
60			exists, so it cannot accidentally replace an existing secret.
61
62	root	1.13	=item $bytes = $config->derive_secret ($length, @info)
63
64			=item $bytes = AnyEvent::MCP::Config->derive_secret ($length, @info)
65
66			Derive C<$length> secret bytes from the configuration's master secret and
67			an ordered list of context byte strings C<@info>. The class form uses
68			C<global>, loading the default configuration on first use and reusing it
69			thereafter. The object form uses that object's configuration, including
70			one loaded from an explicit file.
71
72			The same master secret and context always produce the same bytes. Use a
73			distinctive application/purpose string as the first context field, followed
74			by names or other values identifying the result:
75
76			my $secret = AnyEvent::MCP::Config->derive_secret (
77			32, "my application token v1", AnyEvent::MCP::utf8enc ($name)
78			);
79
80			The result contains raw bytes; encode it yourself if a printable token is
81			needed. This method does not add the result to a server's accepted tokens.
82
83			Context fields are separately length-prefixed, so C<("ab", "c")> and
84			C<("a", "bc")> have different contexts. Encode character strings explicitly,
85			for example with C<AnyEvent::MCP::utf8enc>. Context arguments are left
86			unchanged.
87
88			C<$length> must be an integer in 0..16320; zero returns an empty string.
89			Shorter results are prefixes of longer results for the same master secret
90			and context. Use distinct context fields for different purposes, rather
91			than relying on different lengths to separate them.
92
93			Derivation uses HKDF-SHA512 expansion, with each context field prefixed by
94			its four-byte big-endian byte length. Changing or losing the master secret
95			changes every result derived from it.
96
97	root	1.12	=item $credential = $config->credential ($purpose, $name, $username)
98	root	1.1
99			Derives a 32-byte credential, returned as unpadded URL-safe Base64.
100	root	1.8	C<$purpose> is C<token>. C<$name> is the server name, and C<$username>
101			is optional. The default server credential is derived with no username.
102	root	1.1
103	root	1.12	Older versions used the HKDF purpose C<cookie>. Switching from those
104			versions changes derived credentials; update stored client URLs.
105			A credential derived with C<$username> is B<not> automatically accepted
106			by the server. This method neither requires a server section nor configures
107			authentication.
108	root	1.1
109	root	1.12	=item $name = AnyEvent::MCP::Config::server_name ($name)
110	root	1.4
111			Validate a service-instance name, or use the program basename if undefined.
112			Names consist of an ASCII letter or underscore followed by letters, digits,
113			underscores or hyphens.
114
115	root	1.12	=item @options = AnyEvent::MCP::Config::http_getopt (\$name, \$bind, \$print_url, \@tokens)
116	root	1.4
117			Return standard C<Getopt::Long> options referring to the caller's scalars.
118
119	root	1.12	=item $port = $config->server_port ($name)
120	root	1.4
121			Derive a stable default port in 16384..32767 from the master secret and
122			service-instance name. Collisions produce ordinary listener bind errors.
123
124	root	1.12	=item %settings = $config->http_settings ($name, $bind)
125	root	1.4
126	root	1.10	Resolve HTTP settings from C<[instance NAME]> and an optional command-line
127	root	1.4	C<bind> override. The default is IPv4 loopback and the name-derived port.
128			The bind setting accepts C<ADDRESS:PORT>, C<[IPv6]:PORT>, C<ADDRESS>,
129			and C<:PORT> (which keeps the default loopback address).
130	root	1.12	Hostnames are resolved once when settings are obtained; their original
131			spelling is advertised unless C<url_host> overrides it. The returned options
132			include C<name>, C<host>, C<port> and C<tokens>, plus configured C<path>,
133			C<url_host> and C<url_scheme>. This does not start a listener.
134	root	1.4
135	root	1.12	=item $url = $config->http_url ($name, $bind, %options)
136	root	1.4
137	root	1.8	Format a URL containing the first accepted token, without listening.
138			Port zero cannot be used because the kernel has not yet selected a port.
139			When the token is derived, the master secret must be persistently stored,
140			so the next process derives the same URL. Explicit static tokens and
141			C<auth =E<gt> "none"> do not require that persistence check.
142	root	1.4
143	root	1.12	=back
144
145	root	1.1	=cut
146
147			package AnyEvent::MCP::Config;
148
149			use common::sense;
150			use AnyEvent::MCP ();
151	root	1.13	use Digest::SHA ();
152	root	1.1	use MIME::Base64 ();
153			use File::Basename ();
154			use File::Path ();
155			use Fcntl qw(O_WRONLY O_RDWR O_CREAT O_EXCL LOCK_EX);
156			use Errno qw(ENOENT);
157	root	1.4	use AnyEvent::Socket ();
158			use Socket ();
159	root	1.1
160			our @ISA = qw(AnyEvent::MCP::Base);
161
162			sub _file {
163			my $dir = $ENV{XDG_CONFIG_HOME}
164			\|\| ($ENV{HOME} \|\| die "HOME is not set\n") . "/.config";
165
166			"$dir/anyevent-mcp/global.ini"
167			}
168
169			my $global;
170
171			sub global {
172			my $class = shift;
173
174			$global \|\|= $class->new (@_)
175			}
176
177			sub new {
178			my ($class, %kv) = @_;
179	root	1.11
180	root	1.1	my $self = $class->SUPER::new (section => {}, %kv);
181			$self->{file} = _file unless exists $self->{file};
182
183			if (open my $fh, "<:encoding(UTF-8)", $self->{file}) {
184			$self->_read ($fh);
185			close $fh or die "$self->{file}: $!\n";
186			} else {
187			die "$self->{file}: $!\n" unless $! == ENOENT;
188			}
189
190			$self->_ensure_secret;
191
192	root	1.11	$self->{section}{global}{secret} =~ /\A[0-9a-fA-F]{128}\z/
193			or die "$self->{file}: invalid secret; supply 128 hexadecimal digits\n";
194	root	1.1
195			$self
196			}
197
198			sub _read {
199			my ($self, $fh) = @_;
200
201			my @stat = stat $fh;
202			die "$self->{file}: configuration must be private and owned by this user\n"
203			if $stat[4] != $< \|\| $stat[2] & 077;
204
205			my $section = $self->{section}{global} \|\|= {};
206
207			while (<$fh>) {
208			next if /\A\s*(?:[#;]\|\z)/;
209
210			if (/\A\s\[([^\]\r\n]+)\]\s\z/) {
211			$section = $self->{section}{$1} \|\|= {};
212			} elsif (/\A\s([^=\s]+)\s=\s(.?)\s*\z/) {
213			$section->{$1} = $2;
214			} else {
215			die "$self->{file}:$.: invalid configuration line\n";
216			}
217			}
218
219			}
220
221			sub _ensure_secret {
222			my ($self) = @_;
223
224			return if exists $self->{section}{global}{secret};
225
226			my $secret = eval { unpack "H*", AnyEvent::MCP::random_bytes 64 };
227			die "$@Supply a securely generated 128-digit hexadecimal secret in $self->{file}\n"
228			if $@;
229
230			eval {
231			File::Path::mkpath (File::Basename::dirname ($self->{file}), 0, 0700);
232			sysopen my $fh, $self->{file}, O_RDWR \| O_CREAT, 0600
233			or die "$self->{file}: $!\n";
234			flock $fh, LOCK_EX or die "$self->{file}: $!\n";
235			binmode $fh, ":encoding(UTF-8)";
236
237			my $disk = bless { file => $self->{file}, section => {} }, ref $self;
238			$disk->_read ($fh);
239
240			unless (exists $disk->{section}{global}{secret}) {
241			seek $fh, 0, 2 or die "$self->{file}: $!\n";
242			print {$fh} "\n[global]\nsecret = $secret\n"
243			or die "$self->{file}: $!\n";
244			$disk->{section}{global}{secret} = $secret;
245			}
246
247			close $fh or die "$self->{file}: $!\n";
248			$self->{section} = $disk->{section};
249			1
250			} or warn "Cannot save MCP master secret; credentials may only be stable for this process: $@";
251
252			$self->{section}{global}{secret} = $secret
253			unless exists $self->{section}{global}{secret};
254			}
255
256			sub init {
257			my ($class, %kv) = @_;
258	root	1.11
259	root	1.1	my $file = exists $kv{file} ? $kv{file} : _file;
260
261			my $secret = AnyEvent::MCP::random_bytes 64;
262
263			File::Path::mkpath (File::Basename::dirname ($file), 0, 0700);
264
265			sysopen my $fh, $file, O_WRONLY \| O_CREAT \| O_EXCL, 0600
266			or die "$file: $!\n";
267
268			print {$fh} "[global]\nsecret = ", unpack ("H*", $secret), "\n"
269			or die "$file: $!\n";
270			close $fh or die "$file: $!\n";
271
272			$class->new (file => $file)
273			}
274
275	root	1.13	sub _prk_derive_secret($$@) {
276			my ($prk, $length, @info) = @_;
277
278			64 == length $prk
279			or die "derive_secret: key length must be 64 octets\n";
280			$length =~ /\A[0-9]+\z/ && $length <= 255 * 64
281			or die "derive_secret: length must be an integer in 0..16320\n";
282
283			my $info = pack "(N/a)", @info;
284			my $t = "";
285			my $okm = "";
286			my $i = 0;
287
288			while ($length > length $okm) {
289			$t = Digest::SHA::hmac_sha512 $t . $info . chr ++$i, $prk;
290			$okm .= $t;
291			}
292
293			substr $okm, 0, $length
294			}
295
296			sub derive_secret {
297			my ($self, $length, @info) = @_;
298
299			$self = $self->global unless ref $self;
300
301			my $secret = $self->{section}{global}{secret};
302			$secret =~ /\A[0-9a-fA-F]{128}\z/
303			or die "$self->{file}: missing or invalid secret\n";
304
305			_prk_derive_secret (pack ("H*", $secret), $length, @info)
306			}
307
308	root	1.1	sub credential {
309			my ($self, $purpose, $name, $username) = @_;
310
311			$username = "" unless defined $username;
312
313	root	1.11	$purpose eq "token"
314			or die "Unknown credential purpose '$purpose'\n";
315	root	1.1
316			my $credential = MIME::Base64::encode_base64 (
317	root	1.13	$self->derive_secret (
318			32, "AnyEvent::MCP credential v1", $purpose,
319			AnyEvent::MCP::utf8enc ($name), AnyEvent::MCP::utf8enc ($username)
320			), ""
321	root	1.1	);
322			$credential =~ y!+/=!-_!d;
323
324			$credential
325			}
326
327	root	1.4	sub server_name {
328			my ($name) = @_;
329
330			unless (defined $name) {
331			$name = File::Basename::basename ($0);
332			$name =~ s/\.(?:pl\|perl)\z//;
333			$name = "perl" if $name eq "-e";
334			}
335
336			$name =~ /\A[A-Za-z_][A-Za-z0-9_-]*\z/
337			or die "Invalid MCP server name '$name'\n";
338
339			$name
340			}
341
342			sub http_getopt {
343	root	1.5	my ($name, $bind, $print_url, $tokens) = @_;
344	root	1.4
345	root	1.5	"name=s" => $name, "bind=s" => $bind, "print-url" => $print_url, "token=s@" => $tokens
346	root	1.4	}
347
348			sub server_port {
349			my ($self, $name) = @_;
350
351			$name = server_name $name;
352
353	root	1.13	16384 + ((unpack "n", $self->derive_secret (2, "AnyEvent::MCP port v1", $name)) & 16383)
354	root	1.4	}
355
356			sub http_settings {
357			my ($self, $name, $bind) = @_;
358
359			$name = server_name $name;
360	root	1.10	my $settings = $self->{section}{"instance $name"} \|\| {};
361	root	1.4	my $port = $self->server_port ($name);
362			my $configured = $settings->{bind} // "127.0.0.1:$port";
363			$configured = "127.0.0.1$configured" if $configured =~ /\A:[0-9]+\z/;
364			my ($configured_host, $configured_port) = AnyEvent::Socket::parse_hostport $configured, $port;
365			defined $configured_host && defined $configured_port
366			&& $configured_port =~ /\A[0-9]+\z/ && $configured_port <= 65535
367			or die "Invalid MCP bind address '$configured'\n";
368
369			$bind = $configured unless defined $bind;
370			$bind = "127.0.0.1$bind" if $bind =~ /\A:[0-9]+\z/;
371
372			my ($host, $service) = AnyEvent::Socket::parse_hostport $bind, $configured_port;
373			defined $host && defined $service && $service =~ /\A[0-9]+\z/ && $service <= 65535
374			or die "Invalid MCP bind address '$bind'\n";
375
376			my %kv = (
377			(map { exists $settings->{$_} ? ($_ => $settings->{$_}) : () }
378	root	1.5	qw(path url_host url_scheme)),
379	root	1.4	name => $name,
380			host => $host,
381			port => $service,
382			);
383
384			unless (AnyEvent::Socket::parse_address $host) {
385			my ($error, @addresses) = Socket::getaddrinfo ($host, undef, { socktype => Socket::SOCK_STREAM () });
386			!$error && @addresses
387			or die "Cannot resolve MCP bind host '$host': $error\n";
388
389	root	1.9	my (undef, $address) = AnyEvent::Socket::unpack_sockaddr $addresses[0]{addr};
390	root	1.4
391			$kv{url_host} //= $host;
392	root	1.9	$kv{host} = AnyEvent::Socket::format_address $address;
393	root	1.4	}
394
395	root	1.11	$kv{tokens} = [exists $settings->{tokens}
396			? split /\s,\s/, $settings->{tokens}, -1
397			: $self->credential ("token", $name)];
398	root	1.4
399			%kv
400			}
401
402			sub http_url {
403			my ($self, $name, $bind, %options) = @_;
404
405	root	1.11	# only a derived token depends on the master secret surviving this process.
406	root	1.8	if (($options{auth} \|\| "") ne "none"
407			&& !exists $options{tokens}
408	root	1.10	&& !exists $self->{section}{"instance $name"}{tokens}) {
409	root	1.8	my $stored = ref ($self)->new (file => $self->{file});
410			$stored->{section}{global}{secret} eq $self->{section}{global}{secret}
411			or die "MCP master secret is not persistently stored in $self->{file}\n";
412			}
413	root	1.4
414			require AnyEvent::MCP::Server::HTTP;
415	root	1.8	my %http = $self->http_settings ($name, $bind);
416			delete $http{tokens} if ($options{auth} \|\| "") eq "none";
417	root	1.11
418			AnyEvent::MCP::Server::HTTP->new (%http, %options)->url
419	root	1.4	}
420
421	root	1.1
422			1