#!/usr/bin/perl -w
use Curses;
use strict;
use threads;
use threads::shared;
use Thread::Queue;
use IO::Handle;

# Conntrack viewer frontend
# Copyright (C) 2006 Daniel De Graaf
#
# Released under the GNU GPL v2 (http://www.gnu.org/licenses/gpl2.txt)
# 
# $Id: ctview 892 2006-12-20 16:50:26Z daniel $

$_ = $ARGV[0] || '';
if (/h/) {
	print q#
Conntrack Viewer: ncurses-based frontend to conntrack

Options:
	-d FILE   Append debugging information to the specified file, or 
	          /root/ctview-log if not specified
	-h        You're reading it

Displays the netfilter table and allows deletion of entries. Keys in viewer:
	arrows, pageup/down scrolls through connections
	d	Delete higlighed connection
	r	Refresh display (reread pids, process names, and connection bytes)
	R	Full refresh (only useful if the backend conntrack -E dies)
	p	Pause display (do not delete old entries)
	s	Sort (using current sort order)
	S	Change sort order between pid, source, and destination
	q	Quit
#;
	exit;
}

close STDERR;
if (/d/) {
	my $file = $ARGV[1] || '/root/ctview-log';
	open STDERR, '>>', $file;
	autoflush STDERR 1;
}
my $lookup = Thread::Queue->new;
my (%conn,%inode,@connl,$ctpid) : shared;
my $scan_ct : shared = 0;
my $sortorder = 'pid';

sub kbyte {
	my $n = shift || 0;
	my $x = 0;
	while ($n > 9999) {
		$x++;
		$n = int $n / 1000;
	}
	$n . (' ',qw/K M G T P/)[$x];
}

sub getdat {
	local $_ = shift;
	s/\s+/ /g;
	s/^ ?(\S+) (\d+) (\d+)? ?(\S+)? ?src/src/;
	my %t : shared = ( 
		process => '',
		t_st_o => '',
		uid_n => '',
		redisp => 1,
		'ref' => 1,
	);
	my %p : shared = ( 
		proto => $1, 
		pnum => $2,
		ttl => $3,
		t_state => $4,
		x => \%t,
	);
	my $i = 0;
	for (split / /) {
		if (/(.+)=(.+)/) {
			my $k = $1;
			$k .= '_' while exists $p{$k};
			$p{$k} = $2;
		} else {
			$p{c_state} = $1 if /([A-Z_]+)/;
			$p{$i++} = $_;
		}
	}
	$p{uuid} = $p{proto};
	$p{uuid} .= (defined $p{$_} ? '/'.$p{$_} : '/') for qw/src sport dst dport id/;
#	print STDERR "<$_:$p{$_}>" for sort keys %p;
#	print STDERR "\n";
	$p{disp} = sprintf '%-5.5s %21.21s%-6s %21.21s%-6s %5s %5s %s',
		$p{proto}, $p{src}, (exists $p{sport} ? ':'.$p{sport} : ''), $p{dst}, (exists $p{dport} ? ':'.$p{dport} : ''),
		kbyte($p{bytes}), kbyte($p{bytes_}), ($p{t_state} || $p{c_state} || '?');
	
	$_ = $p{proto}.' ~'.$p{src};
	s/~/' 'x(28 - length)/e;
	$_ .= (exists $p{sport} ? ':'.$p{sport} : '').' ~'.$p{dst};
	s/~/' 'x(56 - length)/e;
	$_ .= (exists $p{dport} ? ':'.$p{dport} : '').' ~';
	s/~/' 'x(63 - length)/e;
	$_ .= sprintf '%5s %5s %s', kbyte($p{bytes}), kbyte($p{bytes_}), ($p{t_state} || $p{c_state} || '?');
	
	$p{disph} = $_;
	
	\%p
}

sub get_pid {
	lock %inode;
	exists $inode{$_[0]} ? $inode{$_[0]} : undef;
}

sub scan_proc {
	my $pdir;
	my %node : shared = ();
	opendir $pdir, '/proc' or die "hey, where'd proc go? I get $!";
	print STDERR "Scanning /proc...";
	for (readdir $pdir) {
		next unless /^([0-9]+)$/;
		my $pid = $1;
		my $fds;
		opendir $fds, "/proc/$pid/fd" or next;
		for (readdir $fds) {
			my $n = readlink "/proc/$pid/fd/$_";
#			print STDERR "$pid/$_:$n\n";
			next unless defined $n && $n =~ /socket:\[([0-9]+)\]/;
			$node{$1} = $pid;
		}
	}
	print STDERR (keys %node)." inodes found\n";
	closedir $pdir;
#	print STDERR "$_:$node{$_}\n" for sort keys %node;
	lock %inode;
	%inode = %node;
}

