mirror of
				https://github.com/xcat2/xcat-core.git
				synced 2025-10-31 03:12:30 +00:00 
			
		
		
		
	git-svn-id: https://svn.code.sf.net/p/xcat/code/xcat-core/trunk@6026 8638fb3e-16cb-4fca-ae20-7b5d299a9bcd
		
			
				
	
	
		
			663 lines
		
	
	
		
			25 KiB
		
	
	
	
		
			Perl
		
	
	
	
	
	
			
		
		
	
	
			663 lines
		
	
	
		
			25 KiB
		
	
	
	
		
			Perl
		
	
	
	
	
	
| package xCAT_plugin::dns;
 | |
| use strict;
 | |
| use Getopt::Long;
 | |
| use Net::DNS;
 | |
| use xCAT::Table;
 | |
| use Sys::Hostname;
 | |
| use MIME::Base64;
 | |
| use Socket;
 | |
| use Fcntl qw/:flock/;
 | |
| #This is a rewrite of DNS management using nsupdate rather than direct zone mangling
 | |
| 
 | |
| my $callback;
 | |
| 
 | |
| sub handled_commands
 | |
| {
 | |
|     return {"makedns" => "dns"};
 | |
| }
 | |
| sub get_reverse_zone_for_entity {
 | |
|     my $ctx = shift;
 | |
|     my $node = shift;
 | |
|     my $net;
 | |
|     if ($ctx->{hoststab} and $ctx->{hoststab}->{$node} and $ctx->{hoststab}->{$node}->[0]->{ip}) {
 | |
|         $node = $ctx->{hoststab}->{$node}->[0]->{ip};
 | |
|     }
 | |
|     my $tvar;
 | |
|     if ($tvar = inet_aton($node)) { #This is an assignment, we are testing and storing the value in one shot
 | |
|         $tvar = unpack("N",$tvar);
 | |
|         foreach my $net (keys %{$ctx->{nets}}) {
 | |
|             if ($ctx->{nets}->{$net}->{netn} == ($tvar & $ctx->{nets}->{$net}->{mask})) {
 | |
|                 my $maskstr = unpack("B32",pack("N",$ctx->{nets}->{$net}->{mask}));
 | |
|                 my $maskcount = ($maskstr =~ tr/1//);
 | |
|                 $maskcount+=((8-($maskcount%8))%8); #round to the next octet
 | |
|                 my $newmask = 2**$maskcount -1 << (32 - $maskcount);
 | |
|                 my $rev = inet_ntoa(pack("N",($tvar & $newmask)));
 | |
|                 my @zone;
 | |
|                 my @orig=split /\./,$rev;
 | |
|                 while ($maskcount) {
 | |
|                     $maskcount-=8;
 | |
|                     unshift(@zone,(shift @orig));
 | |
|                 }
 | |
|                 $rev = join('.',@zone);
 | |
|                 $rev .= '.IN-ADDR.ARPA';
 | |
|                 return $rev;
 | |
|             }
 | |
|         }
 | |
|     }
 | |
|     return undef;
 | |
| }
 | |
| 
 | |
| sub process_request {
 | |
|     my $request = shift;
 | |
|     $callback = shift;
 | |
|     umask 0007;
 | |
|     my $ctx = {};
 | |
|     my @nodes=();
 | |
|     my $hadargs=0;
 | |
|     my $allnodes;
 | |
|     my $zapfiles;
 | |
|     if ($request->{arg}) {
 | |
|         $hadargs=1;
 | |
|         @ARGV=@{$request->{arg}};
 | |
|         if (!GetOptions(
 | |
|             'a|all' => \$allnodes,
 | |
|             'n|new' => \$zapfiles,
 | |
|             )) {
 | |
|             sendmsg([1,"TODO: makedns Usage message"]);
 | |
|             return;
 | |
|         }
 | |
|     }
 | |
|         
 | |
|     my $sitetab = xCAT::Table->new('site');
 | |
|     my $stab = $sitetab->getAttribs({key=>'domain'},['value']);
 | |
|     unless ($stab and $stab->{value}) {
 | |
|         sendmsg([1,"domain not defined in site table"]);
 | |
|         return;
 | |
|     }
 | |
|     $ctx->{domain} = $stab->{value};
 | |
| 
 | |
|     if ($request->{node}) { #we have a noderange to process
 | |
|         @nodes = @{$request->{node}};
 | |
|     } elsif ($allnodes) {
 | |
|         #read all nodelist specified nodes
 | |
|     } else { 
 | |
|         #legacy behavior, read from /etc/hosts
 | |
|         my $hostsfile;
 | |
|         open($hostsfile,"<","/etc/hosts");
 | |
|         flock($hostsfile,LOCK_SH);
 | |
|         my @contents = <$hostsfile>;
 | |
|         flock($hostsfile,LOCK_UN);
 | |
|         close($hostsfile);
 | |
|         my $domain = $ctx->{domain};
 | |
|         unless ($domain =~ /^\./) { $domain = '.'.$domain; }
 | |
|         my $addr;
 | |
|         my $name;
 | |
|         my $canonical;
 | |
|         my $aliasstr;
 | |
|         my @aliases;
 | |
|         my $names;
 | |
|         foreach (@contents) {
 | |
|             chomp; #no newline
 | |
|             s/#.*//; #strip comments;
 | |
|             s/^[ \t\n]*//; #remove leading whitespace
 | |
|             next unless ($_); #skip empty lines
 | |
|             ($addr,$names) = split /[ \t]+/,$_,2;
 | |
|             if ($addr !~ /^\d+\.\d+\.\d+\.\d+$/) {
 | |
|                 sendmsg(":Ignoring line $_ in /etc/hosts, only IPv4 format entries are supported currently");
 | |
|                 next;
 | |
|             }
 | |
|             unless ($names =~ /^[a-z0-9\. \t\n-]+$/i) {
 | |
|                 sendmsg(":Ignoring line $_ in /etc/hosts, names  $names contain invalid characters (valid characters include a through z, numbers and the '-', but not '_'");
 | |
|                 next;
 | |
|             }
 | |
|             ($canonical,$aliasstr)  = split /[ \t]+/,$names,2;
 | |
|             if ($aliasstr) {
 | |
|                 @aliases= split /[ \t]+/,$aliasstr;
 | |
|             } else {
 | |
|                 @aliases = ();
 | |
|             }
 | |
|             my %names = ();
 | |
|             my $node = $canonical;
 | |
|             unless ($canonical =~ /$domain/) {
 | |
|                 $canonical.=$domain;
 | |
|             }
 | |
|             unless ($canonical =~ /\.\z/) { $canonical .= '.' } #for only the sake of comparison, ensure consistant dot suffix
 | |
|             foreach my $alias (@aliases) {
 | |
|                 unless ($alias =~ /$domain/) {
 | |
|                     $alias .= $domain;
 | |
|                 }
 | |
|                 unless ($alias =~ /\.\z/) {
 | |
|                     $alias .= '.';
 | |
|                 }
 | |
|                 if ($alias eq $canonical) {
 | |
|                     next;
 | |
|                 }
 | |
|                 $ctx->{aliases}->{$node}->{$alias}=1; #remember alias for CNAM records later
 | |
|             }
 | |
|             push @nodes,$node;
 | |
|             $ctx->{nodeips}->{$node}->{$addr}=1;
 | |
|         }
 | |
|     }
 | |
|     my $hoststab = xCAT::Table->new('hosts',-create=>0);
 | |
|     if ($hoststab) {
 | |
|         $ctx->{hoststab} = $hoststab->getNodesAttribs(\@nodes,['ip']);
 | |
|     }
 | |
|     $ctx->{nodes} = \@nodes;
 | |
|     my $networkstab = xCAT::Table->new('networks',-create=>0);
 | |
|     unless ($networkstab) { sendmsg([1,'Unable to enumerate networks, try to run makenetworks']); }
 | |
|     my @networks = $networkstab->getAllAttribs('net','mask');
 | |
|     foreach (@networks) {
 | |
|         my $maskn = unpack("N",inet_aton($_->{mask}));
 | |
|         $ctx->{nets}->{$_->{net}}->{mask} = $maskn;
 | |
|         $ctx->{nets}->{$_->{net}}->{netn} = unpack("N",inet_aton($_->{net}));
 | |
|     }
 | |
|     my $passtab = xCAT::Table->new('passwd');
 | |
|     my $pent = $passtab->getAttribs({key=>'omapi',username=>'xcat_key'},['password']);
 | |
|     if ($pent and $pent->{password}) { 
 | |
|         $ctx->{privkey} = $pent->{password};
 | |
|     } #do not warn/error here yet, if we can't generate or extract, we'll know later
 | |
|     $stab =  $sitetab->getAttribs({key=>'forwarders'},['value']);
 | |
|     if ($stab and $stab->{value}) {
 | |
|         my @forwarders = split /[ ,]/,$stab->{value};
 | |
|         $ctx->{forwarders}=\@forwarders;
 | |
|     }
 | |
|     $ctx->{zonestotouch}->{$ctx->{domain}}=1;
 | |
|     foreach (@nodes) {
 | |
|         my $revzone =  get_reverse_zone_for_entity($ctx,$_);;
 | |
|         unless ($revzone) { next; }
 | |
|         $ctx->{revzones}->{$_} = $revzone;
 | |
|         $ctx->{zonestotouch}->{$ctx->{revzones}->{$_}}=1;
 | |
|     }
 | |
|     if (1) { #TODO: function to detect and return 1 if the master server is DNS SOA for all the zones we care about
 | |
|         #here, we are examining local files to assure that our key is in named.conf, the zones we care about are there, and that if
 | |
|         #active directory is in use, allow the domain controllers to update specific zones
 | |
|         $stab =$sitetab->getAttribs({key=>'directoryprovider'},['value']);
 | |
|         if ($stab and $stab->{value} and $stab->{value} eq 'activedirectory') {
 | |
|             $stab =$sitetab->getAttribs({key=>'directoryservers'},['value']);
 | |
|             if ($stab and $stab->{value} and $stab->{value}) {
 | |
|                 my @dservers = split /[ ,]/,$stab->{value};
 | |
|                 $ctx->{adservers} = \@dservers;
 | |
|                 $ctx->{adzones} = {
 | |
|                     "_msdcs.". $ctx->{domain} => 1,
 | |
|                     "_sites.". $ctx->{domain} => 1,
 | |
|                     "_tcp.". $ctx->{domain} => 1,
 | |
|                     "_udp.". $ctx->{domain} => 1,
 | |
|                 };
 | |
|             }
 | |
|         }
 | |
|         $stab =$sitetab->getAttribs({key=>'dnsupdaters'},['value']); #allow unsecure updates from these
 | |
|         if ($stab and $stab->{value} and $stab->{value}) {
 | |
|                 my @nservers = split /[ ,]/,$stab->{value};
 | |
|                 $ctx->{dnsupdaters} = \@nservers;
 | |
|         }
 | |
|         if ($zapfiles) { #here, we unlink all the existing files to start fresh
 | |
|             system("/sbin/service named stop"); #named may otherwise hold on to stale journal filehandles
 | |
|             unlink "/etc/named.conf";
 | |
|             foreach (</var/named/db.*>) {
 | |
|                 unlink $_;
 | |
|             }
 | |
|             foreach (</var/lib/named/db.*>) {
 | |
|                 unlink $_;
 | |
|             }
 | |
|         }
 | |
|         #We manipulate local namedconf
 | |
|         $ctx->{dbdir} = get_dbdir();
 | |
|         chmod 0775, $ctx->{dbdir}; # assure dynamic dns can actually execute against the directory
 | |
|         update_namedconf($ctx); 
 | |
|         update_zones($ctx);
 | |
|         if ($ctx->{restartneeded}) {
 | |
|             sendmsg("Restarting named");
 | |
|             system("/sbin/service named start");
 | |
|             system("/sbin/service named reload");
 | |
|             sendmsg("Restarting named complete");
 | |
|         }
 | |
|     } else {
 | |
|         unless ($ctx->{privkey}) {
 | |
|             sendmsg([1,"Unable to update DNS due to lack of credentials in passwd to communicate with remote server"]);
 | |
|         }
 | |
|     }
 | |
|     #now we stick to Net::DNS style updates, with TSIG if possible.  TODO: kerberized (i.e. Windows) DNS server support, maybe needing to use nsupdate -g....
 | |
|     $ctx->{resolver} = Net::DNS::Resolver->new();
 | |
|     add_records($ctx);
 | |
| }
 | |
| 
 | |
| sub get_dbdir {
 | |
|     if (-d "/var/named") {
 | |
|         return "/var/named/";
 | |
|     } elsif (-d "/var/lib/named") {
 | |
|         return "/var/lib/named/";
 | |
|     } else {
 | |
|         use File::Path;
 | |
|         mkpath "/var/named/";
 | |
|         chown(scalar(getpwnam('named')),scalar(getgrnam('named')),"/var/named");
 | |
|         return "/var/named/";
 | |
|     }
 | |
| }
 | |
| 
 | |
| sub update_zones {
 | |
|     my $ctx = shift;
 | |
|     my $currzone;
 | |
|     my $dbdir = $ctx->{dbdir};
 | |
|     my $domain = $ctx->{domain};
 | |
|     my $name = hostname;
 | |
|     my $node = $name;
 | |
|     unless ($domain =~ /^\./) {
 | |
|         $domain = '.'.$domain;
 | |
|     }
 | |
|     unless ($name =~ /\./) {
 | |
|         $name .= $domain;
 | |
|     }
 | |
|     unless ($name =~ /\.\z/) {
 | |
|         $name .= '.';
 | |
|     }
 | |
|     my $ip=$node;
 | |
|     if ($ctx->{hoststab} and $ctx->{hoststab}->{$node} and $ctx->{hoststab}->{$node}->[0]->{ip}) {
 | |
|         $ip = $ctx->{hoststab}->{$node}->[0]->{ip};
 | |
|     } else {
 | |
|         unless ($ip = inet_aton($ip)) {
 | |
|             print "Unable to find an IP for $node in hosts table or via system lookup (i.e. /etc/hosts";
 | |
|             sendmsg([1,"Unable to find an IP for $node in hosts table or via system lookup (i.e. /etc/hosts"]);
 | |
|             next;
 | |
|         }
 | |
|         $ip = inet_ntoa($ip);
 | |
|     }
 | |
|     my @neededzones = keys %{$ctx->{zonestotouch}};
 | |
|     push @neededzones,keys %{$ctx->{adzones}};
 | |
|     my ($sec, $min, $hour, $mday, $mon, $year, $rest) = localtime(time);
 | |
|     my $serial = ($mday * 100) + (($mon + 1) * 10000) + (($year + 1900) * 1000000);
 | |
|     foreach $currzone (@neededzones) {
 | |
|         my $zonefilename = $currzone;
 | |
|         if ($currzone =~ /IN-ADDR\.ARPA/) {
 | |
|             $currzone =~ s/\.IN-ADDR\.ARPA.*//;
 | |
|             my @octets = split/\./,$currzone;
 | |
|             $currzone = join('.',reverse(@octets));
 | |
|             $zonefilename = $currzone;
 | |
|         } else {
 | |
|             $zonefilename =~ s/\..*//; #compatible with bind.pm
 | |
|         }
 | |
|         unless (-f $dbdir."/db.$zonefilename") {
 | |
|             my $zonehdl;
 | |
|             open($zonehdl,">>",$dbdir."/db.$zonefilename");
 | |
|             flock($zonehdl,LOCK_EX);
 | |
|             seek($zonehdl,0,0);
 | |
|             truncate($zonehdl,0);
 | |
|             print $zonehdl '$TTL 86400'."\n";
 | |
|             print $zonehdl '@ IN SOA '.$name." root.$name ( $serial 10800 3600 604800 86400 )\n";
 | |
|             print $zonehdl "  IN NS  $name\n";
 | |
|             if ($name =~ /$currzone/) { #Must guarantee an A record for the DNS server
 | |
|                 print $zonehdl "$name  IN A  $ip\n";
 | |
|             }
 | |
|             flock($zonehdl,LOCK_UN);
 | |
|             close($zonehdl);
 | |
|             chown(scalar(getpwnam('named')),scalar(getgrnam('named')),$dbdir."/db.$zonefilename");
 | |
|             $ctx->{restartneeded}=1;
 | |
|         }
 | |
|     }
 | |
| }
 | |
| 
 | |
| 
 | |
| 
 | |
| sub update_namedconf {
 | |
|     my $ctx = shift;
 | |
|     my $namedlocation = '/etc/named.conf';
 | |
|     my $nameconf;
 | |
|     my @newnamed;
 | |
|     my $gotoptions=0;
 | |
|     my $gotkey=0;
 | |
|     my %didzones;
 | |
|     if (-r $namedlocation) {
 | |
|         my @currnamed=();
 | |
|         open($nameconf,"<",$namedlocation);
 | |
|         flock($nameconf,LOCK_SH);
 | |
|         @currnamed=<$nameconf>;
 | |
|         flock($nameconf,LOCK_UN);
 | |
|         close($nameconf);
 | |
|         my $i = 0;
 | |
|         for ($i=0;$i<scalar(@currnamed);$i++) {
 | |
|             my $line = $currnamed[$i];
 | |
|             if ($line =~ /^options +\{/) {
 | |
|                 $gotoptions=1;
 | |
|                 my $skip=0;
 | |
|                 do {
 | |
|                     if ($ctx->{forwarders} and $line =~ /forwarders {/) {
 | |
|                         push @newnamed,"\tforwarders \{\n";
 | |
|                         $skip=1;
 | |
|                         foreach (@{$ctx->{forwarders}}) {
 | |
|                             push  @newnamed,"\t\t".$_.";\n";
 | |
|                         }
 | |
|                         push @newnamed,"\t};\n";
 | |
|                     } elsif ($skip) {
 | |
|                         if ($line =~ /};/) {
 | |
|                             $skip = 0;
 | |
|                         }
 | |
|                     } else {
 | |
|                         push @newnamed,$line;
 | |
|                     }
 | |
|                     $i++;
 | |
|                     $line = $currnamed[$i];
 | |
|                 } while ($line !~ /^\};/);
 | |
|                 push @newnamed,$line;
 | |
|             } elsif ($line =~ /^zone "([^"]*)" in \{/) {
 | |
|                 my $currzone = $1;
 | |
|                 if ($ctx->{zonestotouch}->{$currzone} or $ctx->{adzones}->{$currzone}) {
 | |
|                     $didzones{$currzone}=1;
 | |
|                     my @candidate = ($line);
 | |
|                     my $needreplace=1;
 | |
|                     do {
 | |
|                         $i++;
 | |
|                         $line =  $currnamed[$i];
 | |
|                         push @candidate,$line;
 | |
|                         if ($line =~ /key xcat_key/) {
 | |
|                             $needreplace=0;
 | |
|                         }
 | |
|                     } while ($line !~ /^\};/); #skip the old file zone
 | |
|                     unless ($needreplace) {
 | |
|                         push @newnamed,@candidate;
 | |
|                         next;
 | |
|                     }
 | |
|                     $ctx->{restartneeded}=1;
 | |
|                     push @newnamed,"zone \"$currzone\" in {\n","\ttype master;\n","\tallow-update {\n","\t\tkey xcat_key;\n";
 | |
|                     my @list;
 | |
|                     if (not $ctx->{adzones}->{$currzone}) {
 | |
|                         if ($ctx->{dnsupdaters}) {
 | |
|                             @list = @{$ctx->{dnsupdaters}};
 | |
|                         }
 | |
|                     } else {
 | |
|                         if ($ctx->{adservers}) {
 | |
|                             @list = @{$ctx->{adservers}};
 | |
|                         }
 | |
|                     }
 | |
|                     foreach (@list) {
 | |
|                         push @newnamed,"\t\t$_;\n";
 | |
|                     }
 | |
|                     if ($currzone =~ /IN-ADDR\.ARPA/) {
 | |
|                         my $net = $currzone;
 | |
|                         $net =~ s/.IN-ADDR\.ARPA.*//;
 | |
|                         my @octets = split/\./,$net;
 | |
|                         $net = join('.',reverse(@octets));
 | |
|                         push @newnamed,"\t};\n","\tfile \"db.$net\";\n","};\n";
 | |
| 
 | |
|                     } else {
 | |
|                         my $zfilename = $currzone;
 | |
|                         $zfilename =~ s/\..*//;
 | |
|                         push @newnamed,"\t};\n","\tfile \"db.$zfilename\";\n","};\n";
 | |
|                     }
 | |
|                 } else {
 | |
|                     push @newnamed,$line;
 | |
|                     do {
 | |
|                         $i++;
 | |
|                         $line =  $currnamed[$i];
 | |
|                         push @newnamed,$line;
 | |
|                     } while ($line !~ /^\};/);
 | |
|                 }
 | |
| 
 | |
|             } elsif ($line =~ /^key xcat_key/) {
 | |
|                 $gotkey=1;
 | |
|                 if ($ctx->{privkey}) {
 | |
|                     #for now, assume the field is correct
 | |
|                     #push @newnamed,"key xcat_key {\n","\talgorithm hmac-md5;\n","\tsecret \"".$ctx->{privkey}."\";\n","};\n\n";
 | |
|                     push @newnamed,$line;
 | |
|                     do {
 | |
|                         $i++;
 | |
|                         $line =  $currnamed[$i];
 | |
|                         push @newnamed,$line;
 | |
|                     } while ($line !~ /^\};/);
 | |
|                 } else {
 | |
|                     push @newnamed,$line;
 | |
|                     while ($line !~ /^\};/) { #skip the old file zone
 | |
|                         if ($line =~ /secret \"([^"]*)\"/) {
 | |
