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: 