named_setup.in

#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2005 University of Utah and the Flux Group.
# All rights reserved.
#
use English;
use Socket;
use strict;

#
# Suck out virtual names and create CNAME map entries.
#
# This script always does the right thing, so it does not matter who calls it. 
#
# usage: named_setup [-norestart]
#

#
# Function phototypes
#

sub assemble_zonefile($);
sub make_forward_zonefile($$$);
sub isroutable($);

#
# Configure variables
#
my $TB		= "@prefix@";
my $TBOPS       = "@TBOPSEMAIL@";
my $USERS	= "@USERNODE@";
my $DISABLED    = "@DISABLE_NAMED_SETUP@";
my $OURDOMAIN   = "@OURDOMAIN@";

my $mapdir			= "/etc/namedb";
my $mapfile			= "$mapdir/${OURDOMAIN}.db";
my $mapfiletail			= "$mapfile.tail";
my $mapfile_internal		= "$mapdir/${OURDOMAIN}.internal.db";
my $mapfile_internal_head	= "$mapfile_internal.head";
my $mapfile_internal_tail	= "$mapfile_internal.tail";
my $vnodesfile			= "$mapdir/vnodes.${OURDOMAIN}.db";
my $vnodesback 			= "$mapdir/vnodes.${OURDOMAIN}.db.backup";
my $reversedir			= "$mapdir/reverse";
my $restart_named		= 1;
my $dbg	= 0;
my @row;

use strict;

# If we are disabled, just quietly exit
if ($DISABLED) {
    exit 0;
}

# We do not want to run this script unless its the real version.
if ($EUID != 0) {
    die("*** $0:\n".
	"    Must be root! Maybe its a development version?\n");
}
# XXX Hacky!
if (0 && $TB ne "/usr/testbed") {
    die("*** $0:\n".
	"    Wrong version. Maybe its a development version?\n");
}

# un-taint path
$ENV{'PATH'} = '/bin:/usr/bin:/usr/sbin:/usr/local/bin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

# Turn off line buffering on output
$| = 1;

# Testbed Support libraries
use lib "@prefix@/lib";
use libtestbed;
use libdb;

#
# Check for norestart option.
#
if (@ARGV && $ARGV[0] eq "-norestart") {
    $restart_named = 0;
}

#
# We need to serialize this script to avoid a trashed map file.
#
if ((my $locked = TBScriptLock("named", 1)) != TBSCRIPTLOCK_OKAY()) {
    exit(0)
        if ($locked == TBSCRIPTLOCK_IGNORE);
    fatal("Could not get the lock after a long time!\n");
}

#
# Grab the list of all nodes, including virtual and widearea nodes
#
my $db_result =
    DBQueryFatal("select n.node_id, n.role, n.jailip, i.IP, i.role ".
		 "    from nodes as n ".
		 "left join node_types as nt on n.type=nt.type ".
		 "left join interfaces as i on n.phys_nodeid=i.node_id ". 
		 "where (n.role='testnode' or n.role='virtnode') ".
		 "    and (i.IP is not null or n.jailip is not null) ".
		 "    and (i.card is null or ".
		 "         i.role='" . TBDB_IFACEROLE_CONTROL() . "' or " .
		 "         i.role='" . TBDB_IFACEROLE_GW() . "') ");