|                             my $passtab = xCAT::Table->new("passwd",-create=>1);
 | |
|                             $passtab->setAttribs({key=>"omapi",username=>"xcat_key"},{password=>$1});
 | |
|                         }
 | |
|                         $i++;
 | |
|                         $line =  $currnamed[$i];
 | |
|                         push @newnamed,$line;
 | |
|                     }
 | |
|                 }
 | |
|             } else {
 | |
|                 push @newnamed,$line;
 | |
|             }
 | |
|         }
 | |
|     }
 | |
|     unless ($gotoptions) {
 | |
|         push @newnamed,"options {\n","\tdirectory \"".$ctx->{dbdir}."\";\n";
 | |
|         if ($ctx->{forwarders}) {
 | |
|             push @newnamed,"\tforwarders {\n";
 | |
|             foreach (@{$ctx->{forwarders}}) {
 | |
|                 push @newnamed,"\t\t$_;\n";
 | |
|             }
 | |
|             push @newnamed,"\t};\n";
 | |
|         }
 | |
|         push @newnamed,"};\n\n";
 | |
|     }
 | |
|     unless ($gotkey) {
 | |
|         unless ($ctx->{privkey}) { #need to generate one
 | |
|             $ctx->{privkey} = encode_base64(genpassword(32));
 | |
|             chomp($ctx->{privkey});
 | |
|         }
 | |
|         push @newnamed,"key xcat_key {\n","\talgorithm hmac-md5;\n","\tsecret \"".$ctx->{privkey}."\";\n","};\n\n";
 | |
|         $ctx->{restartneeded}=1;
 | |
|     }
 | |
