diff options
author | Eric Wong <e@80x24.org> | 2022-01-20 18:34:18 +0000 |
---|---|---|
committer | Eric Wong <e@80x24.org> | 2022-01-21 19:54:43 +0000 |
commit | 748c3633ce794685af343de0bcd24eca7440281b (patch) | |
tree | 704aa24640712de04c102eceed7eb169d787d568 /perl | |
parent | 5111742a5a100e44fccf191b12a13c452b025944 (diff) | |
download | dtas-748c3633ce794685af343de0bcd24eca7440281b.tar.gz |
"script/" is the standard location for Perl ExtUtils::MakeMaker-based installations, so and we'll probably overload "lib" to support Perl scripts. This is another step in expanding our use of Perl5 and avoiding the slow startup and API instability of Ruby.
Diffstat (limited to 'perl')
-rwxr-xr-x | perl/dtas-graph | 134 |
1 files changed, 0 insertions, 134 deletions
diff --git a/perl/dtas-graph b/perl/dtas-graph deleted file mode 100755 index 776485d..0000000 --- a/perl/dtas-graph +++ /dev/null @@ -1,134 +0,0 @@ -#!/usr/bin/perl -w -# Copyright (C) 2013-2020 all contributors <dtas-all@nongnu.org> -# License: GPL-3.0+ <https://www.gnu.org/licenses/gpl-3.0.txt> -# -# Process visualizer which shows pipe connections between processes with -# ASCII art. Useful for displaying complex interations between different -# processes in a non-traditional pipeline. -use strict; -use Graph::Easy; # for ASCII-art graphs -$^O =~ /linux/ or print STDERR "$0 probably only works on Linux...\n"; -scalar @ARGV or die "Usage: $0 PID [PID ...]"; -our $procfs = $ENV{PROCFS} || "/proc"; -my $cull_self_pipe = 1; - -# returns a list of PIDs which are children of the given PID -sub children_of { - my ($ppid) = @_; - my %rv = map { - s/\A\s*//g; - s/\s*\z//g; - my ($pid, $cmd) = split(/\s+/, $_, 2); - $pid => $cmd; - } `ps h -o pid,cmd --ppid=$ppid`; - \%rv; -} - -# pid => [ child pids ] -my %pids; - -# pipe_ino => { r => [ [pid, fd], [pid, fd] ], w => [ [pid, fd], ... ] } -my %pipes; - -# pid => argv -my %cmds; - -my $pipe_nr = 0; -# pipe_id -> pipe_ino (we use short pipe IDs to save space on small terms) -my %graphed; - -my @to_scan = (@ARGV); - -sub cmd_of { - my ($pid) = @_; - my $cmd = `ps h -o cmd $pid`; - chomp $cmd; - $cmd; -} - -while (my $pid = shift @to_scan) { - my $children = children_of($pid); - my @child_pids = keys %$children; - push @to_scan, @child_pids; - $pids{$pid} = \@child_pids; - foreach my $child (keys @child_pids) { - $cmds{$child} = $children->{$child}; - } -} - -# build up a hash of pipes and their connectivity to processes: -# -foreach my $pid (keys %pids) { - my @out = `lsof -p $pid`; - # output is like this: - # play 12739 ew 0r FIFO 0,7 0t0 36924019 pipe - foreach my $l (@out) { - my @l = split(/\s+/, $l); - $l[4] eq "FIFO" or next; - - my $fd = $l[3]; - my $pipe_ino = $l[7]; - my $info = $pipes{$pipe_ino} ||= { r => [], w => [] }; - if ($fd =~ s/r\z//) { - push @{$info->{r}}, [ $pid, $fd ]; - } elsif ($fd =~ s/w\z//) { - push @{$info->{w}}, [ $pid, $fd ]; - } - - } -} - -my $graph = Graph::Easy->new(); -foreach my $pid (keys %pids) { - $graph->add_node($pid); -} - -foreach my $pipe_ino (keys %pipes) { - my $info = $pipes{$pipe_ino}; - my %pairs; - my $pipe_node; - - foreach my $rw (qw(r w)) { - foreach my $pidfd (@{$info->{$rw}}) { - my ($pid, $fd) = @$pidfd; - my $pair = $pairs{$pid} ||= {}; - my $fds = $pair->{$rw} ||= []; - push @$fds, $fd; - } - } - # use Data::Dumper; - # print Dumper(\%pairs); - my $nr_pids = scalar keys %pairs; - - foreach my $pid (keys %pairs) { - my $pair = $pairs{$pid}; - my $r = $pair->{r} || []; - my $w = $pair->{w} || []; - next if $cull_self_pipe && $nr_pids == 1 && @$r && @$w; - - unless ($pipe_node) { - my $pipe_id = $pipe_nr++; - $graphed{$pipe_id} = $pipe_ino; - $pipe_node = "|$pipe_id"; - $graph->add_node($pipe_node); - } - - $graph->add_edge($pipe_node, $pid, join(',', @$r)) if @$r; - $graph->add_edge($pid, $pipe_node, join(',', @$w)) if @$w; - } -} - -print " PID COMMAND\n"; -foreach my $pid (sort { $a <=> $b } keys %pids) { - printf "% 6d", $pid; - print " ", $cmds{$pid} || cmd_of($pid), "\n"; -} - -print "\nPIPEID PIPE_INO\n"; -foreach my $pipe_id (sort { $a <=> $b } keys %graphed) { - printf "% 6s", "|$pipe_id"; - my $ino = $graphed{$pipe_id}; - printf " %u (0x%0x)\n", $ino, $ino; -} - -print $graph->as_ascii; |