psa-chapter05.txt

perl语言的经典文章

#*
#* generate complete set of DNS config files and check into RCS
#*

use Rcs;

$datafile   = "./database"; # our host database
$outputfile = "zone.$$";    # our temporary output file
$target     = "zone.db";    # our target output
$revtarget  = "rev.db";     # out target output for the reverse mapping
$defzone    = ".oog.org";   # the default zone being created
$recordsep  = "-=-\n";     

# get today's date in the form of YYYYMMDD 
@localtime = localtime;
$today = sprintf("%04d%02d%02d",$localtime[5]+1900,
                                $localtime[4]+1,
                                $localtime[3]);

# get username on either NT/2000 or UNIX
$user = ($^O eq "MSWin32")? $ENV{USERNAME} :
                            (getpwuid($<))[6]." (".(getpwuid($<))[0].")";

$/=$recordsep;

# read in the database file
open(DATA,$datafile) or die "Unable to open datafile:$!\n";

while (<DATA>) {
    chomp; # remove record separator
    # split into key1,value1
    @record = split /:\s*|\n/m; 

    $record ={};                     # create a reference to empty hash
    %{$record} = @record;            # populate that hash with @record

    # check for bad hostname
    if ($record->{name} =~ /[^-.a-zA-Z0-9]/) {
	warn "!!!! ",$record->{name} .
	     " has illegal host name characters, skipping...\n";
	next;
    }

    # check for bad aliases
    if ($record->{aliases} =~ /[^-.a-zA-Z0-9\s]/) {
	warn "!!!! " . $record->{name} .
	     " has illegal alias name characters, skipping...\n";
	next;
    }

    # check for missing address
    unless ($record->{address}) {
	warn "!!!! " . $record->{name} .
             " does not have an IP address, skipping...\n";
	next;
    }

    # check for duplicate address
    if (defined $addrs{$record->{address}}) {
	warn "!!!! Duplicate IP addr:" . $record->{name}.
	     " & " . $addrs{$record->{address}} . ", skipping...\n";
	next;
    }
    else {
	$addrs{$record->{address}} = $record->{name};
    }

    $entries{$record->{name}} = $record; # add this to a hash of hashes

}
close(DATA);

$header = &GenerateHeader;

# create the forward mapping file
open(OUTPUT,"> $outputfile") or 
  die "Unable to write to $outputfile:$!\n";
print OUTPUT $header;

foreach my $entry (sort byaddress keys %entries) {
    print OUTPUT
          "; Owned by ",$entries{$_}->{owner}," (",
          $entries{$entry}->{department},"): ",
          $entries{$entry}->{building},"/",
          $entries{$entry}->{room},"\n";

    # print A record
    printf OUTPUT "%-20s\tIN A     %s\n",      
      $entries{$entry}->{name},$entries{$entry}->{address};

    # print any CNAMES (aliases)
    if (defined $entries{$entry}->{aliases}){
	foreach my $alias (split(' ',$entries{$entry}->{aliases})) {
	    printf OUTPUT "%-20s\tIN CNAME %s\n",$alias,
		                                 $entries{$entry}->{name};
	}
    }
    print OUTPUT "\n";
}

close(OUTPUT);

Rcs->bindir('/usr/local/bin');
my $rcsobj = Rcs->new;
$rcsobj->file($target);
$rcsobj->co('-l');
rename($outputfile,$target) or 
  die "Unable to rename $outputfile to $target:$!\n";
$rcsobj->ci("-u","-m"."Converted by $user on ".scalar(localtime));

# now create the reverse mapping file
open(OUTPUT,"> $outputfile") or 
  die "Unable to write to $outputfile:$!\n";
print OUTPUT $header;
foreach my $entry (sort byaddress keys %entries) {
    print OUTPUT
          "; Owned by ",$entries{$entry}->{owner}," (",
          $entries{$entry}->{department},"): ",
          $entries{$entry}->{building},"/",
          $entries{$entry}->{room},"\n";

    printf OUTPUT "%-3d\tIN PTR    %s$defzone.\n\n", 
      (split/\./,$entries{$entry}->{address})[3], $entries{$entry}->{name};

}

close(OUTPUT);
$rcsobj->file($revtarget);
$rcsobj->co('-l'); # assumes target has been checked out at least once
rename($outputfile,$revtarget) or 
  die "Unable to rename $outputfile to $revtarget:$!\n";