sub find_tu4 {
	my ($pro,$p) = @_;
	open my $nlist, "/proc/net/$pro" or die "can't open /proc/net/$pro: $!";
	my @srcl = reverse $$p{src} =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/;
	my @dstl = reverse $$p{dst} =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/;
	my $ss1 = sprintf ' %02X%02X%02X%02X:%04X %02X%02X%02X%02X:%04X', @srcl, $$p{sport}, @dstl, $$p{dport};
	my $ss2 = sprintf ' %02X%02X%02X%02X:%04X %02X%02X%02X%02X:%04X', @dstl, $$p{dport}, @srcl, $$p{sport};
	while (<$nlist>) {
		if (index($_,$ss1) != -1 || index($_,$ss2) != -1) {
			#/^\s*\d+: [0-9A-F:]+ [0-9A-F:]+ ([0-9A-F]+) [0-9A-F:]+ [0-9A-F:]+ [0-9A-F]+\s+(\d+)\s+\d+\s+(\d+)/;
			/^\s*\d+: [0-9A-F:]+ [0-9A-F:]+ [0-9A-F]+ [0-9A-F:]+ [0-9A-F:]+ [0-9A-F]+\s+(\d+)\s+\d+\s+(\d+)/;
			($$p{x}{uid},$$p{x}{inode}) = ($1,$2);
			last;
		}
	}
	close $nlist;
	unless ($$p{x}{inode}) {
		$ss1 =~ s/ / 0000000000000000FFFF0000/g;
		$ss2 =~ s/ / 0000000000000000FFFF0000/g;
#		print STDERR "secondary search for $ss1\n";
		return unless -e "/proc/net/${pro}6";
		open $nlist, "/proc/net/${pro}6" or die $!;
		while (<$nlist>) {
			if (index($_,$ss1) != -1 || index($_,$ss2) != -1) {
				/^\s*\d+: [0-9A-F:]+ [0-9A-F:]+ [0-9A-F]+ [0-9A-F:]+ [0-9A-F:]+ [0-9A-F]+\s+(\d+)\s+\d+\s+(\d+)/;
				($$p{x}{uid},$$p{x}{inode}) = ($1,$2);
				last;
			}
		}
		close $nlist;
	}
}

# args: IPv6 address, use_little_endian. Returns: hexadecimal string
sub ip6_hex {
	# 2002:4071:4c37::1 => 714002200000374C0000000001000000
	# I hate little endian.
	local $_ = $_[0].'::';
#	print STDERR "Start: $_\n";
	s/::/:0::/ until /([^:]+:+){8}/;
	s/^://;
	s/:+/:/g;
#	print STDERR "Expand1: $_\n";
	s/([^:]+):/sprintf '%04s', $1/eg;
	y/a-f/A-F/;
#	print STDERR "Expand2: $_\n";
	s/(..)(..)(..)(..)/$4$3$2$1/g if $_[1];
	print STDERR "$_[0] => $_\n";
	$_
}

sub find_tu6 {
	my ($pro,$p) = @_;
	open my $nlist, "/proc/net/${pro}6" or die "can't open /proc/net/${pro}6: $!";
	my $shex = ip6_hex $$p{src}, 1;
	my $dhex = ip6_hex $$p{dst}, 1;
	my $ss1 = sprintf ' %s:%04X %s:%04X', $shex, $$p{sport}, $dhex, $$p{dport};
	my $ss2 = sprintf ' %s:%04X %s:%04X', $dhex, $$p{dport}, $shex, $$p{sport};
	while (<$nlist>) {
		if (index($_,$ss1) != -1 || index($_,$ss2) != -1) {
			#/^\s*\d+: [0-9A-F:]+ [0-9A-F:]+ ([0-9A-F]+) [0-9A-F:]+ [0-9A-F:]+ [0-9A-F]+\s+(\d+)\s+\d+\s+(\d+)/;
			/^\s*\d+: [0-9A-F:]+ [0-9A-F:]+ [0-9A-F]+ [0-9A-F:]+ [0-9A-F:]+ [0-9A-F]+\s+(\d+)\s+\d+\s+(\d+)/;
			($$p{x}{uid},$$p{x}{inode}) = ($1,$2);
			last;
		}
	}
	close $nlist;
}

