aboutsummaryrefslogtreecommitdiff
path: root/lib/App/RunForPid.pm6
blob: 69c8c6a4d61cb50a0d90d7b2468f9b21fabd9798 (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
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
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";
}

=begin pod

=head1 NAME

App::RunForPid - blah blah blah

=head1 SYNOPSIS

=begin code :lang<perl6>

use App::RunForPid;

=end code

=head1 DESCRIPTION

App::RunForPid is ...

=head1 AUTHOR

Matias Linares <matiaslina@gmail.com>

=head1 COPYRIGHT AND LICENSE

Copyright 2020 Matias Linares

This library is free software; you can redistribute it and/or modify it under the Artistic License 2.0.

=end pod