$rcsobj->ci("-u","-m"."Converted by $user on ".scalar(localtime));

sub GenerateHeader{
    my($header);
    if (open(OLDZONE,$target)){
	while (<OLDZONE>) {
	    next unless (/(\d{8}).*serial/);
	    $oldserial = $1;
	    last;
	}
	close(OLDZONE);
    }
    else {
	$oldserial = "000000";
    }
    
    $olddate = substr($oldserial,0,6);
    $count = ($olddate == $today) ? substr($oldserial,6,2)+1 : 0;

    $serial = sprintf("%6d%02d",$today,$count);

    $header .= "; dns zone file - GENERATED BY $0\n";
    $header .= "; DO NOT EDIT BY HAND!\n;\n";
    $header .= "; Converted by $user on ".scalar(localtime)."\n;\n";

    # count the number of entries in each department and then report
    foreach $entry (keys %entries){
        $depts{$entries{$entry}->{department}}++;
    }
    foreach $dept (keys %depts) {
        $header .= "; number of hosts in the $dept department: 
                    $depts{$dept}.\n";
    }
    $header .= "; total number of hosts: ".scalar(keys %entries)."\n#\n\n";

    $header .= <<"EOH";

@ IN SOA   dns.oog.org. hostmaster.oog.org. (
                          $serial ; serial
                            10800    ; refresh
                            3600     ; retry
                            604800   ; expire
                            43200)   ; TTL

@                           IN  NS  dns.oog.org.

EOH

    return $header;
}

sub byaddress {
   @a = split(/\./,$entries{$a}->{address});
   @b = split(/\./,$entries{$b}->{address});
   ($a[0]<=>$b[0]) ||
   ($a[1]<=>$b[1]) ||
   ($a[2]<=>$b[2]) ||
   ($a[3]<=>$b[3]);
}
-------
#*
#* checking DNS server response integrity using nslookup
#*

use Data::Dumper;

$hostname = $ARGV[0];
$nslookup = "/usr/local/bin/nslookup";              # nslookup binary
@servers = qw(nameserver1 nameserver2 nameserver3); # name of the name servers
foreach $server (@servers) {
    &lookupaddress($hostname,$server);              # populates %results
}
%inv = reverse %results;                            # invert the result hash
if (scalar(keys %inv) > 1) {                       
    print "There is a discrepancy between DNS servers:\n";
    print Data::Dumper->Dump([\%results],["results"]),"\n";
}

# ask the server to look up the IP address for the host
# passed into this program on the command line, add info to 
# the %results hash
sub lookupaddress {
    my($hostname,$server) = @_;

    open(NSLOOK,"$nslookup $hostname $server|") or
      die "Unable to start nslookup:$!\n";
    
    while (<NSLOOK>) {
        # ignore until we hit "Name: "
	next until (/^Name:/);              
        # next line is Address: response
	chomp($results{$server} = <NSLOOK>); 
        # remove the field name
        die "nslookup output error\n" unless /Address/;
	$results{$server} =~ s/Address(es)?:\s+//;	    
        # we're done with this nslookup 
        last;
    }
    close(NSLOOK);
}
-------
#*
#* checking DNS server response integrity "by hand" using raw sockets
#*

use IO::Socket;
$hostname = $ARGV[0];
$defdomain = ".oog.org"; # default domain if not present

@servers = qw(nameserver1 nameserver2 nameserver3); # name of the name servers
foreach $server (@servers) {
    &lookupaddress($hostname,$server);              # populates %results
}
%inv = reverse %results;        # invert the result hash
if (scalar(keys %inv) > 1) {    # see how many elements it has
    print "There is a discrepancy between DNS servers:\n";
    use Data::Dumper;
    print Data::Dumper->Dump([\%results],["results"]),"\n";
}

