view release on metacpan or  search on metacpan

t/15_getoptions.t  view on Meta::CPAN

($status, $out, $err) = command ('mcp_getoptions;', "--set", "invalid");
ok $status && $err =~ /Invalid --set KEY=VALUE/,
   "--set rejects a missing equals sign";
($status, $out, $err) = command ('mcp_getoptions;', "-s", "invalid key=value");
ok $status && $err =~ /Invalid --set KEY=VALUE/,
   "-s rejects whitespace in configuration keys";

open $fh, ">>", "$dir/anyevent-mcp/global.ini" or die $!;
print {$fh} "\n[instance secured]\ntls_cert = cert.pem\n";
close $fh or die $!;
($status, $out, $err) = command ('mcp_getoptions;', "--name", "secured",
   "--bind", ":31740", "--token", "static", "--print-url");
is $status, 0, "named TLS URL discovery succeeds";
is $out, "https://127.0.0.1:31740/static/\nhttp://127.0.0.1:31740/static/\n",
   "named TLS certificate selects dual URLs";
is $err, "", "named TLS URL discovery has no diagnostics";

open $fh, ">>", "$dir/anyevent-mcp/global.ini" or die $!;
print {$fh} "\n[program perl]\ncustom_instructions = Program purpose\n"
   . "[instance named]\ncustom_instructions = Instance purpose\n";
close $fh or die $!;

my $probe = 'mcp_config instructions => "Operating rules", short_instructions => "Discover tools"; '
   . 'my $options = mcp_getoptions; '
   . 'mcp_start %$options, auth => "none", port => 0, on_start => sub { '
   . 'print $_[0]{instructions}, "\\n"; $_[0]->close };';
($status, $out, $err) = command ($probe, "--name", "other");
is $status, 0, "program-level custom instructions start";
my $hint = "\n\nFull instructions: meta-instructions tool description.\n";
is $out, "Program purpose\n\nDiscover tools$hint", "program-level purpose advertised";
($status, $out, $err) = command ($probe, "--name", "named");
is $status, 0, "instance-level custom instructions start";
is $out, "Instance purpose\n\nDiscover tools$hint", "instance setting overrides program setting";
($status, $out, $err) = command ($probe, "--name", "named", "--custom-instructions", "CLI purpose");
is $status, 0, "CLI custom instructions start";
is $out, "CLI purpose\n\nDiscover tools$hint", "CLI purpose overrides instance setting";

for my $bad (
   {},
   { tokens => [] },
   { tokens => ["good", "bad/token"] },
   { auth => "unknown" },
   { auth => "none", tokens => ["x"] },
) {
   eval { AnyEvent::MCP::Server::HTTP->new (%$bad) };
   ok $@, "insecure or invalid constructor rejected";
}

my $open = AnyEvent::MCP::Server::HTTP->new (port => 31740, auth => "none");
is $open->{auth}, "none", "unauthenticated HTTP requires explicit opt-out";
is $open->url, "http://127.0.0.1:31740/mcp/", "unauthenticated URL has no secret segment";

my $secured = AnyEvent::MCP::Server::HTTP->new (port => 31740, tokens => ["first", "second"]);
is $secured->url, "http://127.0.0.1:31740/first/mcp/", "first token advertised";
is $secured->url (0), "http://127.0.0.1:31740/mcp/", "clean URL available";

is $config->http_url ("demo", ":31740", path => "/", auth => "none"),
   "http://127.0.0.1:31740/", "explicit unauthenticated URL contains no token";

my %http = $config->http_settings ("demo");
is $config->user_credentials ("demo")->[0][2], $http{tokens}[0],
   "derived default uses token HKDF purpose";

my $unstable = AnyEvent::MCP::Config->new (file => "$dir/anyevent-mcp/global.ini");
my $first = substr $unstable->{section}{global}{secret}, 0, 1;
substr ($unstable->{section}{global}{secret}, 0, 1) = $first eq "0" ? "1" : "0";
eval { $unstable->http_url ("demo", ":31740", path => "/") };
like $@, qr/not persistently stored/, "derived URL refuses an unstable master secret";
is $unstable->http_url ("demo", ":31740", path => "/", tokens => ["fixed"]),
   "http://127.0.0.1:31740/fixed/", "static token URL does not need persistent HKDF secret";

my ($started, $mode);
{
   open my $fh, ">>", "$dir/anyevent-mcp/global.ini" or die $!;
   print {$fh} <<'INI';

[program perl]
auto-rule.30 = deny *,exec,*
auto-rule.10 = allow *,read,workdir-read
auto-rule.20 = allow *,write,workdir-write

[instance named]
auto-rule.20 = deny *,write,workdir-write
auto-rule.30 =
auto-rule.40 = allow tabs
INI
   close $fh or die $!;
   local $0 = "perl"; # match the -e program name used by the child probes.
   my $configured = AnyEvent::MCP::Config->new (file => "$dir/anyevent-mcp/global.ini");
   is_deeply [$configured->auto_rules ("other")], [
      ["allow", "*,read,workdir-read"],
      ["allow", "*,write,workdir-write"],
      ["deny", "*,exec,*"],
   ], "program-level permission rules sorted by key";
   is_deeply [$configured->auto_rules ("named")], [
      ["allow", "*,read,workdir-read"],
      ["deny", "*,write,workdir-write"],
      ["allow", "tabs"],
   ], "instance overrides, removes, and adds inherited permission rules";
   $configured->{section}{"instance named"}{"auto-rule.40"} = "bad";
   eval { $configured->auto_rules ("named") };
   like $@, qr/Invalid configured automatic permission rule/, "invalid configured rule rejected";
}

my $auto_probe = q{
   require AnyEvent::MCP::Server::Permissions;
   my $options = mcp_getoptions;
   my $p = AnyEvent::MCP::Server::Permissions->new (
      sandbox_grants => {
         "workdir-read" => [],
         "workdir-write" => ["workdir-read"],
      },
   );
   mcp_start %$options, permissions => $p, auth => "none", port => 0, on_start => sub {
      print join (" ", map {
         $p->check ({ action => $_->[0], sandbox_grants => $_->[1], reason => "test" }, $_->[2])->{decision}
      } (["read", ["workdir-write"], "x"], ["write", ["workdir-write"], "x"],
         ["exec", [], "x"], ["inspect", [], "tabs"])), "\n";
      $_[0]->close;
   };
};