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
|
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+ }
my regex pid { \d+ }
my regex proc { <name=name> '(' <pid=pid> ')' }
my regex pstree { <proc>* % '---' }
my $proc = run 'pstree', '-Tp', $pid.Str, :out;
my $output = $proc.out.slurp: :close;
if $output ~~ /<pstree>/ {
@process = 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 = <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 '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";
}
|