Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

comment on

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

In reply to Tk app to show the computers you are connecting to by jepri

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others scrutinizing the Monastery: (4)
As of 2024-03-28 21:15 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found