#!/usr/bin/perl 
#This program has been tested on Debian 2.2 and Win2k, and works fine on both 
#All comments encouraged, the nice ones will be appreciated 
#GPL by Jepri 
 
 
#Things that could be added to make this extremely neat: 
#Assign unique numbers to the open connections so that we can see 
#how long they've been open for 
 
#Add a little bit of AI to detect evil banner server sites 
 
#Find a way to swat the connections that we don't like 
 
#Copy selected IP addresses to the clipboard so the user can paste them into 
#junkbuster. 
 
#Or just insert them ourselves... 
 
#OS cheat.  Unix and BSD always have /etc/passwd 
-e '/etc/passwd' or my $windows=1; 
if ($windows) { 
 print  "Updating windows installation...\n\n\n"; 
 require PPM; 
 #Returns a list of all the installed packages.  Why can't CPAN do the same? 
 my %temp=PPM::InstalledPackageProperties(); 
 PPM::InstallPackage("package" => "Tk") unless $temp{Tk};  
 PPM::InstallPackage("package" => "Net::DNS") unless $temp{qw(Net-DNS)};  
} 
else { 
 #Painfull way of finding if modules are installed.  Should be eval('require module'); 
 my %mods=( Tk=>0, 'Net/DNS'=>0 ); 
 print "Updating *nix installation\n"; 
 print @INC; 
 foreach $dir (@INC) { 
  foreach $file (keys %mods) { 
   $mods{$file}=1 if (`ls -lR $dir | grep $file`); 
  } 
 }  
 my $needtoload=0; 
 foreach $file (keys %mods) {$needtoload=1 unless $mods{$file};} 
 if ($needtoload) { 
  require CPAN; 
  for $mod (qw(Tk Net::DNS)){  
   my $obj = CPAN::Shell->expand('Module',$mod);  
   $obj->install;  
  } 
 } 
} 
 
require Tk; 
require Tk::After; 
require Tk::Listbox; 
 
require Net::DNS::Resolver; 
require Net::DNS::Packet; 
require Net::DNS::RR; 
 
use Socket; 
use strict; 
use diagnostics; 
 
my %ripname;  #Cache of DNS lookups by addr 
my $nextconnum=1;  #Increment each time you use it to assign a unique number to a connection 
my $res = new Net::DNS::Resolver; 
my $packet=new Net::DNS::Packet; 
#Replace these IP numbers with your own DNS servers. Only do this if perl fails  
#to detect your nameserver automatically 
#$res->nameservers("10.0.0.1 10.0.0.2);  #Space separated list of nameservers to query 
$res->tcp_timeout(30);    #If we don't get a result in 30 secs we never will 
$res->retry(1);      #Screw retrying too 
my @connlist;      #Should have the following keys: id (unique), proto, lip, lp, rip, rp, state 
my $numofconnections=0;    #number of currently open connections 
my %pending;      #List of IPs being looked up 
my %socket;       #sockets corresponding to IP lookups 
my %broken;       #IP numbers which can't be looked up 
my %activetime;      #Total time links to site have been open (by ip) 
my $timerperiod=1000;    #what it says, make it larger if your 
         #system starts to grind 
my @visited; 
 
 
 
#Might as well do the states while I'm here.  I can never pass up the chance to be  
#a smartarse <- Note spelling, this is the right way. 
my %portstate=(ESTABLISHED=>"In progress", SYN_WAIT=>"Dolphin!", TIME_WAIT=>"Closing", CLOSE_WAIT=>"Closing", FIN_WAIT=>"Dolphin!!"); 
#If you see too many dolphins in your connection list then something fishy 
#is going on :) 
 
my $main = MainWindow->new; 
$main->title("Status"); 
my $top1 = $main->Toplevel;  
$top1->title("All visited sites"); 
my $currconn; 
 
 $top1->Label(-text => 'All the computers you have connected to')->pack();   