|     my $zone;
 | |
|     foreach $zone (keys %{$ctx->{zonestotouch}}) {
 | |
|         if ($didzones{$zone}) { next; }
 | |
|         $ctx->{restartneeded}=1; #have to add a zone, a restart will be needed
 | |
|         push @newnamed,"zone \"$zone\" in {\n","\ttype master;\n","\tallow-update {\n","\t\tkey xcat_key;\n";
 | |
|         foreach (@{$ctx->{dnsupdaters}}) {
 | |
|             push @newnamed,"\t\t$_;\n";
 | |
|         }
 | |
|         if ($zone =~ /IN-ADDR\.ARPA/) {
 | |
|             my $net = $zone;
 | |
|             $net =~ s/.IN-ADDR\.ARPA.*//;
 | |
|             my @octets = split/\./,$net;
 | |
|             $net = join('.',reverse(@octets));
 | |
|             push @newnamed,"\t};\n","\tfile \"db.$net\";\n","};\n";
 | |
| 
 | |
|         } else {
 | |
|             my $zfilename = $zone;
 | |
|             $zfilename =~ s/\..*//;
 | |
|             push @newnamed,"\t};\n","\tfile \"db.$zfilename\";\n","};\n";
 | |
|         }
 | |
|     }
 | |
|     foreach $zone (keys %{$ctx->{adzones}}) {
 | |
|         if ($didzones{$zone}) { next; }
 | |
|         $ctx->{restartneeded}=1; #have to add a zone, a restart will be needed
 | |
|         push @newnamed,"zone \"$zone\" in {\n","\ttype master;\n","\tallow-update {\n","\t\tkey xcat_key;\n";
 | |
|         foreach (@{$ctx->{adservers}}) {
 | |
|             push @newnamed,"\t\t$_;\n";
 | |
|         }
 | |
|         my $zfilename = $zone;
 | |
|         $zfilename =~ s/\..*//;
 | |
|         push @newnamed,"\t};\n","\tfile \"db.$zfilename\";\n","};\n\n";
 | |
|     }
 | |
