aboutsummaryrefslogtreecommitdiff
path: root/lib/App
diff options
context:
space:
mode:
Diffstat (limited to 'lib/App')
-rw-r--r--lib/App/RunForPid.pm6156
1 files changed, 156 insertions, 0 deletions
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