#my $allcons=$top1->Listbox(-height=>0,-width=>0)->pack; 
my $allcons = $top1->Scrolled('Listbox',-relief => "sunken", 
        -background => "gray60", 
        -width => 90, 
        -height => 30,)->pack(-expand => 1, -fill => 'both' ); 
 
 
my $Timer = Tk::After->new($main,$timerperiod,'repeat',\&update);  
my %listbox; 
 
sub make_win { 
$currconn = $main ->Toplevel; 
$currconn->title("Current connections"); 
$currconn->Label(-text => 'Computers you are connecting to')->pack;   
$listbox{proto}= $currconn->Listbox(-height=>0,-width=>0);#->pack(-side=>"left"); 
$listbox{lip}= $currconn->Listbox(-height=>0,-width=>0);#->pack(-side=>"left"); 
#$listbox{lp}= $currconn->Listbox(-height=>0,-width=>0)->pack(-side=>"left"); 
$listbox{rip}= $currconn->Listbox(-height=>0,-width=>0)->pack(-side=>"left"); 
$listbox{rp}= $currconn->Listbox(-height=>0,-width=>0)->pack(-side=>"left"); 
$listbox{state}= $currconn->Listbox(-height=>0,-width=>0)->pack(-side=>"left"); 
} 
 
sub dest_win { 
$currconn->destroy; 
} 
 
 
make_win(); 
 
my $DNScalls = $main -> Label(-text => 'DNS calls active: 0')->pack(-side=>'top'); 
my $DNSbroken = $main -> Label(-text => 'DNS calls failed: 0')->pack(-side=>'top'); 
my $totalips = $main -> Label(-text => 'Total hosts visited: 0')->pack(-side=>'top'); 
my $dispcurrconns = $main -> Label(-text => 'Total connections active: 0')->pack(-side=>'top'); 
 
 
 
 
#This hands control to the Tk module, everything we do happens on a callback 
Tk::MainLoop(); 
 
 
 