sub find_raw {
	my $p = shift;
#	print STDERR "find_raw: $$p{disp}\n";
	open my $nlist, "/proc/net/raw" or die "can't open /proc/net/raw: $!";
	while (<$nlist>) {
		#1: 00000000:0001 00000000:0000 07 0000011C:00000000 00:00000000 00000000     0        0 5049885 3 f7ccd280
		($$p{x}{uid},$$p{x}{inode}) = /^\s*\d+: [0-9A-F:]+ [0-9A-F:]+ [0-9A-F]+ [0-9A-F:]+ [0-9A-F:]+ [0-9A-F]+\s+(\d+)\s+\d+\s+(\d+)/;
	}
	close $nlist;

	return if $$p{x}{inode};
	return unless -e '/proc/net/raw6';
	open $nlist, '/proc/net/raw6' or die $!;
	while (<$nlist>) {
		($$p{x}{uid},$$p{x}{inode}) = /^\s*\d+: [0-9A-F:]+ [0-9A-F:]+ [0-9A-F]+ [0-9A-F:]+ [0-9A-F:]+ [0-9A-F]+\s+(\d+)\s+\d+\s+(\d+)/;
	}
	close $nlist;
}

sub lookup_t {
	scan_proc;
	my $scan_queued = 0;
	my %rescan : shared;
	$rescan{_RESCAN} = 1;
	while (1) {
		my $p = $lookup->dequeue;
		my $x = $$p{x};
		last if exists $$p{_EXIT};
		
		if (exists $$p{_RESCAN}) {
			scan_proc;
			$scan_queued = 0;
			next;
		}
		
		print STDERR "Lookup: $$p{disp}\n";
		my $pro = $$p{proto};
		
		unless ($$x{inode}) {
			if ($pro eq 'tcp' || $pro eq 'udp') {
				$$p{src} =~ /:/ ? 
					find_tu6 $pro,$p:
					find_tu4 $pro,$p;
			} else {
				find_raw $p
			}
		}
		
		next unless $$x{inode};
		print STDERR "Found inode=$$x{inode} - ";
		my $pid = get_pid $$x{inode};
		unless (defined $pid) {
			print STDERR "not in list\n";
			next if $$p{rescan}; #we've already rescanned and this one failed twice. Kill it.
			$$p{rescan} = 1;
			$lookup->enqueue(\%rescan) unless $scan_queued;
			$scan_queued = 1;
			$lookup->enqueue($p); #ok, now put it last in line
			next;
		}
		$$x{pid} = $pid;
		print STDERR "belongs to pid $pid\n";
		open my $cmd, "/proc/$pid/cmdline" or next;
		$_ = <$cmd>;
		close $cmd;
		s#(^|\0)/[^\0]+/(\S+)(\0|$)#$1$2$3#; # or print STDERR "Error in regex: $_";
		s/[\0\n]/ /g;
		$$x{process} = $pid.'/'.$_;
		$$x{uid_n} = '['.getpwuid($$x{uid}).']';
		$$x{redisp} = 1;
	}
}

sub ctwatch {
	print STDERR "hello from ctwatch\n";
	$ctpid = open my $w, 'conntrack -E|';
	$w->autoflush(1);
	die "error opening conntrack events: $!" unless $ctpid;
	while (<$w>) {{
		print STDERR $_;
		lock %conn;
		s/\s+/ /g;
		s/^\s*\[(\S+)\] // or warn "bad line from event pipe";
		my $t = $1;
		my $p = getdat $_;
		if ($t eq 'NEW') {
			$lookup->enqueue($p);
			if (exists $conn{$$p{uuid}}) {
				$$p{x} = $conn{$$p{uuid}}{x};
				$$p{x}{ref}++;
			} else {
				$conn{$$p{uuid}} = $p;
				lock @connl;
				push @connl, $$p{uuid};
			}
		} elsif ($t eq 'UPDATE') {
			$$p{x} = $conn{$$p{uuid}}{x} if exists $conn{$$p{uuid}};
			$$p{x}{redisp} = 1;
			$conn{$$p{uuid}} = $p;
			if (exists $$p{t_state} && $$p{proto} eq 'tcp') {
				$lookup->enqueue($p) if $$p{x}{t_st_o} eq 'SYN_RECV' && $$p{t_state} eq 'ESTABLISHED';
				$$p{x}{t_st_o} = $$p{t_state};
			}
		} elsif ($t eq 'DESTROY') {
			$$p{x} = $conn{$$p{uuid}}{x} if exists $conn{$$p{uuid}};
			$$p{x}{redisp} = 1;
			$conn{$$p{uuid}} = $p;
			$$p{disp} =~ s/\S+$/DELETED/;
			$$p{x}{ref}--;
		} else {
			warn "bad line from event pipe";
		}
	}}
}