|     my $newnameconf;
 | |
|     open($newnameconf,">>",$namedlocation);
 | |
|     flock($newnameconf,LOCK_EX);
 | |
|     seek($newnameconf,0,0);
 | |
|     truncate($newnameconf,0);
 | |
|     for my $l  (@newnamed) { print $newnameconf $l; }
 | |
|     flock($newnameconf,LOCK_UN);
 | |
|     close($newnameconf);
 | |
|     chown (scalar(getpwnam('root')),scalar(getgrnam('named')),$namedlocation);
 | |
| }
 | |
| 
 | |
| sub add_records {
 | |
|     my $ctx = shift;
 | |
|     unless ($ctx->{privkey}) {
 | |
|         my $passtab = xCAT::Table->new('passwd');
 | |
|         my $pent = $passtab->getAttribs({key=>'omapi',username=>'xcat_key'},['password']);
 | |
|         if ($pent and $pent->{password}) { 
 | |
|             $ctx->{privkey} = $pent->{password};
 | |
|         } else {
 | |
|             sendmsg([1,"Unable to find omapi key in passwd table"]);
 | |
|         }
 | |
|     }
 | |
|     my $node;
 | |
|     my $ip;
 | |
|     my $domain = $ctx->{domain}; # store off for lazy typing and possible local mangling
 | |
|     unless ($domain =~ /^\./) { $domain = '.'.$domain; } #example.com becomes .example.com for consistency
 | |
|     $ctx->{nsmap} = {}; #will store a map to known NS records to avoid needless redundant queries to sort nodes into domains
 | |
|     $ctx->{updatesbyzone}={}; #sort all updates into their respective zones for bulk update for fewer DNS transactions
 | |
|     foreach $node (@{$ctx->{nodes}}) {
 | |
|         $ip = $node;
 | |
|         my $name = $node;
 | |
|         unless ($name =~ /$domain/) { $name .= $domain } # $name needs to represent fqdn, but must preserve $node as a nodename for cfg lookup
 | |
|         #if (domaintab->{$node}->[0]->{domain) { $domain = domaintab->{$node}->[0]->{domain) }  
 | |
|         #above is TODO draft of how multi-domain support could come into play
 | |
|         if ($ctx->{hoststab} and $ctx->{hoststab}->{$node} and $ctx->{hoststab}->{$node}->[0]->{ip}) {
 | |
|             $ip = $ctx->{hoststab}->{$node}->[0]->{ip};
 | |
|         } else {
 | |
|             unless ($ip = inet_aton($ip)) {
 | |
|                 sendmsg([1,"Unable to find an IP for $node in hosts table or via system lookup (i.e. /etc/hosts"]);
 | |
|                 next;
 | |
|             }
 | |
|             $ip = inet_ntoa($ip);
 | |
|         }
 | |
|         $ctx->{currip}=$ip;
 | |
|         #time to update, A and PTR records, IPv6 still TODO
 | |
|         $ip = join('.',reverse(split(/\./,$ip)));
 | |
|         $ip .= '.IN-ADDR.ARPA.';
 | |
|         #ok, now it is time to identify which zones should actually hold the forward (A) and reverse (PTR) records and a nameserver to handle the request
 | |
|         my $revzone = $ip;
 | |
|         $ctx->{currnode}=$node;
 | |
|         $ctx->{currname}=$name;
 | |
|         $ctx->{currrevname}=$ip;
 | |
|         find_nameserver_for_dns($ctx,$revzone);
 | |
|         find_nameserver_for_dns($ctx,$domain);
 | |
|     }
 | |
|     my $zone;
 | |
|     foreach $zone (keys %{$ctx->{updatesbyzone}}) {
 | |
|         my $resolver = Net::DNS::Resolver->new(nameservers=>[$ctx->{nsmap}->{$zone}]);
 | |
|         my $entry;
 | |
|         my $numreqs = 300; # limit to 300 updates in a payload, something broke at 644 on a certain sample, choosing 300 for now
 | |
|         my $update = Net::DNS::Update->new($zone);
 | |
|         foreach $entry (@{$ctx->{updatesbyzone}->{$zone}}) {
 | |
|             $update->push(update=>rr_add($entry));
 | |
|             $numreqs -= 1;
 | |
|             if ($numreqs == 0) {
 | |
|                 $update->sign_tsig("xcat_key",$ctx->{privkey});
 | |
|                 $numreqs=300;
 | |
|                 my $reply = $resolver->send($update);
 | |
|                 if ($reply->header->rcode ne 'NOERROR') {
 | |
|                     sendmsg([1,"Failure encountered updating $zone, error was ".$reply->header->rcode]);
 | |
|                 }
 | |
|                 $update =  Net::DNS::Update->new($zone); #new empty request
 | |
|             }
 | |
|         }
 | |
|         if ($numreqs != 300) { #either no entries at all to begin with or a perfect multiple of 300
 | |
|             $update->sign_tsig("xcat_key",$ctx->{privkey});
 | |
|             my $reply = $resolver->send($update);
 | |
|         }
 | |
|     }
 | |
| }
 | |
