| 1 |
root |
1.1 |
use common::sense; |
| 2 |
|
|
use Test::More; |
| 3 |
|
|
use JSON::XS (); |
| 4 |
|
|
use IPC::Open3 (); |
| 5 |
|
|
use IO::Select (); |
| 6 |
|
|
use IO::Socket::INET (); |
| 7 |
|
|
use POSIX qw(WNOHANG); |
| 8 |
|
|
use Time::HiRes (); |
| 9 |
|
|
use File::Temp (); |
| 10 |
|
|
use File::Path (); |
| 11 |
|
|
use Symbol (); |
| 12 |
|
|
|
| 13 |
|
|
my $dir = File::Temp::tempdir (CLEANUP => 1); |
| 14 |
|
|
File::Path::mkpath (["$dir/home", "$dir/config"], 0, 0700); |
| 15 |
|
|
local $ENV{HOME} = "$dir/home"; |
| 16 |
|
|
local $ENV{XDG_CONFIG_HOME} = "$dir/config"; |
| 17 |
|
|
|
| 18 |
|
|
sub free_port { |
| 19 |
|
|
my $socket = IO::Socket::INET->new ( |
| 20 |
|
|
LocalAddr => "127.0.0.1", LocalPort => 0, |
| 21 |
|
|
Proto => "tcp", Listen => 1, |
| 22 |
|
|
) or die "cannot allocate TCP test port: $!"; |
| 23 |
|
|
my $port = $socket->sockport; |
| 24 |
|
|
close $socket; |
| 25 |
|
|
$port |
| 26 |
|
|
} |
| 27 |
|
|
|
| 28 |
|
|
sub start_child { |
| 29 |
|
|
my ($use_env) = @_; |
| 30 |
|
|
my $port = free_port; |
| 31 |
|
|
local $ENV{PERL_ANYEVENT_MCP_MULTIBROKER_PROTOCOL} = $use_env ? "stdio" : ""; |
| 32 |
|
|
my $err = Symbol::gensym; |
| 33 |
|
|
my $pid = IPC::Open3::open3 (my $in, my $out, $err, |
| 34 |
root |
1.2 |
$^X, "-Ilib", "bin/mcp-vim", "--bind", "127.0.0.1:$port", ($use_env ? () : ("--stdio"))); |
| 35 |
root |
1.1 |
my $old = select $in; |
| 36 |
|
|
$| = 1; |
| 37 |
|
|
select $old; |
| 38 |
|
|
($pid, $in, $out, $err, $port) |
| 39 |
|
|
} |
| 40 |
|
|
|
| 41 |
|
|
sub rpc { |
| 42 |
|
|
my ($in, $out, $id, $method, $params) = @_; |
| 43 |
|
|
print {$in} JSON::XS::encode_json ({ |
| 44 |
|
|
jsonrpc => "2.0", id => $id, method => $method, params => $params, |
| 45 |
|
|
}), "\n" or die "cannot send JSONL test request: $!"; |
| 46 |
|
|
return unless IO::Select->new ($out)->can_read (5); |
| 47 |
|
|
my $line = <$out>; |
| 48 |
|
|
return unless defined $line; |
| 49 |
|
|
eval { JSON::XS::decode_json $line } |
| 50 |
|
|
} |
| 51 |
|
|
|
| 52 |
|
|
sub wait_exit { |
| 53 |
|
|
my ($pid) = @_; |
| 54 |
|
|
for (1 .. 150) { |
| 55 |
|
|
my $w = waitpid ($pid, WNOHANG); |
| 56 |
|
|
return $? >> 8 if $w == $pid; |
| 57 |
|
|
Time::HiRes::sleep (0.02); |
| 58 |
|
|
} |
| 59 |
|
|
kill TERM => $pid; |
| 60 |
|
|
waitpid ($pid, 0); |
| 61 |
|
|
-1 |
| 62 |
|
|
} |
| 63 |
|
|
|
| 64 |
|
|
for my $use_env (0, 1) { |
| 65 |
|
|
my $kind = $use_env ? "multibroker environment" : "explicit --stdio"; |
| 66 |
|
|
my ($pid, $in, $out, $err, $port) = start_child ($use_env); |
| 67 |
|
|
|
| 68 |
|
|
my $init = rpc ($in, $out, 1, "initialize", { |
| 69 |
|
|
protocolVersion => "2025-11-25", |
| 70 |
|
|
capabilities => {}, clientInfo => { name => "stdio-test", version => "0" }, |
| 71 |
|
|
}); |
| 72 |
|
|
|
| 73 |
|
|
is $init->{id}, 1, "$kind: JSONL initialize response"; |
| 74 |
|
|
ok !$init->{error} && $init->{result}{serverInfo}, |
| 75 |
|
|
"$kind: valid MCP server metadata"; |
| 76 |
|
|
|
| 77 |
|
|
my $tools = rpc ($in, $out, 2, "tools/list", {}); |
| 78 |
|
|
is $tools->{id}, 2, "$kind: JSONL tools/list response"; |
| 79 |
root |
1.3 |
is_deeply [sort map $_->{name}, @{$tools->{result}{tools} || []}], |
| 80 |
|
|
[sort qw(targets state read-lines grep apply-diff substitute set-cursor)], |
| 81 |
|
|
"$kind: exposes exactly the seven unprefixed Vim tools"; |
| 82 |
root |
1.4 |
my ($substitute) = grep $_->{name} eq "substitute", @{$tools->{result}{tools} || []}; |
| 83 |
|
|
ok defined $substitute && index ($substitute->{description}, q{\%^\_.*\%$}) >= 0, |
| 84 |
|
|
"$kind: substitute description preserves Vim regex backslashes and end anchor"; |
| 85 |
root |
1.3 |
ok !$tools->{error}, |
| 86 |
|
|
"$kind: tools/list returned without an error"; |
| 87 |
root |
1.1 |
|
| 88 |
|
|
# The stdio transport must not prevent the normal Vim/browser TCP listener. |
| 89 |
|
|
my $sock; |
| 90 |
|
|
for (1 .. 25) { |
| 91 |
|
|
$sock = IO::Socket::INET->new ( |
| 92 |
|
|
PeerAddr => "127.0.0.1", PeerPort => $port, |
| 93 |
|
|
Proto => "tcp", Timeout => 1, |
| 94 |
|
|
); |
| 95 |
|
|
last if $sock; |
| 96 |
|
|
Time::HiRes::sleep (0.02); |
| 97 |
|
|
} |
| 98 |
|
|
ok $sock, "$kind: TCP listener remains available"; |
| 99 |
|
|
if ($sock) { |
| 100 |
|
|
$sock->autoflush (1); |
| 101 |
|
|
print {$sock} |
| 102 |
|
|
"POST / HTTP/1.1\r\nHost: localhost\r\n" |
| 103 |
|
|
. "Content-Type: application/json\r\nContent-Length: 2\r\n\r\n{}"; |
| 104 |
|
|
my $response = IO::Select->new ($sock)->can_read (3) ? <$sock> : undef; |
| 105 |
|
|
like $response, qr{\AHTTP/1\.1 401\b}, |
| 106 |
|
|
"$kind: TCP listener still serves authenticated MCP HTTP"; |
| 107 |
|
|
close $sock; |
| 108 |
|
|
} else { |
| 109 |
|
|
fail "$kind: HTTP listener response"; |
| 110 |
|
|
} |
| 111 |
|
|
|
| 112 |
|
|
close $in; |
| 113 |
|
|
is wait_exit ($pid), 0, "$kind: stdin EOF stops the child cleanly"; |
| 114 |
|
|
my $extra = <$out>; |
| 115 |
|
|
ok !defined $extra, "$kind: no extraneous stdout after final MCP response"; |
| 116 |
|
|
close $out; |
| 117 |
|
|
close $err; |
| 118 |
|
|
} |
| 119 |
|
|
|
| 120 |
|
|
done_testing; |
