exports_setup.in

#!/usr/bin/perl -wT

#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2003 University of Utah and the Flux Group.
# All rights reserved.
#

use English;
use Fcntl ':flock';

#
# Create an /etc/exports.tail file based on current reserved table and project
# members. Fire that tail over to the fileserver where it is concatenated with
# the head file to become the new /etc/exports
#
# This script always does the right thing, so it does not matter who calls it. 
#
# usage: exports_setup
#

#
# Configure variables
#
my $TB		= "@prefix@";
my $TBOPS       = "@TBOPSEMAIL@";
my $TESTMODE    = @TESTMODE@;
my $FSNODE      = "@FSNODE@";
my $projdir     = "@FSDIR_PROJ@";
my $usersdir    = "@FSDIR_USERS@";
my $groupdir    = "@FSDIR_GROUPS@";

# Note no -n option. We redirect stdin from the new exports file below.
my $SSH		= "$TB/bin/sshtb -l root -host $FSNODE";
my $PROG	= "/usr/testbed/sbin/exports_setup.proxy";
my $exportstail = "/var/tmp/exports.tail";
my $lockfile    = "/var/tmp/testbed_exports_lockfile";
my $dbg		= 0;
my @row; 

#
# We don't 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") {
    print STDERR "*** $0:\n".
	         "    Wrong version. Maybe its a development version?\n";
    #
    # Let experiment continue setting up.
    # 
    exit(0);
}

# 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 libdb;
use libtestbed;

#
# We need to serialize this script to avoid a trashed map file. Use
# a dummy file in /var/tmp, opened for writing and flock'ed. 
#
if (!$TESTMODE) {
    open(LOCK, ">>$lockfile") || fatal("Couldn't open $lockfile\n");
    $count = 0;
    if (flock(LOCK, LOCK_EX|LOCK_NB) == 0) {
	#
	# If we don't get it the first time, we wait for:
	# 1) The lock to become free, in which case we do our thing
	# 2) The time on the lock to change, in which case we wait for that process
	#    to finish
	#
	my $oldlocktime = (stat(LOCK))[9];
	my $gotlock = 0;
	while (1) {
	    print "Another exports update in progress, waiting for it to finish\n";
	    if (flock(LOCK, LOCK_EX|LOCK_NB) != 0) {
		# OK, got the lock, we can do what we're supposed to
		$gotlock = 1;
		last;
	    }
	    $locktime = (stat(LOCK))[9];
	    if ($locktime != $oldlocktime) {
		$oldlocktime = $locktime;
		last;
	    }
	    if ($count++ > 20)  {
		fatal("Could not get the lock after a long time!\n");
	    }
	    sleep(1);
	}

	$count = 0;
	#
	# If we didn't get the lock, wait for the processes that did to finish
	#
	if (!$gotlock) {
	    while (1) {
		if ((stat(LOCK))[9] != $oldlocktime) {
		    exit(0);
		}
		if (flock(LOCK, LOCK_EX|LOCK_NB) != 0) {
		    close(LOCK);
		    exit(0);
		}
		if ($count++ > 20)  {
		    fatal("Process with the lock didn't finish after a long time!\n");
		}
		sleep(1); 
	    }
	}
    }
}

#
# Perl-style touch(1)
#
my $now = time;
utime $now, $now, $lockfile;

#
# We stick the new map entries into the tail file. First zero it out.
#
if (!$TESTMODE) {
  open(MAP, ">$exportstail") || fatal("Couldn't open $exportstail\n");
} else {
  open(MAP, ">/dev/null") || fatal("Couldn't open /dev/null\n");
}
print MAP "\n";
print MAP "#\n";
print MAP "# DO NOT EDIT below this point. Auto generated entries!\n";
print MAP "#\n";
print MAP "\n";

#
# First gather up all the nodes that are reserved and the required info.
# Order by pid,gid first so that they're all grouped together and we avoid
# extra db queries.
#
# VIRTNODE HACK: Virtual nodes are special, so do not export. (isvirtnode).
#
$nodes_result =
    DBQueryFatal("select r.node_id,r.pid,r.eid,e.gid,i.IP from reserved as r ".
		 "left join experiments as e on r.pid=e.pid and r.eid=e.eid ".
		 "left join nodes on r.node_id=nodes.node_id ".
		 "left join node_types on node_types.type=nodes.type ".
		 "left join interfaces as i on r.node_id=i.node_id ".
		 " and i.card=node_types.control_net ".
		 " where i.IP!='NULL' and r.node_id not like 'sh%' ".
		 "       and node_types.isvirtnode=0 ".
		 "       and node_types.isremotenode=0 ".
		 "order by r.pid,e.gid,r.eid,nodes.priority");

