AnyEvent-MCP/t/16_vim_auth.t

use common::sense;
use Test::More;
use JSON::XS ();
use IO::Socket::INET ();
use IO::Select ();
use Protocol::WebSocket::Frame ();
use IPC::Open3 ();
use POSIX qw(WNOHANG);
use Time::HiRes ();
use File::Temp ();
use File::Path ();
use Symbol ();

my $dir = File::Temp::tempdir (CLEANUP => 1);
File::Path::mkpath (["$dir/home", "$dir/config"], 0, 0700);
local $ENV{HOME} = "$dir/home";
local $ENV{XDG_CONFIG_HOME} = "$dir/config";

my $listener = IO::Socket::INET->new (
   LocalAddr => "127.0.0.1", LocalPort => 0, Proto => "tcp", Listen => 1,
) or die "allocate TCP test port: $!";
my $port = $listener->sockport;
close $listener;

my $err = Symbol::gensym;
local $ENV{PERL_ANYEVENT_VERBOSE} = 6; # include notice-level rejection logs
my $pid = IPC::Open3::open3 (my $in, my $out, $err, $^X, "-Ilib",
   "bin/mcp-vim", "--stdio", "--bind", "127.0.0.1:$port",
   "--token", "primary", "--token", "secondary");
my $old = select $in;
$| = 1;
select $old;

sub tcp {
   IO::Socket::INET->new (
      PeerAddr => "127.0.0.1", PeerPort => $port,
      Proto => "tcp", Timeout => 1,
   )
}

my $ready;
for (1 .. 60) {
   $ready = tcp ();
   last if $ready;
   Time::HiRes::sleep (0.03);
}
ok $ready, "mcp-vim listens on TCP with two static tokens";
close $ready if $ready;

sub rpc {
   my ($id, $method, $params) = @_;
   print {$in} JSON::XS::encode_json ({
      jsonrpc => "2.0", id => $id, method => $method, params => $params,
   }), "\n" or die "send JSONL request: $!";
   IO::Select->new ($out)->can_read (3) or die "MCP stdio response timed out";
   my $line = <$out> // die "unexpected MCP stdio EOF";
   JSON::XS::decode_json $line
}

sub target_names {
   my $r = rpc (++$main::request_id, "tools/call",
      { name => "targets", arguments => {} });
   return [] unless $r->{result}{content}[0]{text};
   JSON::XS::decode_json $r->{result}{content}[0]{text}
}

sub vim_connect {
   my ($token, $target) = @_;
   my $sock = tcp () or die "connect private Vim TCP: $!";
   my $hello = JSON::XS::encode_json ([0, [
      "mcp-vim-connect", 1, 0, $token, $target, "test-$target",
   ]]);
   print {$sock} $hello or die "send private Vim hello: $!";
   $sock
}

