aboutsummaryrefslogtreecommitdiff
path: root/lib/App/RunForPid.pm6
blob: 7d45941ecfc963cb407420b3aabd02306bda750e (plain)
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 {
    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 {
                    sayProc finished: exitcode=’, .exitcode, ‘ signal=’, .signal;
                    done # gracefully jump from the react block
                }
                whenever signal(SIGTERM).merge: signal(SIGINT) {
                    once {
                        saySignal received, asking the process to stop’;
                        $strace.kill; # sends SIGHUP, change appropriately
                        whenever signal($_).zip: Promise.in(2).Supply {
                            sayKill it!’;
                            $strace.kill: SIGKILL
                        }
                    }
                }
            }
        }
    }
}

#| Execute a command for a child process of $pid
multi sub MAIN(Int $pid) is export {
    say "Running for $pid";
}