aboutsummaryrefslogtreecommitdiff
path: root/Scripts/lldb-dap-proxy.pl
diff options
context:
space:
mode:
Diffstat (limited to 'Scripts/lldb-dap-proxy.pl')
-rw-r--r--Scripts/lldb-dap-proxy.pl224
1 files changed, 0 insertions, 224 deletions
diff --git a/Scripts/lldb-dap-proxy.pl b/Scripts/lldb-dap-proxy.pl
deleted file mode 100644
index beb6eaa..0000000
--- a/Scripts/lldb-dap-proxy.pl
+++ /dev/null
@@ -1,224 +0,0 @@
-#!/usr/bin/perl
-use strict;
-use warnings;
-use Fcntl qw(O_WRONLY O_APPEND O_CREAT O_NOFOLLOW);
-use IPC::Open3;
-use IO::Select;
-use JSON::PP;
-use Symbol 'gensym';
-
-my $adapter_path = $ARGV[0] // $ENV{NOVA_ZIG_LLDB_DAP_PATH};
-my $log_path = $ARGV[1] // $ENV{NOVA_ZIG_DEBUG_LOG};
-my @adapter_args = @ARGV > 2 ? @ARGV[2 .. $#ARGV] : ();
-
-sub log_msg {
- return unless defined $log_path;
- my ($msg) = @_;
- sysopen(my $fh, $log_path, O_WRONLY | O_APPEND | O_CREAT | O_NOFOLLOW, 0600) or return;
- my @t = gmtime(time);
- printf $fh "[%04d-%02d-%02dT%02d:%02d:%02dZ] %s\n",
- $t[5] + 1900, $t[4] + 1, $t[3], $t[2], $t[1], $t[0], $msg;
- close($fh);
-}
-
-unless (defined $adapter_path) {
- log_msg('missing adapter path');
- print STDERR "lldb-dap proxy requires a target adapter path.\n";
- exit(1);
-}
-
-log_msg("proxy start adapter=$adapter_path");
-
-# open3 treats an undef handle as "inherit parent STDIN/STDOUT", so pre-allocate
-# anonymous typeglobs to force pipe creation for all three streams.
-my ($child_in, $child_out, $child_err) = (gensym(), gensym(), gensym());
-my $pid = eval { open3($child_in, $child_out, $child_err, $adapter_path, @adapter_args) };
-if ($@) {
- (my $err = $@) =~ s/\s+$//;
- log_msg("adapter error $err");
- print STDERR "$err\n";
- exit(1);
-}
-
-binmode($_, ':raw') for \*STDIN, \*STDOUT, $child_in, $child_out, $child_err;
-
-$SIG{INT} = sub { log_msg('received SIGINT'); kill 'INT', $pid };
-$SIG{TERM} = sub { log_msg('received SIGTERM'); kill 'TERM', $pid };
-
-my $json = JSON::PP->new->utf8;
-
-my ($next_client_seq, $next_adapter_seq) = (1, 1);
-my (%client_request_seq_map, %adapter_request_seq_map, %request_args_by_client_seq);
-my ($stdin_buf, $child_buf) = ('', '');
-
-my $stdin_fn = fileno(\*STDIN);
-my $child_out_fn = fileno($child_out);
-
-my $sel = IO::Select->new(\*STDIN, $child_out, $child_err);
-
-LOOP: while ($sel->count > 0) {
- my @ready = $sel->can_read;
- for my $fh (@ready) {
- my ($chunk, $n);
- $n = sysread($fh, $chunk, 65536);
- unless (defined $n && $n > 0) {
- $sel->remove($fh);
- my $fn = fileno($fh);
- if ($fn == $stdin_fn) {
- log_msg('stdin closed');
- close($child_in);
- } elsif ($fn == $child_out_fn) {
- log_msg('adapter stdout closed');
- last LOOP;
- } else {
- log_msg('adapter stderr closed');
- }
- next;
- }
- my $fn = fileno($fh);
- if ($fn == $stdin_fn) {
- $stdin_buf .= $chunk;
- flush_dap(\$stdin_buf, $child_in, \&rewrite_client_message);
- } elsif ($fn == $child_out_fn) {
- $child_buf .= $chunk;
- flush_dap(\$child_buf, \*STDOUT, \&rewrite_adapter_message);
- } else {
- log_msg('stderr ' . $chunk);
- print STDERR $chunk;
- }
- }
-}
-
-waitpid($pid, 0);
-log_msg(sprintf 'adapter exited status=%d signal=%d', $? >> 8, $? & 127);
-# $? encodes exit code in the high byte and terminating signal in the low 7 bits.
-# Re-raise the signal so the parent sees a signal-killed exit rather than exit(0).
-my $signal = $? & 127;
-if ($signal) {
- $SIG{$_} = 'DEFAULT' for qw(INT TERM);
- kill $signal, $$;
- sleep 1;
-}
-log_msg(sprintf 'proxy exit code=%d', $? >> 8);
-exit($? >> 8);
-
-sub flush_dap {
- my ($buf_ref, $dest, $rewrite_fn) = @_;
- while (1) {
- my $header_end = index($$buf_ref, "\r\n\r\n");
- last if $header_end == -1;
-
- my $header = substr($$buf_ref, 0, $header_end);
- unless ($header =~ /Content-Length:\s*(\d+)/i) {
- syswrite($dest, $$buf_ref);
- $$buf_ref = '';
- return;
- }
-
- my $body_len = 0 + $1;
- my $frame_len = $header_end + 4 + $body_len;
- last if length($$buf_ref) < $frame_len;
-
- my $body = substr($$buf_ref, $header_end + 4, $body_len);
- $$buf_ref = substr($$buf_ref, $frame_len);
-
- my $msg = eval { $json->decode($body) };
- if (!$@ && ref($msg) eq 'HASH') {
- $rewrite_fn->($msg);
- my $out = $json->encode($msg);
- syswrite($dest, 'Content-Length: ' . length($out) . "\r\n\r\n");
- syswrite($dest, $out);
- } else {
- log_msg(sprintf 'non-json message forwarded%s', $@ ? " error=$@" : ' reason=not-a-hash');
- syswrite($dest, 'Content-Length: ' . $body_len . "\r\n\r\n");
- syswrite($dest, $body);
- }
- }
-}
-
-sub rewrite_client_message {
- my ($msg) = @_;
- my $type = $msg->{type} // '';
- my $command = $msg->{command} // '';
- log_msg(sprintf 'client message type=%s command=%s seq_in=%s request_seq_in=%s',
- $type, $command, $msg->{seq} // '', $msg->{request_seq} // '');
-
- # Nova omits the filters array on setExceptionBreakpoints requests, which
- # lldb-dap then rejects. Ensure the field is always present before forwarding.
- if ($type eq 'request' && $command eq 'setExceptionBreakpoints') {
- $msg->{arguments} = {} unless ref($msg->{arguments}) eq 'HASH';
- $msg->{arguments}{filters} = [] unless ref($msg->{arguments}{filters}) eq 'ARRAY';
- }
-
- if ($type eq 'response' && defined $msg->{request_seq}) {
- my $rseq = $msg->{request_seq};
- if (exists $adapter_request_seq_map{$rseq}) {
- $msg->{request_seq} = $adapter_request_seq_map{$rseq};
- delete $adapter_request_seq_map{$rseq};
- }
- }
-
- if (defined $msg->{seq}) {
- my $orig = $msg->{seq};
- my $rewrite = $next_client_seq++;
- if ($type eq 'request') {
- $client_request_seq_map{$rewrite} = $orig;
- $request_args_by_client_seq{$rewrite} = {
- command => $command,
- arguments => $msg->{arguments},
- };
- log_msg(sprintf 'client seq map %s=>%s', $orig, $rewrite);
- }
- $msg->{seq} = $rewrite;
- }
-
- log_msg(sprintf 'client message seq_out=%s request_seq_out=%s',
- $msg->{seq} // '', $msg->{request_seq} // '');
-}
-
-sub rewrite_adapter_message {
- my ($msg) = @_;
- my $type = $msg->{type} // '';
- my $command = $msg->{command} // '';
- log_msg(sprintf 'adapter message type=%s command=%s seq_in=%s request_seq_in=%s',
- $type, $command, $msg->{seq} // '', $msg->{request_seq} // '');
-
- if ($type eq 'response' && defined $msg->{request_seq}) {
- my $rseq = $msg->{request_seq};
- my $orig_req = $request_args_by_client_seq{$rseq};
- my $orig_seq = $client_request_seq_map{$rseq};
-
- if (defined $orig_seq) {
- $msg->{request_seq} = $orig_seq;
- delete $client_request_seq_map{$rseq};
- }
-
- # lldb-dap returns a successful setExceptionBreakpoints response without
- # the breakpoints array the DAP spec requires. Synthesise one verified
- # entry per filter so Nova's client confirms each breakpoint as registered.
- if (defined $orig_req
- && ($orig_req->{command} // '') eq 'setExceptionBreakpoints'
- && $msg->{success})
- {
- my $filters = ref($orig_req->{arguments}{filters}) eq 'ARRAY'
- ? $orig_req->{arguments}{filters} : [];
- $msg->{body} = {} unless ref($msg->{body}) eq 'HASH';
- unless (ref($msg->{body}{breakpoints}) eq 'ARRAY') {
- $msg->{body}{breakpoints} = [ map { +{ verified => JSON::PP::true } } @$filters ];
- }
- }
-
- delete $request_args_by_client_seq{$rseq};
- }
-
- if (defined $msg->{seq}) {
- my $orig = $msg->{seq};
- my $rewrite = $next_adapter_seq++;
- $adapter_request_seq_map{$rewrite} = $orig if $type eq 'request';
- $msg->{seq} = $rewrite;
- log_msg("adapter seq map $orig=>$rewrite");
- }
-
- log_msg(sprintf 'adapter message seq_out=%s request_seq_out=%s',
- $msg->{seq} // '', $msg->{request_seq} // '');
-}