1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
use v6.c;
unit class App::RunForPid:ver<0.0.1>:auth<cpan:MATIASL>;
use Term::Choose :choose;
sub get-pid {
my $proc = run 'xprop', :out;
my $output = $proc.out.slurp: :close;
for $output.lines -> $line {
if $line ~~ m/'_NET_WM_PID'.* \s* '=' \s* $<pid> = [ \d+ ]/ {
return $<pid>.Int;
}
}
die 'Cannot find pid!';
}
sub parse-process-tree(Int $pid) {
my @process;
my regex name { \w <[\w -]> + }
my regex pid { \d+ }
my regex proc { <name=name> '(' <pid=pid> ')' }
my regex pstree { <proc>+ % ( '---' || '-+-' ) }
my $proc = run 'pstree', '-TlAp', $pid.Str, :out;
my $output = $proc.out.slurp: :close;
for $output.lines -> $line {
if $line ~~ /<pstree>/ {
@process.append: gather for $<pstree><proc> -> $proc {
take $proc<name>.Str => $proc<pid>.Int
}
}
}
@process
}
sub list-file-descriptors($pid) {
my $proc = run 'ls', '-l', "/proc/$pid/fd", :out;
my $output = $proc.out.slurp: :close;
return gather for $output.lines -> $line {
take $line.words[*-1]
}
}
#| Find a pid for a window
multi sub MAIN() is export(:main) {
my $ppid = get-pid;
my @actions = <kill gdb fd stdout stderr stdout&stderr>;
say "Found pid from a wm: $ppid";
my @process = parse-process-tree($ppid);
my $selection = choose(@process.map({ "{$_.value} ({$_.key})" })) or exit;
say "Selected $selection";
my $pid = $selection.words[0];
my $option = choose(@actions) or exit;
given $option {
when 'gdb' {
run 'gdb', '-p', $pid;
}
when 'fd' {
my $fd = choose(list-file-descriptors($pid)) or exit;
run 'tail', '-f', "$fd";
}
when 'kill' {
my $signal = choose(Signal::.keys) or exit;
run 'kill', "-{$signal}", $pid;
}
when 'stdout'|'stderr'|'stdout&stderr' {
my $has-stdout = $option.index('stdout').defined;
my $has-stderr = $option.index('stderr').defined;
my $write = 'write=';
if $has-stdout && $has-stderr {
$write ~= '1,2';
} elsif $has-stdout {
$write ~= '1';
} elsif $has-stderr {
$write ~= '2'
}
my $strace = Proc::Async.new(
'strace',
'-e', $write,
'-e', 'trace=write',
'-e', 'decode-fds=path,socket,dev,pidfd',
'-p', $pid
);
my @buf;
react {
whenever $strace.stderr.lines -> $line {
given $line {
when /write/ {
say @buf.join: '' if @buf.elems > 0;
@buf = ();
}
when .index('|').defined {
if /$<buf> = [ . ** 16 ] ' |' $$/ {
@buf.push: $<buf>;
}
}
}
# my $in = | 00000 73 74 65 70 20 31 32 33 34 35 36 37 39 30 30 31 step 12345679001 |
# $in ~~ / $<buf> = [ . ** 16 ] ' |' $$ /; $/
}
whenever $strace.start {
say ‘Proc finished: exitcode=’, .exitcode, ‘ signal=’, .signal;
done # gracefully jump from the react block
}
whenever signal(SIGTERM).merge: signal(SIGINT) {
once {
say ‘Signal received, asking the process to stop’;
$strace.kill; # sends SIGHUP, change appropriately
whenever signal($_).zip: Promise.in(2).Supply {
say ‘Kill it!’;
$strace.kill: SIGKILL
}
}
}
}
}
}
}
#| Execute a command for a child process of $pid
multi sub MAIN(Int $pid) is export(:main) {
say "Running for $pid";
}
|