sub ctin {
	lock %conn;
	lock @connl;
	open C, 'conntrack -L|' or die "error opening conntrack list: $!";
	open CT, 'conntrack -f ipv6 -L|' or warn "can't open IPv6 conntrack list: $!";
	my $ctw = $_[0] ? threads->new(\&ctwatch) : 0;
	my %oldl = map {$_ => 1} @connl;
	while (<C>) {
		my $p = getdat $_;
		$lookup->enqueue($p);
		$conn{$$p{uuid}} = $p;
		push @connl, $$p{uuid} unless exists $oldl{$$p{uuid}}
	}
	while (<CT>) {
		my $p = getdat $_;
		$lookup->enqueue($p);
		$conn{$$p{uuid}} = $p;
		push @connl, $$p{uuid} unless exists $oldl{$$p{uuid}}
	}
	close C;
	close CT;
	$ctw
}

sub winrange {
	lock @connl;
	my $r = shift;
	my ($rx,$ry); getmaxyx $rx,$ry;
	$rx--;$ry--;
	my $aim = int $rx/2;
	my ($min,$max);
	if ($#connl >= $rx) {
		$min = 
			($r < $aim) ? 0 :
			($rx + $r - $aim >= @connl) ? @connl - $rx :
			$r - $aim;
		$max = $min + $rx - 1;
		$max = $#connl if $max > $#connl;
	} else {
		$min = 0;
		$max = $#connl;
	}
#	print STDERR "At line $r of $#connl on a $rx line screen. Displaying $min..$max\n";
	($min,$max,$ry)
}

my ($omin,$owinw) = (0,0);

sub ctdisp {
	my ($r,$redisp) = @_;
	lock %conn;
	lock @connl;
	my ($min,$max,$ry) = winrange $r;
	$redisp = 1 unless $min == $omin && $ry == $owinw;
	($omin,$owinw) = ($min,$ry);

	clear if $redisp;
	addstr 0,1,'proto            source                  destination          sent  rcvd  state  Sort order:'.$sortorder if $redisp;
	for ($min..$max) {
		next unless exists $conn{$connl[$_]};
		next unless $redisp || $conn{$connl[$_]}{x}{redisp} || $_ == $r;
		next if !$redisp && $_ == $r && $conn{$connl[$_]}{x}{redisp} == 2;

		$conn{$connl[$_]}{x}{redisp} = ($_ == $r) ? 2 : 0;

		my $ys = $ry - length ${$conn{$connl[$_]}}{x}{uid_n};
		if ($_ == $r) {
			attron A_REVERSE;
			addstr 1 + $_ - $min, 1, sprintf "\%-${ys}.${ys}s\%s", 
				"$conn{$connl[$_]}{disph} ${$conn{$connl[$_]}}{x}{process}", ${$conn{$connl[$_]}}{x}{uid_n};
			attroff A_REVERSE;
		} else {
			addstr 1 + $_ - $min, 1, sprintf "\%-${ys}.${ys}s\%s", 
				"$conn{$connl[$_]}{disp} ${$conn{$connl[$_]}}{x}{process}", ${$conn{$connl[$_]}}{x}{uid_n};
		}	
	}
	move 1 + $r - $min, 0;
}

sub ctdel {
	my $k = shift;
	my $p = $conn{$k};
	return if not defined $p;
	my $c = "conntrack -D -s $$p{src} -d $$p{dst} -p $$p{proto}";
	if ($$p{proto} eq 'tcp' || $$p{proto} eq 'udp') {
		$c .= " --orig-port-src $$p{sport} --orig-port-dst $$p{dport}";
	} elsif ($$p{proto} eq 'icmp') {
		$c .= " --icmp-type $$p{type} --icmp-code $$p{code} --icmp-id $$p{id}";
	} else {
		return
	}
	print STDERR "$c\n";
	system $c;
}

