perlcraft
jepri
#!/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);
}
}