Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

Tk app to show the computers you are connecting to

by jepri (Parson)
on Feb 13, 2001 at 13:50 UTC ( #58113=perlcraft: print w/ replies, xml ) Need Help??

   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:    

Comment on Tk app to show the computers you are connecting to
Download Code
Re: Tk app to show the computers you are connecting to
by TheoPetersen (Priest) on Feb 13, 2001 at 23:58 UTC
    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.

      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.

Re: Tk app to show the computers you are connecting to
by SilverB1rd (Scribe) on Feb 16, 2001 at 01:39 UTC
    Thank you for fixing the problem. Cool script BTW.
Re: Tk app to show the computers you are connecting to
by Fingo (Monk) on Mar 04, 2001 at 02:57 UTC
    Anwser to line 25: This could probably be exploited, and become a security risk, but I am not sure. Good prog.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlcraft [id://58113]
Approved by root
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (2)
As of 2014-07-31 03:41 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (244 votes), past polls