From 748c3633ce794685af343de0bcd24eca7440281b Mon Sep 17 00:00:00 2001 From: Eric Wong Date: Thu, 20 Jan 2022 18:34:18 +0000 Subject: move dtas-graph into script/, support Perl for dtas.sh "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. --- dtas.sh | 7 +-- perl/dtas-graph | 134 ------------------------------------------------------ script/dtas-graph | 134 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 138 insertions(+), 137 deletions(-) delete mode 100755 perl/dtas-graph create mode 100755 script/dtas-graph diff --git a/dtas.sh b/dtas.sh index d3ea5e1..1ceca15 100755 --- a/dtas.sh +++ b/dtas.sh @@ -1,7 +1,8 @@ #!/bin/sh -e # symlink this file to a directory in PATH to run dtas (or anything in bin/*) # without needing perms to install globally. Used by "make symlink-install" -p=$(realpath "$0" || readlink "$0") # neither is POSIX, but common -p=$(dirname "$p") c=$(basename "$0") # both are POSIX -exec ${RUBY-ruby} -I"$p"/lib "$p"/bin/"${c%.sh}" "$@" +p=$(realpath "$0" || readlink "$0"); # neither is POSIX, but common +p=$(dirname "$p") c=$(basename "$0"); c="${c%.sh}" +if test -x "$p/bin/$c"; then exec ${RUBY-ruby} -I"$p"/lib "$p/bin/$c" "$@"; +else exec ${PERL-perl} -I"$p"/lib "$p/script/$c" "$@"; fi : this script is too short to copyright 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 -# License: GPL-3.0+ -# -# 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; diff --git a/script/dtas-graph b/script/dtas-graph new file mode 100755 index 0000000..d918351 --- /dev/null +++ b/script/dtas-graph @@ -0,0 +1,134 @@ +#!/usr/bin/perl -w +# Copyright (C) all contributors +# License: GPL-3.0+ +# +# 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; -- cgit v1.2.3-24-ge0c7