#!C:\perl\bin\perl.exe 
# Note: run under wperl.exe for no DOS window.

use Tk;
use strict;
use warnings;

# Repeatedly scan certain ports and their immediate neighbors.
my @ports = (4899, 8080); # Win32 RAdmin, XML-RPC.
my $range = 5;            # How many neigbhbors ports.
my $seconds = 30;         # How long to wait between scans.
my $minutes = 60;         # How long to keep re-scaning.

my %mw_hash;
my $netstat = "C:\\WINNT\\System32\\netstat.exe";

sub clear_screen {
    my $cmd;
    if ($^O =~ /win32/i) {$cmd = 'cls'} 
    else {$cmd = 'clear'}
    system($cmd);
}

sub ferret {
    my ($line, @ports) = @_;
    my ($protocol, $local, $other, $status) = 
        split(/\s+/, $line, 4);
    my ($local_addr, $local_port) = split(/:/, $local);
    my ($other_addr, $other_port) = split(/:/, $other);
    my @scan;
    foreach (@ports) { 
        if  ($local_port =~ /$_/){
            if ($status =~ /ESTABLISHED/) {               
                push @scan, "$local_port -> $other_addr\n";
                start_MainLoop($local_port,$other,'okay') 
                    unless Tk::Exists($mw_hash{$local_port})
            } else { 
                quit_one_MainLoop($mw_hash{$local_port})
            }
            push @scan, "$local_port listening...\n" 
                if $status =~ /LISTENING/;
            push @scan, "$local_port waiting...\n" 
                if $status =~ /TIME_WAIT/;
        }
    }
    return @scan;
}

# Scan a range of ports,
sub scan_range {
    my $range = shift;

    my @ports;
    foreach (@_) {push @ports, ($_-$range .. $_+$range)}; 

    open(NETSTAT, "$netstat -a -p tcp|") 
        or die "Oops! Cannot run netstat: $! \n";
    my $report;
    while(<NETSTAT>) {
        next unless $_ =~ /TCP/; 
        $_ =~ s/^\s+//;
        $report .=  join "\n", ferret($_, @ports);
    }
    close(NETSTAT);

    $report = "Ports idle...\n" unless $report;
    clear_screen();
    return "$report\n";
}

# Pop up a Tk window for each ESTABLISHED socket.
sub start_MainLoop {
    my ($local_port, $msg_txt, $button_txt ) = @_;
    $mw_hash{$local_port} = 
        MainWindow->new( -title => 'Periscope' );
    $mw_hash{$local_port}->Label( 
        -text               => " $msg_txt ", 
        -justify            => 'left',
        -font               => 'courier',
    )->pack( -side => 'top', -expand => 1, -fill => 'x' );
    $mw_hash{$local_port}->Button(
        -width            => (length($button_txt) + 2),
        -relief           => 'raised',
        -background       => 'blue',
        -activebackground => 'green',
        -command          => sub {
                                 quit_one_MainLoop(
                                     $mw_hash{$local_port}
                                 )
                             },
        -text             => $button_txt, 
    )->pack( -side => 'left', -expand => 1, -fill => 'x' );
    $mw_hash{$local_port}->Button(
        -width            => (length($button_txt) + 2),
        -relief           => 'raised',
        -background       => 'orange',
        -activebackground => 'red',
        -command          => \&quit_all_MainLoops,
        -text             => 'Exit All', 
    )->pack( -side => 'left', -expand => 1, -fill => 'x' );
    MainLoop;
}

# Close down the Perl/Tk GUI
sub quit_one_MainLoop { 
    my $mw = shift; 
    $mw->destroy() if Tk::Exists($mw) 
}

sub quit_all_MainLoops {
    foreach (keys %mw_hash) { 
        quit_one_MainLoop($mw_hash{$_})
    }
}

my $scans = int($minutes / $seconds * 60);

for (1 .. $scans) { 
    print "Scan $_ of $scans \n", scan_range($range, @ports);
    sleep $seconds; 
}