sub lookupaddress{
    my($hostname,$server) = @_;

    my($qname,$rname,$header,$question,$lformat,@labels,$count);
    local($position,$buf);

    ###
    ### Construct the packet header
    ###
    $header = pack("n C2 n4", 
		   ++$id,  # query id
		   1,  # qr, opcode, aa, tc, rd fields (only rd set)
		   0,  # rd, ra
		   1,  # one question (qdcount)
		   0,  # no answers (ancount)
		   0,  # no ns records in authority section (nscount)
		   0); # no addtl rr's (arcount)

    # if we do not have any separators in the name of the host, 
    # append the default domain
    if (index($hostname,'.') == -1) {
	$hostname .= $defdomain;
    }
    
    # construct the qname section of a packet (domain name in question) 
    for (split(/\./,$hostname)) {
	$lformat .= "C a* ";
	$labels[$count++]=length;
	$labels[$count++]=$_;
    }
    
    ###
    ### construct the packet question section
    ###
    $question = pack($lformat."C n2",
		     @labels,
		     0,  # end of labels
		     1,  # qtype of A 
		     1); # qclass of IN
    
    ###
    ### send the packet to the server and read the response
    ###
    $sock = new IO::Socket::INET(PeerAddr => $server,
				 PeerPort => "domain",
				 Proto    => "udp");
    
    $sock->send($header.$question);
    # we're using UDP, so we know the max packet size
    $sock->recv($buf,512); 
    close($sock);
    
    # get the size of the response, since we're going to have to keep 
    # track of where we are in the packet as we parse it (via $position)
    $respsize = length($buf);
    
    ### 
    ### unpack the header section
    ###
    ($id,
     $qr_opcode_aa_tc_rd,
     $rd_ra,
     $qdcount,
     $ancount,
     $nscount,
     $arcount) = unpack("n C2 n4",$buf);
    
    if (!$ancount) {
	warn "Unable to lookup data for $hostname from $server!\n";
	return;
    }

    ###
    ### unpack the question section
    ###
    # question section starts 12 bytes in
    ($position,$qname) = &decompress(12); 
    ($qtype,$qclass)=unpack('@'.$position.'n2',$buf);
    # move us forward in the packet to end of question section
    $position += 4; 
    
    ###
    ### unpack all of the resource record sections
    ###
    for ( ;$ancount;$ancount--){
	($position,$rname) = &decompress($position);
	($rtype,$rclass,$rttl,$rdlength)=
	  unpack('@'.$position.'n2 N n',$buf);
	$position +=10;
        # this next line could be changed to use a more sophisticated 
        # data structure, it currently picks the last rr returned            
        $results{$server}=
	  join('.',unpack('@'.$position.'C'.$rdlength,$buf));
	$position +=$rdlength;
    }
}    

# handle domain information which is "compressed" as per RFC1035
# we take in the starting position of our packet parse and return
# the name we found (after dealing with the compressed format pointer)
# and the place we left off in the packet at the end of the name we found
sub decompress { 
    my($start) = $_[0];
    my($domain,$i,$lenoct);
    
    for ($i=$start;$i<=$respsize;) { 
	$lenoct=unpack('@'.$i.'C', $buf); # get the length of label

	if (!$lenoct){        # 0 signals we are done with this section
	    $i++;
	    last;
	}

	if ($lenoct == 192) { # we've been handed a pointer, so recurse
	    $domain.=(&decompress((unpack('@'.$i.'n',$buf) & 1023)))[1];
	    $i+=2;
	    last
	}
	else {                # otherwise, we have a plain label
	    $domain.=unpack('@'.++$i.'a'.$lenoct,$buf).'.';
	    $i += $lenoct;
	}
    }
    return($i,$domain);
}
-------
#*
#* checking DNS server response integrity using Net::DNS
#*

use Net::DNS;

@servers = qw(nameserver1 nameserver2 nameserver3); # name of the name servers
foreach $server (@servers) {
    &lookupaddress($hostname,$server);              # populates %results
}
%inv = reverse %results;        # invert the result hash
if (scalar(keys %inv) > 1) {   # see how many elements it has
    print "There is a discrepency between DNS servers:\n";
    use Data::Dumper;
    print Data::Dumper->Dump([\%results],["results"]),"\n";
}

# only slightly modified from example in the Net::DNS manpage
sub lookupaddress{
    my($hostname,$server) = @_;

    $res = new Net::DNS::Resolver;

    $res->nameservers($server);

    $packet = $res->query($hostname);

    if (!$packet) {
	warn "Unable to lookup data for $hostname from $server!\n";
	return;
    }
    # stores the last RR we receive
    foreach $rr ($packet->answer) {
	$results{$server}=$rr->address;
    }
}