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. The invoked program basename,
instance name, optional username and credential purpose each contribute to
the result. Instances default to C<default>; different programs still derive
different credentials for that instance name.

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

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

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

=head1 METHODS

=over

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

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

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

Read a private INI file without creating or requiring an MCP master secret.
Settings before the first section are in C<< $config->{section}{global} >>.
Use this for stand-alone application configuration.

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Derives a 32-byte credential, returned as unpadded URL-safe Base64.
C<$purpose> is C<token>. C<$name> is the instance name, and C<$username>
is optional. The default server credential is derived with no username.

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. This derivation
replaces the older name-only context; 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 $program = AnyEvent::MCP::Config::program_name ()

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

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

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

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

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

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

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

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

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

=item $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 load {
   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
}

sub new {
   my $self = shift->load (@_);
   $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;

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

}

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

   substr $okm, 0, $length
}

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

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

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

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

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

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

   $name = "default" unless defined $name;

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

   $name
}

sub 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, "port", AnyEvent::MCP::utf8enc (program_name ()), AnyEvent::MCP::utf8enc ($name))) & 16383)
}

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

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

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

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

   my %kv = (
      (map { exists $settings->{$_} ? ($_ => $settings->{$_}) : () }
         qw(path url_host url_scheme)),
      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) = @_;

   $name = server_name $name;

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