dtas.git  about / heads / tags
duct tape audio suite for *nix
blob 90283033ec733dfe2fa67e095a342c155b28afd6 3012 bytes (raw)
$ git show v0.16.1:perl/dtas-graph	# shows this blob on the CLI

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
 
#!/usr/bin/perl -w
# Copyright (C) 2013-2016 all contributors <dtas-all@nongnu.org>
# License: GPL-3.0+ <https://www.gnu.org/licenses/gpl-3.0.txt>
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";
	print " ", $graphed{$pipe_id}, "\n";
}

print $graph->as_ascii;

git clone git://80x24.org/dtas.git
git clone https://80x24.org/dtas.git