#!/usr/bin/perl
# tcplistenzone.pl version 0x1 by vnull 2006
# tested on: solaris 10 x86 06/06, solaris 11 x86 (20060821)
# 
# Note:
# + it IS slow ( proof-of-concept ) and causes heavy CPU usage
# + more: it doesn't scale at ALL
# + and finally yes - i'm aware of lsof -i -n :)
#

use strict;
use warnings;
use Fcntl qw(S_IFMT S_IFSOCK);
use Socket;

my $netstat = "netstat -f inet -a -n -P tcp";
my $pfiles = "pfiles";

opendir(DIR, "/proc") or die "unable to opendir /proc\n";
my @pids = readdir(DIR);
closedir(DIR);

my %pid2port;
foreach my $pid (@pids) {
	next if ( $pid eq "." || $pid eq "..");

	open(PF, "$pfiles $pid |" ) or die "unable to open pfiles\n";
	my $curfd = 0;
	my $written = 0;
	my $name = "";
	while(<PF>) {
		# per PID
		chomp;
		my $l = $_;
		my @d = split;

		if($d[0] =~ /^[0-9]+:/) {
			if($d[0] eq "$pid:") {
				$name = $d[1];
				next;	
			}

			$curfd = $d[0];
			$curfd =~ s/\://;
			next;
		}

		if ($d[0] =~ /^sockname:/ && $d[1] =~ /^AF_INET$/) {
			if(!$written) {
				my $p = "/proc/$pid";
				my @sbuf = stat($p) or die "unable to stat $p: $!\n";
				$_  = `ps -o zone -p $pid`;
				chomp;
				my @z = split;
				print "\nPID: $pid ($name) UID: $sbuf[4] GID: $sbuf[5] ZONE: ".$z[1]."\n";
				$written++;
			}

			print "\tfd=$curfd $d[2]:$d[4]\n";
		}

	}
	close PF;
}

print "\n";

exit 0;