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 => "vim-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";

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";

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.2
Committed:	Sun Oct 11 02:43:41 2026 UTC (9 days, 5 hours ago) by root
Content type:	application/x-troff
Branch:	MAIN
Changes since 1.1:	+16 -3 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			{ name => "vim-targets", arguments => {} });
63			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
127			my $bad = vim_connect ("unknown", "bad-vim");
128			my $before = target_names ();
129			ok !grep ($_ eq "bad-vim", @$before), "unknown private Vim token cannot register a target";
130			close $bad;
131
132			my $valid = vim_connect ("secondary", "secondary-vim");
133			my $visible;
134			for (1 .. 35) {
135			my $names = target_names ();
136			$visible = grep $_ eq "secondary-vim", @$names;
137			last if $visible;
138			Time::HiRes::sleep (0.03);
139			}
140			ok $visible, "secondary token authenticates private Vim handshake";
141
142	root	1.2	my ($invalid_ws, $invalid_headers) = upgrade ("secret-do-not-log-XYZ");
143	root	1.1	unlike $invalid_headers, qr{\AHTTP/1\.[01] 101\b},
144			"unknown WebSocket URL token does not upgrade";
145			close $invalid_ws;
146
147	root	1.2	my ($malformed_ws, $malformed_headers) = upgrade ("secondary", "/secondary/");
148			unlike $malformed_headers, qr{\AHTTP/1\.[01] 101\b},
149			"malformed WebSocket URL rejected even when it contains a valid token";
150			close $malformed_ws;
151
152	root	1.1	for my $kind (qw(xpcse-client ypcse-client)) {
153			my ($sock, $headers, $pending) = upgrade ("secondary");
154			like $headers, qr{\AHTTP/1\.1 101\b},
155			"secondary token authenticates $kind WebSocket handshake";
156			if ($headers =~ /\AHTTP\/1\.1 101\b/) {
157			my $payload = JSON::XS::encode_json ([$kind, 99]);
158			my $frame = Protocol::WebSocket::Frame->new (
159			type => "text", masked => 1, buffer => $payload,
160			);
161			print {$sock} $frame->to_bytes or die "send $kind mismatch: $!";
162			is ws_close_code ($sock, $pending), 1002,
163			"$kind version mismatch triggers protocol-error close";
164			} else {
165			fail "$kind version mismatch closes connection";
166			}
167			close $sock;
168			}
169
170			close $valid;
171			close $in;
172			my $exit;
173			for (1 .. 120) {
174			my $w = waitpid ($pid, WNOHANG);
175			if ($w == $pid) {
176			$exit = $? >> 8;
177			last;
178			}
179			Time::HiRes::sleep (0.025);
180			}
181			if (!defined $exit) {
182			kill TERM => $pid;
183			waitpid ($pid, 0);
184			$exit = -1;
185			}
186			is $exit, 0, "broker exits after stdio EOF";
187			close $out;
188	root	1.2	local $/;
189			my $log = <$err> // "";
190			like $log, qr/illegal websocket connect from 127\.0\.0\.1:\d+/,
191			"rejected websocket handshake logs the numeric TCP peer and port";
192			unlike $log, qr/secret-do-not-log-XYZ\|\/secondary\//,
193			"rejected URL never exposes supplied credentials in the log";
194	root	1.1	close $err;
195
196			done_testing;