| sub find_nameserver_for_dns {
 | |
|     my $ctx = shift;
 | |
|     my $zone = shift;
 | |
|     my $node = $ctx->{currnode};
 | |
|     my $ip = $ctx->{currip};
 | |
|     my $rname = $ctx->{currrevname};
 | |
|     my $name = $ctx->{currname};
 | |
|     unless ($name =~ /\.\z/) { $name .= '.' }
 | |
|     my @rrcontent = ( "$name IN A $ip" );
 | |
|     foreach (keys %{$ctx->{nodeips}->{$node}}) {
 | |
|         unless ($_ eq $ip) {
 | |
|             push @rrcontent,"$name IN A $_";
 | |
|         }
 | |
|     }
 | |
|     if ($zone =~ /IN-ADDR.ARPA/) { #reverse style
 | |
|         @rrcontent = ("$rname IN PTR $name");
 | |
|     }
 | |
|     while ($zone) {
 | |
|        unless (defined $ctx->{nsmap}->{$zone}) { #ok, we already thought about this zone and made a decision
 | |
|            if ($zone =~ /^\.*192.IN-ADDR.ARPA\.*/ or $zone =~ /^\.*172.IN-ADDR.ARPA\.*/ or $zone =~ /127.IN-ADDR.ARPA\.*/ or $zone =~ /^\.*IN-ADDR.ARPA\.*/ or $zone =~ /^\.*ARPA\.*/) {
 | |
|                 $ctx->{nsmap}->{$zone} = 0; #ignore zones that are likely to appear, but probably not ours
 | |
|            } else {
 | |
|                my $reply = $ctx->{resolver}->query($zone,'NS');
 | |
|                if ($reply)  {
 | |
|                     foreach my $record ($reply->answer) {
 | |
|                         if ( $record->nsdname =~ /blackhole.*\.iana\.org/) {
 | |
|                             $ctx->{nsmap}->{$zone} = 0; 
 | |
|                         } else {
 | |
|                             $ctx->{nsmap}->{$zone} = $record->nsdname;
 | |
|                         }
 | |
|                     }
 | |
|                } else { 
 | |
|                    $ctx->{nsmap}->{$zone} = 0; 
 | |
|                }
 | |
|            }
 | |
|        }
 | |
|        if ($ctx->{nsmap}->{$zone}) {  #we have a nameserver for this zone, therefore this zone is one to update
 | |
|            push @{$ctx->{updatesbyzone}->{$zone}},@rrcontent;
 | |
|            last;
 | |
|        } else { #we have it defined, but zero, means search higher domains.  Possible to shortcut further by pointing to the right domain, maybe later
 | |
|             if ($zone !~ /\./) {
 | |
|                sendmsg([1,"Unable to find reverse zone to hold $node"],$node);
 | |
|                last;
 | |
|             }
 | |
| 
 | |
|            $zone =~ s/^[^\.]*\.//; #strip all up to and including first dot
 | |
|            unless ($zone) {
 | |
|                sendmsg([1,"Unable to find zone to hold $node"],$node);
 | |
|                last;
 | |
|            }
 | |
|        }
 | |
|     }
 | |
| }
 | |
