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.pl23
1 files changed, 17 insertions, 6 deletions
diff --git a/Scripts/lldb-dap-proxy.pl b/Scripts/lldb-dap-proxy.pl
index 5f545b1..beb6eaa 100644
--- a/Scripts/lldb-dap-proxy.pl
+++ b/Scripts/lldb-dap-proxy.pl
@@ -1,6 +1,7 @@
1#!/usr/bin/perl 1#!/usr/bin/perl
2use strict; 2use strict;
3use warnings; 3use warnings;
4use Fcntl qw(O_WRONLY O_APPEND O_CREAT O_NOFOLLOW);
4use IPC::Open3; 5use IPC::Open3;
5use IO::Select; 6use IO::Select;
6use JSON::PP; 7use JSON::PP;
@@ -13,7 +14,7 @@ my @adapter_args = @ARGV > 2 ? @ARGV[2 .. $#ARGV] : ();
13sub log_msg { 14sub log_msg {
14 return unless defined $log_path; 15 return unless defined $log_path;
15 my ($msg) = @_; 16 my ($msg) = @_;
16 open(my $fh, '>>', $log_path) or return; 17 sysopen(my $fh, $log_path, O_WRONLY | O_APPEND | O_CREAT | O_NOFOLLOW, 0600) or return;
17 my @t = gmtime(time); 18 my @t = gmtime(time);
18 printf $fh "[%04d-%02d-%02dT%02d:%02d:%02dZ] %s\n", 19 printf $fh "[%04d-%02d-%02dT%02d:%02d:%02dZ] %s\n",
19 $t[5] + 1900, $t[4] + 1, $t[3], $t[2], $t[1], $t[0], $msg; 20 $t[5] + 1900, $t[4] + 1, $t[3], $t[2], $t[1], $t[0], $msg;
@@ -41,8 +42,8 @@ if ($@) {
41 42
42binmode($_, ':raw') for \*STDIN, \*STDOUT, $child_in, $child_out, $child_err; 43binmode($_, ':raw') for \*STDIN, \*STDOUT, $child_in, $child_out, $child_err;
43 44
44$SIG{INT} = sub { kill 'INT', $pid }; 45$SIG{INT} = sub { log_msg('received SIGINT'); kill 'INT', $pid };
45$SIG{TERM} = sub { kill 'TERM', $pid }; 46$SIG{TERM} = sub { log_msg('received SIGTERM'); kill 'TERM', $pid };
46 47
47my $json = JSON::PP->new->utf8; 48my $json = JSON::PP->new->utf8;
48 49
@@ -63,8 +64,15 @@ LOOP: while ($sel->count > 0) {
63 unless (defined $n && $n > 0) { 64 unless (defined $n && $n > 0) {
64 $sel->remove($fh); 65 $sel->remove($fh);
65 my $fn = fileno($fh); 66 my $fn = fileno($fh);
66 close($child_in) if $fn == $stdin_fn; 67 if ($fn == $stdin_fn) {
67 last LOOP if $fn == $child_out_fn; # adapter stdout closing ends the session 68 log_msg('stdin closed');
69 close($child_in);
70 } elsif ($fn == $child_out_fn) {
71 log_msg('adapter stdout closed');
72 last LOOP;
73 } else {
74 log_msg('adapter stderr closed');
75 }
68 next; 76 next;
69 } 77 }
70 my $fn = fileno($fh); 78 my $fn = fileno($fh);
@@ -82,6 +90,7 @@ LOOP: while ($sel->count > 0) {
82} 90}
83 91
84waitpid($pid, 0); 92waitpid($pid, 0);
93log_msg(sprintf 'adapter exited status=%d signal=%d', $? >> 8, $? & 127);
85# $? encodes exit code in the high byte and terminating signal in the low 7 bits. 94# $? encodes exit code in the high byte and terminating signal in the low 7 bits.
86# Re-raise the signal so the parent sees a signal-killed exit rather than exit(0). 95# Re-raise the signal so the parent sees a signal-killed exit rather than exit(0).
87my $signal = $? & 127; 96my $signal = $? & 127;
@@ -90,6 +99,7 @@ if ($signal) {
90 kill $signal, $$; 99 kill $signal, $$;
91 sleep 1; 100 sleep 1;
92} 101}
102log_msg(sprintf 'proxy exit code=%d', $? >> 8);
93exit($? >> 8); 103exit($? >> 8);
94 104
95sub flush_dap { 105sub flush_dap {
@@ -119,7 +129,7 @@ sub flush_dap {
119 syswrite($dest, 'Content-Length: ' . length($out) . "\r\n\r\n"); 129 syswrite($dest, 'Content-Length: ' . length($out) . "\r\n\r\n");
120 syswrite($dest, $out); 130 syswrite($dest, $out);
121 } else { 131 } else {
122 log_msg('non-json message forwarded'); 132 log_msg(sprintf 'non-json message forwarded%s', $@ ? " error=$@" : ' reason=not-a-hash');
123 syswrite($dest, 'Content-Length: ' . $body_len . "\r\n\r\n"); 133 syswrite($dest, 'Content-Length: ' . $body_len . "\r\n\r\n");
124 syswrite($dest, $body); 134 syswrite($dest, $body);
125 } 135 }
@@ -157,6 +167,7 @@ sub rewrite_client_message {
157 command => $command, 167 command => $command,
158 arguments => $msg->{arguments}, 168 arguments => $msg->{arguments},
159 }; 169 };
170 log_msg(sprintf 'client seq map %s=>%s', $orig, $rewrite);
160 } 171 }
161 $msg->{seq} = $rewrite; 172 $msg->{seq} = $rewrite;
162 } 173 }