Initial commitv0.1.7

1 files changed, 213 insertions, 0 deletions

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} // '');
+}