| sub sendmsg {
 | |
| #    my $callback = $output_handler;
 | |
|     my $text = shift;
 | |
|     my $node = shift;
 | |
|     my $descr;
 | |
|     my $rc;
 | |
|     if (ref $text eq 'HASH') {
 | |
|         die "not right now";
 | |
|     } elsif (ref $text eq 'ARRAY') {
 | |
|         $rc = $text->[0];
 | |
|         $text = $text->[1];
 | |
|     }
 | |
|     if ($text =~ /:/) {
 | |
|         ($descr,$text) = split /:/,$text,2;
 | |
|     }
 | |
|     $text =~ s/^ *//;
 | |
|     $text =~ s/ *$//;
 | |
|     my $msg;
 | |
|     my $curptr;
 | |
|     if ($node) {
 | |
|         $msg->{node}=[{name => [$node]}];
 | |
|         $curptr=$msg->{node}->[0];
 | |
|     } else {
 | |
|         $msg = {};
 | |
|         $curptr = $msg;
 | |
|     }
 | |
|     if ($rc) {
 | |
|         $curptr->{errorcode}=[$rc];
 | |
|         $curptr->{error}=[$text];
 | |
|         $curptr=$curptr->{error}->[0];
 | |
|     } else {
 | |
|         $curptr->{data}=[{contents=>[$text]}];
 | |
|         $curptr=$curptr->{data}->[0];
 | |
|         if ($descr) { $curptr->{desc}=[$descr]; }
 | |
|     }
 | |
| #        print $outfd freeze([$msg]);
 | |
| #        print $outfd "\nENDOFFREEZE6sK4ci\n";
 | |
| #        yield;
 | |
| #        waitforack($outfd);
 | |
|     $callback->($msg);
 | |
| }
 | |
| sub genpassword
 | |
| {
 | |
| 
 | |
|     #Generate a pseudo-random password of specified length
 | |
|     my $length     = shift;
 | |
|     my $password   = '';
 | |
|     my $characters =
 | |
|       'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ01234567890';
 | |
|     srand;    #have to reseed, rand is not rand otherwise
 | |
|     while (length($password) < $length)
 | |
|     {
 | |
|         $password .= substr($characters, int(rand 63), 1);
 | |
|     }
 | |
|     return $password;
 | |
| }
 | |
| 1;
 |