#
# Sort out the routable and unroutable addresses, and make a map for reversing
# them
#
my %routable;
my %unroutable;
my %reverse;
while (my @row = $db_result->fetchrow_array()) {
    my $node_id = $row[0];
    my $nrole   = $row[1];
    my $jailIP  = $row[2];
    my $IP      = $row[3];
    my $irole   = $row[4];

    #
    # For most nodes, we get the IP address from the interfaces table; but, for
    # virtual nodes, we get it from the jailip column
    #
    if (defined($jailIP)) {
	$IP = $jailIP;
    }
    if (!$IP) {
	warn "named_setup: No IP for node $node_id!\n";
	next;
    }

    #
    # Special treatment for gateway interfaces - we give act as if they are a
    # separate node
    #
    if ($irole && $irole eq TBDB_IFACEROLE_GW()) {
	$node_id = "$node_id-gw";
    }

    #
    # Make a little structure so that we can make decisions later about this
    # node (ie. handling virt nodes differently)
    #
    my $node_rec = {
	IP   => $IP,
	role => $nrole
    };

    #
    # Sort it into the right pile based on whether or not it's routable
    #
    if (isroutable($IP)) {
	$routable{$node_id} = $node_rec;
    } else {
	$unroutable{$node_id} = $node_rec;
    }

    #
    # Put it into a map so we can generate the reverse zone file later
    #
    $IP =~ /(\d+\.\d+\.\d+)\.(\d+)/;
    if ($1 && $2) {
	my $subnet = $1;
	my $host = $2;
	push @{$reverse{$subnet}}, [$host, $node_id];
    } else {
	warn "Poorly formed IP address $IP\n";
    }
}

#
# Get the list of currently-reserved nodes so that we can make CNAMEs for them
#
$db_result =
    DBQueryFatal("select node_id,pid,eid,vname from reserved");

my %cnames;
while (my ($node_id,$pid,$eid,$vname) = $db_result->fetchrow_array()) {

    #
    # Handle some rare cases where a node can get reserved without a vname -
    # such as calling nalloc directly
    #
    if (!defined($vname)) {
	$vname = $node_id;
    }

    push @{$cnames{$node_id}}, "$vname.$eid.$pid";
}


#
# Make the zone file for routable IP addresses
#
make_forward_zonefile($mapfiletail,\%routable,\%cnames);
assemble_zonefile($mapfile);

#
# Make the zone file that includes both routable and unroutable IP addresses,
# if the site has a .head file for it
#
if (-e $mapfile_internal_head) {
    make_forward_zonefile($mapfile_internal_tail,
	{%routable, %unroutable},\%cnames);
    assemble_zonefile($mapfile_internal);
}


#
# Look for reverse zone files that we may need to make
#
opendir(DIR,$reversedir) or fatal("Unable to open directory $reversedir\n");
while (my $dirent = readdir(DIR)) {
    if ($dirent !~ /((\d+\.\d+\.\d+)\.db)\.head/) {
	next;
    }
    my $subnet = $2;
    my $basename = $1;

    my $filename = "$reversedir/$basename.tail";
    open MAP, ">$filename" || fatal("Couldn't open $filename: $!\n");
    if ($reverse{$subnet}) {
	foreach my $aref (sort {$$a[0] <=> $$b[0]} @{$reverse{$subnet}}) {
	    my ($host, $name) = @$aref;
	    printf MAP "$host\tIN\tPTR\t$name.$OURDOMAIN.\n";
	}
    }
    close MAP;

    assemble_zonefile("$reversedir/$basename");
    
}
closedir DIR;

#
# Get the nameserver to reload the zone files.
# This is better than HUPing the nameserver directly. Notet that we look
# for a local port of named first.
#
if ($restart_named) {
    if (-x "/usr/local/sbin/rndc") {
	system("/usr/local/sbin/rndc reload > /dev/null") == 0 or
	    fatal("/usr/local/sbin/rndc reload failed!\n");
    } else {
	system("named.reload > /dev/null") == 0 or
	    fatal("named.reload failed!\n");
    }
}
TBScriptUnlock();
exit(0);

#
# Die and tell someone about it
#
sub fatal {
    my $msg = $_[0];

    TBScriptUnlock();
    SENDMAIL($TBOPS, "Named Setup Failed", $msg);
    die($msg);
}

