"SfR Fresh" - the SfR Freeware/Shareware Archive 
Member "scandns-0.1/scandns.pl" of archive scandns-0.1.tar.gz:
As a special service "SfR Fresh" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting with prefixed line numbers.
Alternatively you can here view or download the uninterpreted source code file.
That can be also achieved for any archive member file by clicking within an archive contents listing on the first character of the file(path) respectively on the according byte size field.
1 #!/usr/bin/perl
2 #
3 # File: scandns.pl
4 # Summary: dns cleanup tool
5 #
6 # Author: Jon Schatz
7 # E-Mail: jon@divisionbyzero.com
8 # Org:
9 #
10 # Orig-Date: 22-Mar-00 at 13:30:53
11 # Last-Mod: 19-Jun-00 at 16:24:42 by
12 #
13 # This program is free software; you can redistribute it and/or modify it
14 # under the terms of the GNU General Public License as published
15 # by the Free Software Foundation; either version 1, or (at your option)
16 # any later version.
17 #
18 # This program is distributed in the hope that it will be useful,
19 # but WITHOUT ANY WARRANTY; without even the implied warranty of
20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either
21 # the GNU General Public License or the Artistic License for more details.
22 #
23 #
24 # $Source: /home/jschatz/.cvs/el/file-hdr/hdr.perl,v $
25 # $Date: 1999/12/23 00:06:23 $
26 # $Revision: 1.1.1.1 $
27 # $Author: tkunze $
28 # $State: Exp $
29 # $Locker: $
30 #
31 # -*- EOF -*-
32 #!/usr/bin/perl -w
33
34 use IO::Socket;
35 use Net::Netmask;
36 use strict;
37
38 my ($network)=@ARGV;
39
40 #separate the netmask from the network
41
42 my ($ip_address,$netmask) = split /[\/||:]/ , $network;
43 my $address;
44
45 &usage unless ($ip_address); #complain if @ARGV was incorrect
46 &badip unless (&validip($ip_address)); #copmlain if $ip_address is invalid
47
48 #complain if $netmask is bad. unfortunately Net::Netmask only warns if it's
49 #given an invalid netmask. I'm working on a patch so that the module will
50 #be smart enough to return something useful when it cant parse the netmask.
51
52 &badnet unless (&validnet($netmask));
53
54 #if the netmask is given as a netmask (ie, 255.255.255.0 as opposed to CIDR
55 # notation (/24)), then ditch the "/" since Net::Netmask isn't smart enough
56 # to do that either.
57
58 $network=~s/\//:/ if (validip($netmask));
59
60 #create the netmask object
61
62 (my $obj=Net::Netmask->new ($network)) or die "Invalid address / netmask\n";
63
64 #return an array of all addresses in the given network
65
66 my (@addresses)=$obj->enumerate();
67
68
69 foreach $address (@addresses) {
70 &checkdns($address);
71 }
72
73 #the good stuff
74
75 sub checkdns {
76 my ($ip_address)=@_;
77 my ($packed_ip_address)=&get_packed_ip($ip_address);
78 my ($hostname)=gethostbyaddr($packed_ip_address, AF_INET);
79
80 if (! $hostname) {
81 &no_ptr("$ip_address");
82 return;
83 }
84
85 my $reverse_packed_ip_address;
86 $reverse_packed_ip_address=gethostbyname($hostname);
87
88 if (length($reverse_packed_ip_address)!=4) {
89 &no_a("$ip_address","$hostname");
90 return;
91 }
92
93 my ($reverse_ip_address)=inet_ntoa($reverse_packed_ip_address);
94
95 if ($reverse_ip_address ne $ip_address) {
96 print("$ip_address => $hostname => $reverse_ip_address \n");
97 }
98
99 else {
100 print("$ip_address => $hostname \n");
101 }
102 }
103
104 sub no_ptr {
105 my ($ip_address)=@_;
106 print "$ip_address => no PTR record\n";
107
108 return;
109 }
110
111 sub no_a {
112 my ($ip_address, $hostname)=@_;
113 print "$ip_address => $hostname => $hostname has no A record\n";
114 return;
115 }
116
117 sub badip {
118 print "$ip_address is an invalid address.\n";
119 exit 1;
120 }
121
122 sub badnet {
123 print "/$netmask is an invalid netmask.\n";
124 exit 1;
125 }
126
127 sub usage {
128 print "Usage: scandns.pl <address>[/netmask]\n";
129 exit 1;
130 }
131
132 sub validnet {
133 my ($netmask)=@_;
134 return(1) if (validip($netmask)) ;
135 return(1) if (($netmask>=0)&&($netmask<=32));
136 }
137
138 #this is an ip checker that seems simpler to me than the enormous regex in
139 #the cookbook. since it's only executed twice, it's probably not generating
140 #that much overhead.
141
142 sub validip {
143 my ($ip)=@_;
144 my $x;
145 foreach ($ip=~/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/){
146 $x++ if(($_>=0)&&($_<=255));
147 }
148 return($x==4);
149 }
150
151 sub get_packed_ip {
152
153 my ($ip)=@_;
154 chomp $ip;
155 my $a;
156 my $b;
157 my $c;
158 my $d;
159 ($a, $b, $c, $d)=split(/\./,$ip);
160 my $packed_ip=pack "C4","$a","$b","$c","$d";
161 return $packed_ip;
162 }
163
164 sub bin2dec {
165 my $str= unpack("B8", pack("N", shift));
166 $str=~s/^0+(?=\d)//;
167 return $str;
168 }
169
170 sub dec2bin {
171 return unpack("N",pack("B8", substr("0"x 8, -8)));
172 }