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