#
# Put together a zone file from its consituent head and tail pieces
#
sub assemble_zonefile($) {
    my ($mapfile) = @_;

    my $mapfileback = "$mapfile.backup";
    my $mapfilehead = "$mapfile.head";
    my $mapfiletail = "$mapfile.tail";

    #
    # Concat the head and tail files to create the new map.
    #
    if (-e $mapfile) {
	system("mv -f $mapfile $mapfileback") == 0 or
	fatal("Could not back up $mapfile to $mapfileback\n");
    }

    #
    # Generate a warning so that no one tries to edit the file by hand
    #
    open(MAP, ">$mapfile") || fatal("Couldn't open $mapfile\n");
    print MAP
    ";\n".
    "; ******************************************************************\n".
    "; DO NOT EDIT THIS FILE. IT IS A CREATION, A FIGMENT, A CONTRIVANCE!\n".
    ";\n".
    "; Edit the \"head\" file, then run ${TB}bin/named_setup.\n".
    "; ******************************************************************\n".
    ";\n";

    #
    # Now copy in the head part of the map, looking for the serial
    # number so it can be bumped up.
    #
    open(MAPHEAD, "<$mapfilehead") || fatal("Couldn't open $mapfilehead\n");
    while (<MAPHEAD>) {
	if ( /;\s*Serial\s+/i ) {
	    my $serial = `date +%s`;
	    chop $serial;

	    print MAP "\t\t\t$serial\t; Serial Number -- DO NOT EDIT\n";
	}
	else {
	    print MAP "$_";
	}
    }
    close(MAPHEAD);
    close(MAP);

    #
    # Now the tail of the map.
    # 
    system("cat $mapfiletail >> $mapfile") == 0 or
    fatal("Failed to concat $mapfiletail to $mapfile\n");
}

#
# Make a forward zone file, from the given map of addresses and CNAMEs
#
sub make_forward_zonefile($$$) {
    my ($filename, $addresses, $cnames) = @_;
    open(MAP, ">$filename") || fatal("Couldn't open $filename\n");
    print MAP "\n";
    print MAP ";\n";
    print MAP "; DO NOT EDIT below this point. Auto generated map entries!\n";
    print MAP ";\n";
    print MAP "\n";

    #
    # Start out with the A records for the nodes
    #
    print MAP "\n";
    print MAP ";\n";
    print MAP "; Nodes\n";
    print MAP ";\n";
    print MAP "\n";
    while (my ($node_id, $node_rec) = each %$addresses) {

	#
	# Special treatment for virtual nodes - we only bother to print them
	# out if some has reserved them (ie. if they have a CNAME)
	#
	if (($node_rec->{role} eq "virtnode") && (!$cnames->{$node_id})) {
	    next;
	}

	print MAP "$node_id\tIN\tA\t$node_rec->{IP}\n";
	print MAP "\tIN\tMX 10\t$USERS.\n";
    }

    #
    # Switch the TTL to 1 second for CNAMEs so that people will changes quickly
    # as experiments swap in and out
    #
    print MAP "\n";
    print MAP "\$TTL\t1\n\n";

    print MAP "\n";
    print MAP ";\n";
    print MAP "; CNAMEs for reserved nodes\n";
    print MAP ";\n";
    print MAP "\n";

    while (my ($pname, $vnames) = each %$cnames) {
	#
	# Only print out CNAMEs for nodes that are actually going into this map
	#
	next unless ($addresses->{$pname});

	#
	# Write out every CNAME for this pnode
	#
	foreach my $vname (@$vnames) {
	    my $formatted_vname = sprintf "%-50s", $vname;
	    print MAP "$formatted_vname\tIN\tCNAME\t$pname\n";
	}
    }

    print MAP "\n";
    close(MAP);
}

#
# Is an IP routable?
#
sub isroutable($)
{
    my ($IP)  = @_;
    my ($a,$b,$c,$d) = ($IP =~ /^(\d*)\.(\d*)\.(\d*)\.(\d*)/);

    #
    # These are unroutable:
    # 10.0.0.0        -   10.255.255.255  (10/8 prefix)
    # 172.16.0.0      -   172.31.255.255  (172.16/12 prefix)
    # 192.168.0.0     -   192.168.255.255 (192.168/16 prefix)
    #

    # Easy tests.
    return 0
	if (($a eq "10") ||
	    ($a eq "192" && $b eq "168"));

    # Lastly
    return 0
	if (inet_ntoa((inet_aton($IP) & inet_aton("255.240.0.0"))) eq
	    "172.16.0.0");

    return 1;
}