sub upgrade {
   my ($token, $path) = @_;
   my $sock = tcp () or die "connect browser WS TCP: $!";
   $sock->autoflush (1);
   $path //= "/$token/http://page.example:818";
   my $req = "GET $path HTTP/1.1\r\n"
      . "Host: 127.0.0.1:$port\r\n"
      . "Upgrade: websocket\r\nConnection: Upgrade\r\n"
      . "Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==\r\n"
      . "Sec-WebSocket-Version: 13\r\n"
      . "Origin: http://page.example:818\r\n\r\n";
   print {$sock} $req or die "send WebSocket upgrade: $!";

   my $bytes = "";
   my $deadline = Time::HiRes::time () + 2;
   while ($bytes !~ /\r\n\r\n/ && Time::HiRes::time () < $deadline) {
      last unless IO::Select->new ($sock)->can_read (0.2);
      my $n = sysread $sock, my $chunk, 4096;
      last unless $n;
      $bytes .= $chunk;
   }

   my ($headers, $frames) = split /\r\n\r\n/, $bytes, 2;
   ($sock, $headers // "", $frames // "")
}

sub ws_close_code {
   my ($sock, $initial) = @_;
   my $frame = Protocol::WebSocket::Frame->new;
   $frame->append ($initial) if length $initial;
   my $deadline = Time::HiRes::time () + 3;
   while (Time::HiRes::time () < $deadline) {
      while (defined (my $payload = $frame->next_bytes)) {
         return unpack ("n", $payload) if $frame->opcode == 8 && length ($payload) >= 2;
      }
      next unless IO::Select->new ($sock)->can_read (0.2);
      my $n = sysread $sock, my $bytes, 8192;
      last unless $n;
      $frame->append ($bytes);
   }
   undef
}

my $init = rpc (1, "initialize", {
   protocolVersion => "2025-11-25", capabilities => {},
   clientInfo => { name => "auth-test", version => "0" },
});
ok !$init->{error} && $init->{result}{serverInfo},
   "stdio control channel initialized";
is $init->{result}{serverInfo}{name}, "mcp-vim", "stdio reports mcp-vim as its identity";
like $init->{result}{instructions}, qr/live Vim editors and buffers/,
   "stdio gives MCP clients live-buffer guidance";
unlike JSON::XS::encode_json ($init->{result}), qr/xpcse/i,
   "stdio initialization does not expose the legacy browser name";

my $discover = rpc (2, "server/discover", {});
is $discover->{result}{instructions}, $init->{result}{instructions},
   "discovery gives the same Vim instructions as initialize";

{
   my $http = tcp () or die "connect MCP HTTP: $!";
   my $body = JSON::XS::encode_json ({
      jsonrpc => "2.0", id => 3, method => "initialize",
      params => {
         protocolVersion => "2025-11-25", capabilities => {},
         clientInfo => { name => "auth-test", version => "0" },
      },
   });
   print {$http} "POST / HTTP/1.1\r\n",
      "Host: 127.0.0.1:$port\r\n",
      "Authorization: Bearer primary\r\n",
      "Content-Type: application/json\r\n",
      "Content-Length: ", length $body, "\r\n\r\n", $body
      or die "send MCP HTTP request: $!";
   local $/;
   my $response = <$http> // "";
   close $http;
   my ($headers, $json) = split /\r\n\r\n/, $response, 2;
   like $headers, qr{\AHTTP/1\.1 200\b}, "HTTP initialization succeeds";
   my $result = eval { JSON::XS::decode_json $json };
   is $result->{result}{serverInfo}{name}, "mcp-vim", "HTTP reports mcp-vim as its identity";
   is $result->{result}{instructions}, $init->{result}{instructions},
      "HTTP gives the same Vim instructions as stdio";
}

my $bad = vim_connect ("unknown", "bad-vim");
my $before = target_names ();
ok !grep ($_ eq "bad-vim", @$before), "unknown private Vim token cannot register a target";
close $bad;

my $valid = vim_connect ("secondary", "secondary-vim");
my $visible;
for (1 .. 35) {
   my $names = target_names ();
   $visible = grep $_ eq "secondary-vim", @$names;
   last if $visible;
   Time::HiRes::sleep (0.03);
}
ok $visible, "secondary token authenticates private Vim handshake";

# A private Vim RPC supplying disjoint ranges must yield a separate
# [range=...] metadata text entry and an unchanged lines text entry for each.
print {$in} JSON::XS::encode_json ({
   jsonrpc => "2.0", id => 180, method => "tools/call",
   params => { name => "read-lines", arguments => {
      target => "secondary-vim", buffer => 1, ranges => ["727,728", "985,986"],
   } },
}), "\n" or die "send Vim read-lines request: $!";

my $wire = "";
my $vim_call;
for (1 .. 15) {
   IO::Select->new ($valid)->can_read (0.3)
      or next;
   my $n = sysread $valid, my $fragment, 8192;
   last unless $n;
   $wire .= $fragment;
   $vim_call = eval { JSON::XS::decode_json $wire };
   last if $vim_call;
}
ok $vim_call && $vim_call->[1][0] eq "call"
   && $vim_call->[1][2] eq "read_lines",
   "read-lines delegates disjoint ranges to the private Vim RPC";
if ($vim_call) {
   $valid->autoflush (1);
   print {$valid} JSON::XS::encode_json ([0, [
      reply => $vim_call->[1][1], 1, {
         changedtick => 7,
         ranges => [
            { range => "727,728", start => 727, end => 728, lines => ["function alpha () {", "   return a;"] },
            { range => "985,986", start => 985, end => 986, lines => ["function beta () {", "   return b;"] },
         ],
      },
   ]]) or die "send mock Vim RPC reply: $!";
}
IO::Select->new ($out)->can_read (5) or die "read-lines MCP reply timeout";
my $lines_reply = JSON::XS::decode_json (scalar <$out>);
my $blocks = $lines_reply->{result}{content} || [];
is @{$blocks}, 5, "Vim returns initial metadata plus two text entries per requested range";
is_deeply [map $_->{type}, @$blocks], [("text") x 5],
   "all Vim metadata and source blocks remain MCP text entries";
is_deeply JSON::XS::decode_json ($blocks->[0]{text}), {
   changedtick => 7,
   ranges => [
      { range => "727,728", start => 727, end => 728 },
      { range => "985,986", start => 985, end => 986 },
   ],
}, "Vim changedtick and resolved range metadata remain available";
is_deeply [map $_->{text}, @{$blocks}[1..4]], [
   "[range=727,728]",
   "function alpha () {\n   return a;\n",
   "[range=985,986]",
   "function beta () {\n   return b;\n",
], "each Vim range has visible standalone metadata and unchanged newline-terminated source";


my ($invalid_ws, $invalid_headers) = upgrade ("secret-do-not-log-XYZ");
unlike $invalid_headers, qr{\AHTTP/1\.[01] 101\b},
   "unknown WebSocket URL token does not upgrade";
close $invalid_ws;

my ($malformed_ws, $malformed_headers) = upgrade ("secondary", "/secondary/");
unlike $malformed_headers, qr{\AHTTP/1\.[01] 101\b},
   "malformed WebSocket URL rejected even when it contains a valid token";
close $malformed_ws;

for my $kind (qw(xpcse-client ypcse-client)) {
   my ($sock, $headers, $pending) = upgrade ("secondary");
   like $headers, qr{\AHTTP/1\.1 101\b},
      "secondary token authenticates $kind WebSocket handshake";
   if ($headers =~ /\AHTTP\/1\.1 101\b/) {
      my $payload = JSON::XS::encode_json ([$kind, 99]);
      my $frame = Protocol::WebSocket::Frame->new (
         type => "text", masked => 1, buffer => $payload,
      );
      print {$sock} $frame->to_bytes or die "send $kind mismatch: $!";
      is ws_close_code ($sock, $pending), 1002,
         "$kind version mismatch triggers protocol-error close";
   } else {
      fail "$kind version mismatch closes connection";
   }
   close $sock;
}

close $valid;
close $in;
my $exit;
for (1 .. 120) {
   my $w = waitpid ($pid, WNOHANG);
   if ($w == $pid) {
      $exit = $? >> 8;
      last;
   }
   Time::HiRes::sleep (0.025);
}
if (!defined $exit) {
   kill TERM => $pid;
   waitpid ($pid, 0);
   $exit = -1;
}
is $exit, 0, "broker exits after stdio EOF";
close $out;
local $/;
my $log = <$err> // "";
like $log, qr/illegal websocket connect from 127\.0\.0\.1:\d+/,
   "rejected websocket handshake logs the numeric TCP peer and port";
unlike $log, qr/secret-do-not-log-XYZ|\/secondary\//,
   "rejected URL never exposes supplied credentials in the log";
close $err;

done_testing;
Revision:	1.6
Committed:	Mon Oct 12 09:28:11 2026 UTC (2 weeks, 5 days ago) by root
Content type:	application/x-troff
Branch:	MAIN
Changes since 1.5:	+11 -7 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	use common::sense;
2			use Test::More;
3			use JSON::XS ();
4			use IO::Socket::INET ();
5			use IO::Select ();
6			use Protocol::WebSocket::Frame ();
7			use IPC::Open3 ();
8			use POSIX qw(WNOHANG);
9			use Time::HiRes ();
10			use File::Temp ();
11			use File::Path ();
12			use Symbol ();
13
14			my $dir = File::Temp::tempdir (CLEANUP => 1);
15			File::Path::mkpath (["$dir/home", "$dir/config"], 0, 0700);
16			local $ENV{HOME} = "$dir/home";
17			local $ENV{XDG_CONFIG_HOME} = "$dir/config";
18
19			my $listener = IO::Socket::INET->new (
20			LocalAddr => "127.0.0.1", LocalPort => 0, Proto => "tcp", Listen => 1,
21			) or die "allocate TCP test port: $!";
22			my $port = $listener->sockport;
23			close $listener;
24
25			my $err = Symbol::gensym;
26	root	1.2	local $ENV{PERL_ANYEVENT_VERBOSE} = 6; # include notice-level rejection logs
27	root	1.1	my $pid = IPC::Open3::open3 (my $in, my $out, $err, $^X, "-Ilib",
28			"bin/mcp-vim", "--stdio", "--bind", "127.0.0.1:$port",
29			"--token", "primary", "--token", "secondary");
30			my $old = select $in;
31			$\| = 1;
32			select $old;
33
34			sub tcp {
35			IO::Socket::INET->new (
36			PeerAddr => "127.0.0.1", PeerPort => $port,
37			Proto => "tcp", Timeout => 1,
38			)
39			}
40
41			my $ready;
42			for (1 .. 60) {
43			$ready = tcp ();
44			last if $ready;
45			Time::HiRes::sleep (0.03);
46			}
47			ok $ready, "mcp-vim listens on TCP with two static tokens";
48			close $ready if $ready;
49
50			sub rpc {
51			my ($id, $method, $params) = @_;
52			print {$in} JSON::XS::encode_json ({
53			jsonrpc => "2.0", id => $id, method => $method, params => $params,
54			}), "\n" or die "send JSONL request: $!";
55			IO::Select->new ($out)->can_read (3) or die "MCP stdio response timed out";
56			my $line = <$out> // die "unexpected MCP stdio EOF";
57			JSON::XS::decode_json $line
58			}
59
60			sub target_names {
61			my $r = rpc (++$main::request_id, "tools/call",
62	root	1.3	{ name => "targets", arguments => {} });
63	root	1.1	return [] unless $r->{result}{content}[0]{text};
64			JSON::XS::decode_json $r->{result}{content}[0]{text}
65			}
66
67			sub vim_connect {
68			my ($token, $target) = @_;
69			my $sock = tcp () or die "connect private Vim TCP: $!";
70			my $hello = JSON::XS::encode_json ([0, [
71			"mcp-vim-connect", 1, 0, $token, $target, "test-$target",
72			]]);
73			print {$sock} $hello or die "send private Vim hello: $!";
74			$sock
75			}
76
77			sub upgrade {
78	root	1.2	my ($token, $path) = @_;
79	root	1.1	my $sock = tcp () or die "connect browser WS TCP: $!";
80			$sock->autoflush (1);
81	root	1.2	$path //= "/$token/http://page.example:818";
82			my $req = "GET $path HTTP/1.1\r\n"
83	root	1.1	. "Host: 127.0.0.1:$port\r\n"
84			. "Upgrade: websocket\r\nConnection: Upgrade\r\n"
85			. "Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==\r\n"
86			. "Sec-WebSocket-Version: 13\r\n"
87			. "Origin: http://page.example:818\r\n\r\n";
88			print {$sock} $req or die "send WebSocket upgrade: $!";
89
90			my $bytes = "";
91			my $deadline = Time::HiRes::time () + 2;
92			while ($bytes !~ /\r\n\r\n/ && Time::HiRes::time () < $deadline) {
93			last unless IO::Select->new ($sock)->can_read (0.2);
94			my $n = sysread $sock, my $chunk, 4096;
95			last unless $n;
96			$bytes .= $chunk;
97			}
98
99			my ($headers, $frames) = split /\r\n\r\n/, $bytes, 2;
100			($sock, $headers // "", $frames // "")
101			}
102
103			sub ws_close_code {
104			my ($sock, $initial) = @_;
105			my $frame = Protocol::WebSocket::Frame->new;
106			$frame->append ($initial) if length $initial;
107			my $deadline = Time::HiRes::time () + 3;
108			while (Time::HiRes::time () < $deadline) {
109			while (defined (my $payload = $frame->next_bytes)) {
110			return unpack ("n", $payload) if $frame->opcode == 8 && length ($payload) >= 2;
111			}
112			next unless IO::Select->new ($sock)->can_read (0.2);
113			my $n = sysread $sock, my $bytes, 8192;
114			last unless $n;
115			$frame->append ($bytes);
116			}
117			undef
118			}
119
120			my $init = rpc (1, "initialize", {
121			protocolVersion => "2025-11-25", capabilities => {},
122			clientInfo => { name => "auth-test", version => "0" },
123			});
124			ok !$init->{error} && $init->{result}{serverInfo},
125			"stdio control channel initialized";
126	root	1.4	is $init->{result}{serverInfo}{name}, "mcp-vim", "stdio reports mcp-vim as its identity";
127			like $init->{result}{instructions}, qr/live Vim editors and buffers/,
128			"stdio gives MCP clients live-buffer guidance";
129			unlike JSON::XS::encode_json ($init->{result}), qr/xpcse/i,
130			"stdio initialization does not expose the legacy browser name";
131
132			my $discover = rpc (2, "server/discover", {});
133			is $discover->{result}{instructions}, $init->{result}{instructions},
134			"discovery gives the same Vim instructions as initialize";
135
136			{
137			my $http = tcp () or die "connect MCP HTTP: $!";
138			my $body = JSON::XS::encode_json ({
139			jsonrpc => "2.0", id => 3, method => "initialize",
140			params => {
141			protocolVersion => "2025-11-25", capabilities => {},
142			clientInfo => { name => "auth-test", version => "0" },
143			},
144			});
145			print {$http} "POST / HTTP/1.1\r\n",
146			"Host: 127.0.0.1:$port\r\n",
147			"Authorization: Bearer primary\r\n",
148			"Content-Type: application/json\r\n",
149			"Content-Length: ", length $body, "\r\n\r\n", $body
150			or die "send MCP HTTP request: $!";
151			local $/;
152			my $response = <$http> // "";
153			close $http;
154			my ($headers, $json) = split /\r\n\r\n/, $response, 2;
155			like $headers, qr{\AHTTP/1\.1 200\b}, "HTTP initialization succeeds";
156			my $result = eval { JSON::XS::decode_json $json };
157			is $result->{result}{serverInfo}{name}, "mcp-vim", "HTTP reports mcp-vim as its identity";
158			is $result->{result}{instructions}, $init->{result}{instructions},
159			"HTTP gives the same Vim instructions as stdio";
160			}
161	root	1.1
162			my $bad = vim_connect ("unknown", "bad-vim");
163			my $before = target_names ();
164			ok !grep ($_ eq "bad-vim", @$before), "unknown private Vim token cannot register a target";
165			close $bad;
166
167			my $valid = vim_connect ("secondary", "secondary-vim");
168			my $visible;
169			for (1 .. 35) {
170			my $names = target_names ();
171			$visible = grep $_ eq "secondary-vim", @$names;
172			last if $visible;
173			Time::HiRes::sleep (0.03);
174			}
175			ok $visible, "secondary token authenticates private Vim handshake";
176
177	root	1.6	# A private Vim RPC supplying disjoint ranges must yield a separate
178			# [range=...] metadata text entry and an unchanged lines text entry for each.
179	root	1.5	print {$in} JSON::XS::encode_json ({
180			jsonrpc => "2.0", id => 180, method => "tools/call",
181			params => { name => "read-lines", arguments => {
182			target => "secondary-vim", buffer => 1, ranges => ["727,728", "985,986"],
183			} },
184			}), "\n" or die "send Vim read-lines request: $!";
185
186			my $wire = "";
187			my $vim_call;
188			for (1 .. 15) {
189			IO::Select->new ($valid)->can_read (0.3)
190			or next;
191			my $n = sysread $valid, my $fragment, 8192;
192			last unless $n;
193			$wire .= $fragment;
194			$vim_call = eval { JSON::XS::decode_json $wire };
195			last if $vim_call;
196			}
197			ok $vim_call && $vim_call->[1][0] eq "call"
198			&& $vim_call->[1][2] eq "read_lines",
199			"read-lines delegates disjoint ranges to the private Vim RPC";
200			if ($vim_call) {
201			$valid->autoflush (1);
202			print {$valid} JSON::XS::encode_json ([0, [
203			reply => $vim_call->[1][1], 1, {
204			changedtick => 7,
205			ranges => [
206			{ range => "727,728", start => 727, end => 728, lines => ["function alpha () {", " return a;"] },
207			{ range => "985,986", start => 985, end => 986, lines => ["function beta () {", " return b;"] },
208			],
209			},
210			]]) or die "send mock Vim RPC reply: $!";
211			}
212			IO::Select->new ($out)->can_read (5) or die "read-lines MCP reply timeout";
213			my $lines_reply = JSON::XS::decode_json (scalar <$out>);
214			my $blocks = $lines_reply->{result}{content} \|\| [];
215	root	1.6	is @{$blocks}, 5, "Vim returns initial metadata plus two text entries per requested range";
216			is_deeply [map $_->{type}, @$blocks], [("text") x 5],
217			"all Vim metadata and source blocks remain MCP text entries";
218	root	1.5	is_deeply JSON::XS::decode_json ($blocks->[0]{text}), {
219			changedtick => 7,
220			ranges => [
221			{ range => "727,728", start => 727, end => 728 },
222			{ range => "985,986", start => 985, end => 986 },
223			],
224			}, "Vim changedtick and resolved range metadata remain available";
225	root	1.6	is_deeply [map $_->{text}, @{$blocks}[1..4]], [
226			"[range=727,728]",
227			"function alpha () {\n return a;\n",
228			"[range=985,986]",
229			"function beta () {\n return b;\n",
230			], "each Vim range has visible standalone metadata and unchanged newline-terminated source";
231	root	1.5
232
233	root	1.2	my ($invalid_ws, $invalid_headers) = upgrade ("secret-do-not-log-XYZ");
234	root	1.1	unlike $invalid_headers, qr{\AHTTP/1\.[01] 101\b},
235			"unknown WebSocket URL token does not upgrade";
236			close $invalid_ws;
237
238	root	1.2	my ($malformed_ws, $malformed_headers) = upgrade ("secondary", "/secondary/");
239			unlike $malformed_headers, qr{\AHTTP/1\.[01] 101\b},
240			"malformed WebSocket URL rejected even when it contains a valid token";
241			close $malformed_ws;
242
243	root	1.1	for my $kind (qw(xpcse-client ypcse-client)) {
244			my ($sock, $headers, $pending) = upgrade ("secondary");
245			like $headers, qr{\AHTTP/1\.1 101\b},
246			"secondary token authenticates $kind WebSocket handshake";
247			if ($headers =~ /\AHTTP\/1\.1 101\b/) {
248			my $payload = JSON::XS::encode_json ([$kind, 99]);
249			my $frame = Protocol::WebSocket::Frame->new (
250			type => "text", masked => 1, buffer => $payload,
251			);
252			print {$sock} $frame->to_bytes or die "send $kind mismatch: $!";
253			is ws_close_code ($sock, $pending), 1002,
254			"$kind version mismatch triggers protocol-error close";
255			} else {
256			fail "$kind version mismatch closes connection";
257			}
258			close $sock;
259			}
260
261			close $valid;
262			close $in;
263			my $exit;
264			for (1 .. 120) {
265			my $w = waitpid ($pid, WNOHANG);
266			if ($w == $pid) {
267			$exit = $? >> 8;
268			last;
269			}
270			Time::HiRes::sleep (0.025);
271			}
272			if (!defined $exit) {
273			kill TERM => $pid;
274			waitpid ($pid, 0);
275			$exit = -1;
276			}
277			is $exit, 0, "broker exits after stdio EOF";
278			close $out;
279	root	1.2	local $/;
280			my $log = <$err> // "";
281			like $log, qr/illegal websocket connect from 127\.0\.0\.1:\d+/,
282			"rejected websocket handshake logs the numeric TCP peer and port";
283			unlike $log, qr/secret-do-not-log-XYZ\|\/secondary\//,
284			"rejected URL never exposes supplied credentials in the log";
285	root	1.1	close $err;
286
287			done_testing;