| 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 |
$^X, "-Ilib", "-e", |
| 35 |
'unshift @INC, sub { die "WebSocket must not be loaded\n" if $_[1] =~ m{^AnyEvent/WebSocket/}; return }; do shift @ARGV; die $@ if $@;', |
| 36 |
"bin/mcp-vim", "--bind", "127.0.0.1:$port", ($use_env ? () : ("--stdio"))); |
| 37 |
my $old = select $in; |
| 38 |
$| = 1; |
| 39 |
select $old; |
| 40 |
($pid, $in, $out, $err, $port) |
| 41 |
} |
| 42 |
|
| 43 |
sub rpc { |
| 44 |
my ($in, $out, $id, $method, $params) = @_; |
| 45 |
print {$in} JSON::XS::encode_json ({ |
| 46 |
jsonrpc => "2.0", id => $id, method => $method, params => $params, |
| 47 |
}), "\n" or die "cannot send JSONL test request: $!"; |
| 48 |
return unless IO::Select->new ($out)->can_read (30); |
| 49 |
my $line = <$out>; |
| 50 |
return unless defined $line; |
| 51 |
eval { JSON::XS::decode_json $line } |
| 52 |
} |
| 53 |
|
| 54 |
sub wait_exit { |
| 55 |
my ($pid) = @_; |
| 56 |
for (1 .. 1500) { |
| 57 |
my $w = waitpid ($pid, WNOHANG); |
| 58 |
return $? >> 8 if $w == $pid; |
| 59 |
Time::HiRes::sleep (0.02); |
| 60 |
} |
| 61 |
kill TERM => $pid; |
| 62 |
waitpid ($pid, 0); |
| 63 |
-1 |
| 64 |
} |
| 65 |
|
| 66 |
for my $use_env (0, 1) { |
| 67 |
my $kind = $use_env ? "multibroker environment" : "explicit --stdio"; |
| 68 |
my ($pid, $in, $out, $err, $port) = start_child ($use_env); |
| 69 |
|
| 70 |
my $init = rpc ($in, $out, 1, "initialize", { |
| 71 |
protocolVersion => "2025-11-25", |
| 72 |
capabilities => {}, clientInfo => { name => "stdio-test", version => "0" }, |
| 73 |
}); |
| 74 |
|
| 75 |
is $init->{id}, 1, "$kind: JSONL initialize response"; |
| 76 |
ok !$init->{error} && $init->{result}{serverInfo}, |
| 77 |
"$kind: valid MCP server metadata"; |
| 78 |
|
| 79 |
my $tools = rpc ($in, $out, 2, "tools/list", {}); |
| 80 |
is $tools->{id}, 2, "$kind: JSONL tools/list response"; |
| 81 |
is_deeply [sort map $_->{name}, @{$tools->{result}{tools} || []}], |
| 82 |
[sort qw(targets state open read-lines grep apply-diff substitute undo redo save set-cursor ex meta-instructions)], |
| 83 |
"$kind: exposes thirteen unprefixed Vim tools including metadata"; |
| 84 |
my ($substitute) = grep $_->{name} eq "substitute", @{$tools->{result}{tools} || []}; |
| 85 |
ok defined $substitute && index ($substitute->{description}, q{\%^\_.*\%$}) >= 0, |
| 86 |
"$kind: substitute description preserves Vim regex backslashes and end anchor"; |
| 87 |
ok !$tools->{error}, |
| 88 |
"$kind: tools/list returned without an error"; |
| 89 |
|
| 90 |
# The stdio transport must not prevent the normal Vim/browser TCP listener. |
| 91 |
my $sock; |
| 92 |
for (1 .. 1500) { |
| 93 |
$sock = IO::Socket::INET->new ( |
| 94 |
PeerAddr => "127.0.0.1", PeerPort => $port, |
| 95 |
Proto => "tcp", Timeout => 1, |
| 96 |
); |
| 97 |
last if $sock; |
| 98 |
Time::HiRes::sleep (0.02); |
| 99 |
} |
| 100 |
ok $sock, "$kind: TCP listener remains available"; |
| 101 |
if ($sock) { |
| 102 |
$sock->autoflush (1); |
| 103 |
print {$sock} |
| 104 |
"POST / HTTP/1.1\r\nHost: localhost\r\n" |
| 105 |
. "Content-Type: application/json\r\nContent-Length: 2\r\n\r\n{}"; |
| 106 |
my $response = IO::Select->new ($sock)->can_read (30) ? <$sock> : undef; |
| 107 |
like $response, qr{\AHTTP/1\.1 401\b}, |
| 108 |
"$kind: TCP listener still serves authenticated MCP HTTP"; |
| 109 |
close $sock; |
| 110 |
} else { |
| 111 |
fail "$kind: HTTP listener response"; |
| 112 |
} |
| 113 |
|
| 114 |
close $in; |
| 115 |
is wait_exit ($pid), 0, "$kind: stdin EOF stops the child cleanly"; |
| 116 |
my $extra = <$out>; |
| 117 |
ok !defined $extra, "$kind: no extraneous stdout after final MCP response"; |
| 118 |
close $out; |
| 119 |
close $err; |
| 120 |
} |
| 121 |
|
| 122 |
done_testing; |