my %ipgroups	= ();
my %lastfslist  = ();
my $lastpid     = "";
my $lastgid     = "";

# For each node:
#	determine the list of directories accessible
#	split the list into sublists based on filesystems
#	  (i.e., all directories in the same FS are in the same sublist)
#	add the node to each sublist
#
# Note that we could do this per experiment rather than per node,
# adding all nodes from an experiment to the sublists created.
while (@row = $nodes_result->fetchrow_array) {
    my $node_id = $row[0];
    my $pid     = $row[1];
    my $eid     = $row[2];
    my $gid     = $row[3];
    my $ip      = $row[4];
    my %fslist = ();
    my @dirlist = ();

    # Sanity check - don't try this if any of the above are not defined - we
    # may end up with a bad line in exports
    if ((!defined($node_id)) || (!defined($pid)) || (!defined($eid)) ||
        (!defined($gid)) || (!defined($ip))) {
        print "WARNING: exports_setup: Skipping database row with undefined values\n";
	next;
    }

    if ($lastpid eq $pid && $lastgid eq $gid) {

	# If this is for the same proj and group again, don't requery the db 
	# and don't recompute everything.
	%fslist = %lastfslist;

    } else {

	$lastpid=$pid;
	$lastgid=$gid;

	# Construct a list of directories accessible from this node.
	# First the project and group directories.
	# XXX needs to be fixed for shared experiments?
	push(@dirlist, "$projdir/$pid");
	if ($gid ne $pid) {
	    push(@dirlist, "$groupdir/$pid/$gid");
	}

	# Determine the users that can access this node, and add those
	# users' directories to the list.
	# XXX needs to be fixed for shared experiments?
	$users_result =
	    DBQueryFatal("select distinct uid from group_membership ".
			 "where pid='$pid' and gid='$gid' and trust!='none'");

	while (@usersrow = $users_result->fetchrow_array) {
	    my $uid = $usersrow[0];

	    push(@dirlist, "$usersdir/$uid");
	}

	# Build up filesystem sub-lists.
	# Iterate through directory list dividing it according to filesystem.
	foreach my $dir ( @dirlist ) {
	    my $fs = fsof($dir);

	    if (! defined($fslist{$fs})) {
		$fslist{$fs} = [ $dir ];
	    }
	    else {
		push(@{ $fslist{$fs} }, $dir);
	    }
	}

	%lastfslist = %fslist;
    }

    # For each FS directory list, create a hash key out of its directory list.
    foreach my $fs ( keys(%fslist) ) {
	#
	# Convert dirlist to a string and use that as a hash index to group
	# IPs together with the same set of mounts.
	#
	my $str = join(" ", sort(@{ $fslist{$fs} }));

	if (! defined($ipgroups{$str})) {
	    $ipgroups{$str} = [ $ip ];
	}
	else {
	    push(@{ $ipgroups{$str} }, $ip);
	}
    }
}

#
# Now spit out each group!
#
foreach my $str ( keys(%ipgroups) ) {
    my @iplist = @{ $ipgroups{$str} };    

    print MAP "$str -maproot=root @iplist\n";
}

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

#
# Fire the new tail file over to the fileserver to finish. We cat the file
# right into it.
#
if (!$TESTMODE) {
  $UID = 0;
  #
  # Temp Hack! Save a copy of the exports file for debugging.
  #
  if ($dbg) {
      my $backup = "$TB/log/exports/" . TBDateTimeFSSafe();
      system("cp $exportstail $backup");
  }
  
  system("$SSH $PROG < $exportstail") == 0 or
    fatal("Failed: $SSH $PROG < $exportstail: $?");
  unlink("$exportstail");

  #
  # Close the lock file. Exiting releases it, but might as well.
  #
  close(LOCK);
}

exit(0);

sub fatal {
    local($msg) = $_[0];

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

#
# Return a unique (per-FS) string identifying the filesystem of
# the given path.
#
# XXX for the moment, we just return the first component of the path
# assuming everything is mounted at the top level.  Clearly this needs
# to be fixed.
#
# Fixing probably involves either parsing the output of mount or df to
# compare against or using $dev as returned by the stat call.  Both of
# these options require ssh callouts to the ops node where the actual
# filesystems are.
#
sub fsof($) {
    my($path) = @_;

    $path =~ s#^(/[^/]*).*#$1#;
    return $path;
}