sub ctsweep {
	lock @connl;
	my $r = shift;
	my ($om,$ox) = winrange $$r;
	
	my @ol = @connl;
	@connl = ();
	
	my $mark = 0;
	
	$conn{$ol[$$r]}{_PTR} = 1;

	for (@ol) {
		next unless exists $conn{$_};
		if (!$conn{$_}{x}{ref} || !exists $conn{$_}{disp}) {
			$$r = 0 if $conn{$_}{_PTR};
			delete $conn{$_};
			$mark = 1;
		} else {
			push @connl, $_;
			$$r = $#connl if $conn{$_}{_PTR};
			$conn{$_}{x}{redisp} = 1 if $mark || $conn{$_}{_PTR};
			delete $conn{$_}{_PTR};
		}
	}
	my ($nm,$nx,$yx) = winrange $$r;
	$yx++;
	for (($nx+1)..$ox) {
		addstr 1 + $_ - $nm, 0, ' 'x$yx;
	}
}

sub reorder {
	$sortorder = 
		$sortorder eq 'pid' ? 'source' :
		$sortorder eq 'source' ? 'dest' :
		'pid';
}

sub resort {
	lock %conn;
	lock @connl;
	if ($sortorder eq 'source') {
		@connl = sort {
			my ($c,$d) = ($conn{$a}{src}, $conn{$b}{src});
			($c =~ /:/ ? ip6_hex($c,0) : '~'.pack('C4' => $c =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/))
				cmp
			($d =~ /:/ ? ip6_hex($d,0) : '~'.pack('C4' => $d =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/));
	 	} @connl;
	} elsif ($sortorder eq 'dest') {
		@connl = sort {
			my ($c,$d) = ($conn{$a}{dst}, $conn{$b}{dst});
			($c =~ /:/ ? ip6_hex($c,0) : '~'.pack('C4' => $c =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/))
				cmp
			($d =~ /:/ ? ip6_hex($d,0) : '~'.pack('C4' => $d =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/));
	 	} @connl;
	} else {
		@connl = sort {
			my ($c,$d) = ($conn{$a}{x}{pid}, $conn{$b}{x}{pid});
			$c ? $d ? $c <=> $d : -1
			   : $d ? 1         : 0 
		} @connl;
	}
}

my $lthread = threads->new(\&lookup_t);
my $wthread = ctin 1;
my ($r,$rdisp,$sleep,$pause) = (0,1,0,0);

initscr;
keypad 1;
noecho;
timeout 500;

while (1) {
	ctdisp $r,$rdisp;
	refresh;
	$rdisp = 0;
	my $i = getch;
	$sleep = 10 unless $i eq ERR;
	ctsweep \$r unless $sleep-- > 0 || $pause;
	
	if ($i eq 'q') { 
		last;
	} elsif ($i eq 'd') {
		ctdel $connl[$r];
	} elsif ($i eq 'R') {
		kill TERM => $ctpid;
		$wthread->join;
		1 while defined $lookup->dequeue_nb;
		$wthread = ctin 1;
		$rdisp=1;
		ctsweep \$r;
	} elsif ($i eq 'r') {
		ctin 0;
		$rdisp=1;
		ctsweep \$r;
	} elsif ($i eq 'p') {
		$pause = !$pause;
		addstr 0,75,$pause ? 'paused' : 'state ';
		$sleep = 0;
	} elsif ($i eq 's') {
		resort;
		$rdisp = 1;
	} elsif ($i eq 'S') {
		reorder;
		resort;
		$rdisp = 1;
	} elsif ($i eq KEY_UP) {
		$r--;
	} elsif ($i eq KEY_DOWN) {
		$r++;
	} elsif ($i eq KEY_NPAGE) {
		my($rx,$ry); getmaxyx $rx,$ry;
		$r += $rx - 1;
	} elsif ($i eq KEY_PPAGE) {
		my($rx,$ry); getmaxyx $rx,$ry;
		$r -= $rx - 1;
	}
	$r = $#connl if $r < 0;
	$r = 0 if $r > $#connl;
}
endwin;
kill TERM => $ctpid;
1 while defined $lookup->dequeue_nb; #flush the queue
my %x : shared = (_EXIT => 1);
$lookup->enqueue(\%x);
$wthread->join;
$lthread->join;