sub update { 
 do_DNS(); 
 my @connections = get_connlist(); 
 unless ($numofconnections == @connections) { 
  if ($numofconnections<@connections) { 
   dest_win(); 
   make_win(); 
   $numofconnections=@connections; 
  } 
 } 
 @connlist=(); 
 if ($#connections) { 
  foreach (@connections) { 
   my $regexp; 
   if ($windows) {$regexp='\s+(\S+)\s+(\S+):(\d+)\s+(\S+):(\d+)\s+(\S+)'} 
   else {$regexp='(\S+)\s+\S+\s+\S+\s+(\S+):(\d+)\s+(\S+):(\d+)\s+(\S+)'} 
   reset; 
   if (/$regexp/){ 
   push @connlist, { id=>$nextconnum++, proto=>$1, lip=>$2, lp=>$3, rip=>$4, rp=>$5, state=>$6}; 
   $activetime{$4}+=$timerperiod; 
   } 
  } 
 } 
  
 
 foreach my $key (keys %listbox) {$listbox{$key}->delete(0,'end');} 
  
 #This updates the list of all connected machines unless the user is currently inspecting it. 
 unless ( $allcons->focusCurrent == $top1) { 
 $allcons->delete(0,'end'); 
 foreach my $key (keys %ripname) {$allcons->insert(0,$ripname{$key});} 
 } 
 #Populate connection list in window 
 foreach my $i (0..$#connlist) { 
  $ripname{$connlist[$i]{rip}}=$connlist[$i]{rip} unless ($ripname{$connlist[$i]{rip}}); 
  $listbox{proto}->insert(0,$connlist[$i]{proto}); 
  $listbox{lip}->insert(0, $connlist[$i]{lip}); 
  #$listbox{lp}->insert(0, protobyport($connlist[$i]{lp})); 
  $listbox{rip}->insert(0, $ripname{$connlist[$i]{rip}}); 
  my $x; 
  if (protobyport($connlist[$i]{rp}) eq "Unknown") {$x=protobyport($connlist[$i]{lp});} else {$x=protobyport($connlist[$i]{rp})} 
  $listbox{rp}->insert(0, $x); 
  $listbox{state}->insert(0,$portstate{$connlist[$i]{state}}); 
 } 
 $listbox{proto}-> insert(0,"What's happening?"); 
 $listbox{rip}->insert(0,"Other machine"); 
 $listbox{rp}->insert(0,"Link type"); 
 #$listbox{lp}->insert(0,"Link type"); 
 $listbox{state}->insert(0,"Status"); 
  
 $DNScalls->configure(-text=> "DNS calls in progress: ".scalar(keys(%socket))); 
 $DNSbroken->configure(-text=>  "DNS calls failed: ".scalar(keys(%broken))); 
 $totalips->configure(-text=>  "Total hosts visited: ".scalar(keys(%ripname))); 
 $dispcurrconns ->configure(-text => "Total connections active: ".scalar(@connections)); 
  
 
} 
 
 
sub do_DNS { 
 foreach my $ips (keys %ripname) { 
  #If $ips hasn't been resolved to a hostname 
  if ($ips eq $ripname{$ips}){ 
   #And it's not in the process of being resolved, or otherwise dead 
   unless ($broken{$ips} or $pending{$ips}) { 
    #Put it on the pending list 
    $pending{$ips} = 1; 
    #Start an IP->Hostname lookup on it 
    $socket{$ips} = $res->bgsend($ips);  
   }   
  } 
 } 
 #Now go through the pending list and see if any have been successfully 
 #looked up since the last time we checked 
 foreach my $ips (keys %pending) { 
  #If we have a result... 
  if ($socket{$ips} && $res->bgisready($socket{$ips})) { 
   #Read our result 
   $packet = $res->bgread($socket{$ips}); 
   #Clean up 
   delete $socket{$ips}; 
   delete $pending{$ips}; 
   my @answer=$packet->answer if $packet; 
   #If no RRs then IP does not have an official hostname, put it 
   #on the broken list 
   if (@answer == 0) {$broken{$ips}=1;} 
   else { 
    foreach my $rr (@answer) { 
     #Calling this on a bad RR has the convenient effect 
     #of ending this Tk::Timer callback  
     #IIRC only PTRs may be used in reverse zones 
     if ($rr->type eq "PTR") { 
      $ripname{$ips}=$rr->ptrdname; 
     } else { 
      $broken{$ips}=1; 
     } 
     last; 
    } 
   } 
  } 
  else { 
   #print "It's not ready yet :(\n"; 
  } 
 } 
} 
 
sub protobyport { 
 my $portnum=shift; 
 #For some reason I can't get the portnames working under windows so I get to do port naming  
 #for myself.  Oh well, it's a bit of fun for me 
 my %protobyport=( 
 80=>"World Wide Wait",  
 110=>"Receiving Mail",  
 143=>"Receiving Mail",  
 23=>"Telnet",  
 21 =>"FTP",  
 25=>"Sending Mail",  
 1234=>"Back Orifice.  You have been hacked.  Hahahahah");  
  
 if ($protobyport{$portnum}) { 
  return $protobyport{$portnum}; 
 } 
 else { 
  #Insert the proper linux getprotobynum or whatever it's called... 
  #return $portnum; 
  return "Unknown"; 
 } 
} 
 
sub get_connlist { 
#I could do this so much better with the marvellous Net::Pcap module 
#but then I couldn't have used it on windows, which is an operating system 
#that needs this kind of utility more than Linux does. 
 if ($windows) { 
  my $connections = `netstat -n`; 
  $connections =~ s/(.*)State..//s; 
  return split(/\n/, $connections); 
 } 
 else{ 
  my $connections = `netstat -n -Ainet`; 
  $connections =~ s/(?:..*)State..//s; 
  return split(/\n/, $connections); 
 } 
}