From ddf2de739068b5ff0866ccb1d067f3cb53a4fc55 Mon Sep 17 00:00:00 2001 From: David Czihak Date: Thu, 7 May 2026 14:33:19 +0200 Subject: Initial commit --- Scripts/lldb-dap-proxy.pl | 213 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 213 insertions(+) create mode 100644 Scripts/lldb-dap-proxy.pl (limited to 'Scripts/lldb-dap-proxy.pl') diff --git a/Scripts/lldb-dap-proxy.pl b/Scripts/lldb-dap-proxy.pl new file mode 100644 index 0000000..5f545b1 --- /dev/null +++ b/Scripts/lldb-dap-proxy.pl @@ -0,0 +1,213 @@ +#!/usr/bin/perl +use strict; +use warnings; +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) = @_; + open(my $fh, '>>', $log_path) 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 { kill 'INT', $pid }; +$SIG{TERM} = sub { 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); + close($child_in) if $fn == $stdin_fn; + last LOOP if $fn == $child_out_fn; # adapter stdout closing ends the session + 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); +# $? 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; +} +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('non-json message forwarded'); + 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}, + }; + } + $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} // ''); +} -- cgit v1.3