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: