Tk app to show the computers you are connecting to

[jepri]

   1: #!/usr/bin/perl 
   2: #This program has been tested on Debian 2.2 and Win2k, and works fine on both 
   3: #All comments encouraged, the nice ones will be appreciated 
   4: #GPL by Jepri 
   5:  
   6:  
   7: #Things that could be added to make this extremely neat: 
   8: #Assign unique numbers to the open connections so that we can see 
   9: #how long they've been open for 
  10:  
  11: #Add a little bit of AI to detect evil banner server sites 
  12:  
  13: #Find a way to swat the connections that we don't like 
  14:  
  15: #Copy selected IP addresses to the clipboard so the user can paste them into 
  16: #junkbuster. 
  17:  
  18: #Or just insert them ourselves... 
  19:  
  20: #OS cheat.  Unix and BSD always have /etc/passwd 
  21: -e '/etc/passwd' or my $windows=1; 
  22: if ($windows) { 
  23:  print  "Updating windows installation...\n\n\n"; 
  24:  require PPM; 
  25:  #Returns a list of all the installed packages.  Why can't CPAN do the same? 
  26:  my %temp=PPM::InstalledPackageProperties(); 
  27:  PPM::InstallPackage("package" => "Tk") unless $temp{Tk};  
  28:  PPM::InstallPackage("package" => "Net::DNS") unless $temp{qw(Net-DNS)};  
  29: } 
  30: else { 
  31:  #Painfull way of finding if modules are installed.  Should be eval('require module'); 
  32:  my %mods=( Tk=>0, 'Net/DNS'=>0 ); 
  33:  print "Updating *nix installation\n"; 
  34:  print @INC; 
  35:  foreach $dir (@INC) { 
  36:   foreach $file (keys %mods) { 
  37:    $mods{$file}=1 if (`ls -lR $dir | grep $file`); 
  38:   } 
  39:  }  
  40:  my $needtoload=0; 
  41:  foreach $file (keys %mods) {$needtoload=1 unless $mods{$file};} 
  42:  if ($needtoload) { 
  43:   require CPAN; 
  44:   for $mod (qw(Tk Net::DNS)){  
  45:    my $obj = CPAN::Shell->expand('Module',$mod);  
  46:    $obj->install;  
  47:   } 
  48:  } 
  49: } 
  50:  
  51: require Tk; 
  52: require Tk::After; 
  53: require Tk::Listbox; 
  54:  
  55: require Net::DNS::Resolver; 
  56: require Net::DNS::Packet; 
  57: require Net::DNS::RR; 
  58:  
  59: use Socket; 
  60: use strict; 
  61: use diagnostics; 
  62:  
  63: my %ripname;  #Cache of DNS lookups by addr 
  64: my $nextconnum=1;  #Increment each time you use it to assign a unique number to a connection 
  65: my $res = new Net::DNS::Resolver; 
  66: my $packet=new Net::DNS::Packet; 
  67: #Replace these IP numbers with your own DNS servers. Only do this if perl fails  
  68: #to detect your nameserver automatically 
  69: #$res->nameservers("10.0.0.1 10.0.0.2);  #Space separated list of nameservers to query 
  70: $res->tcp_timeout(30);    #If we don't get a result in 30 secs we never will 
  71: $res->retry(1);      #Screw retrying too 
  72: my @connlist;      #Should have the following keys: id (unique), proto, lip, lp, rip, rp, state 
  73: my $numofconnections=0;    #number of currently open connections 
  74: my %pending;      #List of IPs being looked up 
  75: my %socket;       #sockets corresponding to IP lookups 
  76: my %broken;       #IP numbers which can't be looked up 
  77: my %activetime;      #Total time links to site have been open (by ip) 
  78: my $timerperiod=1000;    #what it says, make it larger if your 
  79:          #system starts to grind 
  80: my @visited; 
  81:  
  82:  
  83:  
  84: #Might as well do the states while I'm here.  I can never pass up the chance to be  
  85: #a smartarse <- Note spelling, this is the right way. 
  86: my %portstate=(ESTABLISHED=>"In progress", SYN_WAIT=>"Dolphin!", TIME_WAIT=>"Closing", CLOSE_WAIT=>"Closing", FIN_WAIT=>"Dolphin!!"); 
  87: #If you see too many dolphins in your connection list then something fishy 
  88: #is going on :) 
  89:  
  90: my $main = MainWindow->new; 
  91: $main->title("Status"); 
  92: my $top1 = $main->Toplevel;  
  93: $top1->title("All visited sites"); 
  94: my $currconn; 
  95:  
  96:  $top1->Label(-text => 'All the computers you have connected to')->pack();   
  97: #my $allcons=$top1->Listbox(-height=>0,-width=>0)->pack; 
  98: my $allcons = $top1->Scrolled('Listbox',-relief => "sunken", 
  99:         -background => "gray60", 
 100:         -width => 90, 
 101:         -height => 30,)->pack(-expand => 1, -fill => 'both' ); 
 102:  
 103:  
 104: my $Timer = Tk::After->new($main,$timerperiod,'repeat',\&update);  
 105: my %listbox; 
 106:  
 107: sub make_win { 
 108: $currconn = $main ->Toplevel; 
 109: $currconn->title("Current connections"); 
 110: $currconn->Label(-text => 'Computers you are connecting to')->pack;   
 111: $listbox{proto}= $currconn->Listbox(-height=>0,-width=>0);#->pack(-side=>"left"); 
 112: $listbox{lip}= $currconn->Listbox(-height=>0,-width=>0);#->pack(-side=>"left"); 
 113: #$listbox{lp}= $currconn->Listbox(-height=>0,-width=>0)->pack(-side=>"left"); 
 114: $listbox{rip}= $currconn->Listbox(-height=>0,-width=>0)->pack(-side=>"left"); 
 115: $listbox{rp}= $currconn->Listbox(-height=>0,-width=>0)->pack(-side=>"left"); 
 116: $listbox{state}= $currconn->Listbox(-height=>0,-width=>0)->pack(-side=>"left"); 
 117: } 
 118:  
 119: sub dest_win { 
 120: $currconn->destroy; 
 121: } 
 122:  
 123:  
 124: make_win(); 
 125:  
 126: my $DNScalls = $main -> Label(-text => 'DNS calls active: 0')->pack(-side=>'top'); 
 127: my $DNSbroken = $main -> Label(-text => 'DNS calls failed: 0')->pack(-side=>'top'); 
 128: my $totalips = $main -> Label(-text => 'Total hosts visited: 0')->pack(-side=>'top'); 
 129: my $dispcurrconns = $main -> Label(-text => 'Total connections active: 0')->pack(-side=>'top'); 
 130:  
 131:  
 132:  
 133:  
 134: #This hands control to the Tk module, everything we do happens on a callback 
 135: Tk::MainLoop(); 
 136:  
 137:  
 138:  
 139: sub update { 
 140:  do_DNS(); 
 141:  my @connections = get_connlist(); 
 142:  unless ($numofconnections == @connections) { 
 143:   if ($numofconnections<@connections) { 
 144:    dest_win(); 
 145:    make_win(); 
 146:    $numofconnections=@connections; 
 147:   } 
 148:  } 
 149:  @connlist=(); 
 150:  if ($#connections) { 
 151:   foreach (@connections) { 
 152:    my $regexp; 
 153:    if ($windows) {$regexp='\s+(\S+)\s+(\S+):(\d+)\s+(\S+):(\d+)\s+(\S+)'} 
 154:    else {$regexp='(\S+)\s+\S+\s+\S+\s+(\S+):(\d+)\s+(\S+):(\d+)\s+(\S+)'} 
 155:    reset; 
 156:    if (/$regexp/){ 
 157:    push @connlist, { id=>$nextconnum++, proto=>$1, lip=>$2, lp=>$3, rip=>$4, rp=>$5, state=>$6}; 
 158:    $activetime{$4}+=$timerperiod; 
 159:    } 
 160:   } 
 161:  } 
 162:   
 163:  
 164:  foreach my $key (keys %listbox) {$listbox{$key}->delete(0,'end');} 
 165:   
 166:  #This updates the list of all connected machines unless the user is currently inspecting it. 
 167:  unless ( $allcons->focusCurrent == $top1) { 
 168:  $allcons->delete(0,'end'); 
 169:  foreach my $key (keys %ripname) {$allcons->insert(0,$ripname{$key});} 
 170:  } 
 171:  #Populate connection list in window 
 172:  foreach my $i (0..$#connlist) { 
 173:   $ripname{$connlist[$i]{rip}}=$connlist[$i]{rip} unless ($ripname{$connlist[$i]{rip}}); 
 174:   $listbox{proto}->insert(0,$connlist[$i]{proto}); 
 175:   $listbox{lip}->insert(0, $connlist[$i]{lip}); 
 176:   #$listbox{lp}->insert(0, protobyport($connlist[$i]{lp})); 
 177:   $listbox{rip}->insert(0, $ripname{$connlist[$i]{rip}}); 
 178:   my $x; 
 179:   if (protobyport($connlist[$i]{rp}) eq "Unknown") {$x=protobyport($connlist[$i]{lp});} else {$x=protobyport($connlist[$i]{rp})} 
 180:   $listbox{rp}->insert(0, $x); 
 181:   $listbox{state}->insert(0,$portstate{$connlist[$i]{state}}); 
 182:  } 
 183:  $listbox{proto}-> insert(0,"What's happening?"); 
 184:  $listbox{rip}->insert(0,"Other machine"); 
 185:  $listbox{rp}->insert(0,"Link type"); 
 186:  #$listbox{lp}->insert(0,"Link type"); 
 187:  $listbox{state}->insert(0,"Status"); 
 188:   
 189:  $DNScalls->configure(-text=> "DNS calls in progress: ".scalar(keys(%socket))); 
 190:  $DNSbroken->configure(-text=>  "DNS calls failed: ".scalar(keys(%broken))); 
 191:  $totalips->configure(-text=>  "Total hosts visited: ".scalar(keys(%ripname))); 
 192:  $dispcurrconns ->configure(-text => "Total connections active: ".scalar(@connections)); 
 193:   
 194:  
 195: } 
 196:  
 197:  
 198: sub do_DNS { 
 199:  foreach my $ips (keys %ripname) { 
 200:   #If $ips hasn't been resolved to a hostname 
 201:   if ($ips eq $ripname{$ips}){ 
 202:    #And it's not in the process of being resolved, or otherwise dead 
 203:    unless ($broken{$ips} or $pending{$ips}) { 
 204:     #Put it on the pending list 
 205:     $pending{$ips} = 1; 
 206:     #Start an IP->Hostname lookup on it 
 207:     $socket{$ips} = $res->bgsend($ips);  
 208:    }   
 209:   } 
 210:  } 
 211:  #Now go through the pending list and see if any have been successfully 
 212:  #looked up since the last time we checked 
 213:  foreach my $ips (keys %pending) { 
 214:   #If we have a result... 
 215:   if ($socket{$ips} && $res->bgisready($socket{$ips})) { 
 216:    #Read our result 
 217:    $packet = $res->bgread($socket{$ips}); 
 218:    #Clean up 
 219:    delete $socket{$ips}; 
 220:    delete $pending{$ips}; 
 221:    my @answer=$packet->answer if $packet; 
 222:    #If no RRs then IP does not have an official hostname, put it 
 223:    #on the broken list 
 224:    if (@answer == 0) {$broken{$ips}=1;} 
 225:    else { 
 226:     foreach my $rr (@answer) { 
 227:      #Calling this on a bad RR has the convenient effect 
 228:      #of ending this Tk::Timer callback  
 229:      #IIRC only PTRs may be used in reverse zones 
 230:      if ($rr->type eq "PTR") { 
 231:       $ripname{$ips}=$rr->ptrdname; 
 232:      } else { 
 233:       $broken{$ips}=1; 
 234:      } 
 235:      last; 
 236:     } 
 237:    } 
 238:   } 
 239:   else { 
 240:    #print "It's not ready yet :(\n"; 
 241:   } 
 242:  } 
 243: } 
 244:  
 245: sub protobyport { 
 246:  my $portnum=shift; 
 247:  #For some reason I can't get the portnames working under windows so I get to do port naming  
 248:  #for myself.  Oh well, it's a bit of fun for me 
 249:  my %protobyport=( 
 250:  80=>"World Wide Wait",  
 251:  110=>"Receiving Mail",  
 252:  143=>"Receiving Mail",  
 253:  23=>"Telnet",  
 254:  21 =>"FTP",  
 255:  25=>"Sending Mail",  
 256:  1234=>"Back Orifice.  You have been hacked.  Hahahahah");  
 257:   
 258:  if ($protobyport{$portnum}) { 
 259:   return $protobyport{$portnum}; 
 260:  } 
 261:  else { 
 262:   #Insert the proper linux getprotobynum or whatever it's called... 
 263:   #return $portnum; 
 264:   return "Unknown"; 
 265:  } 
 266: } 
 267:  
 268: sub get_connlist { 
 269: #I could do this so much better with the marvellous Net::Pcap module 
 270: #but then I couldn't have used it on windows, which is an operating system 
 271: #that needs this kind of utility more than Linux does. 
 272:  if ($windows) { 
 273:   my $connections = `netstat -n`; 
 274:   $connections =~ s/(.*)State..//s; 
 275:   return split(/\n/, $connections); 
 276:  } 
 277:  else{ 
 278:   my $connections = `netstat -n -Ainet`; 
 279:   $connections =~ s/(?:..*)State..//s; 
 280:   return split(/\n/, $connections); 
 281:  } 
 282: } 
 283:    

[TheoPetersen]

Nice work. Runs fine on RedHat 6.x

Column headers for the "Current connections" windows would be nice, for those who didn't write the app.

Line 68: make that a parameter, or check for /etc/resolv.conf and get the value from there.

Line 134: right.

There's a classic blunder at line 143: check to see if the regexp actually matched before you use $4 elsewhere.

At 157, you should check to see if $connlist[$i]{rip} is defined before using it as a hash element. Also, the () around an unless or if modifier aren't necessary.

Line 218, assign a default value to $portnum to avoid another undefined value error.

And so on. Some basic cleanup before posting is a nice thing, but it's a good start.

[jepri]

Thanks for the feedback, Theo. I updated it according to your comments. There's more to be done, but it's scratched my itch - it helps identify naughty sites to go in junkbuster.

____________________
Jeremy
I didn't believe in evil until I dated it.

[Fingo]

Anwser to line 25: This could probably be exploited, and become a security risk, but I am not sure. Good prog.

[SilverB1rd]

Thank you for fixing the problem. Cool script BTW.