diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/App/RunForPid.pm6 | 156 |
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 |