From c20106a71d492b5a2250e8ff28df4852057632b7 Mon Sep 17 00:00:00 2001
From: Matias Linares <matiaslina@gmail.com>
Date: Sat, 11 Jul 2020 19:54:29 -0300
Subject: First commit

---
 lib/App/RunForPid.pm6 | 156 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 156 insertions(+)
 create mode 100644 lib/App/RunForPid.pm6

(limited to 'lib')

diff --git a/lib/App/RunForPid.pm6 b/lib/App/RunForPid.pm6
new file mode 100644
index 0000000..69c8c6a
--- /dev/null
+++ b/lib/App/RunForPid.pm6
@@ -0,0 +1,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 {
+                    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 {
+    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
-- 
cgit v1.2.3-70-g09d2