Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
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":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • 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 wandering the Monastery: (4)
    As of 2025-06-15 10:24 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      No recent polls found

      Notices?
      erzuuliAnonymous Monks are no longer allowed to use Super Search, due to an excessive use of this resource by robots.