sched_reserve.in 3.42 KB
Newer Older
1
#!/usr/bin/perl -wT
Leigh Stoller's avatar
Leigh Stoller committed
2 3 4

#
# EMULAB-COPYRIGHT
5
# Copyright (c) 2000-2010 University of Utah and the Flux Group.
Leigh Stoller's avatar
Leigh Stoller committed
6 7 8
# All rights reserved.
#

9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
use English;

# Schedule the reservation of a node. If the node is not currently in use,
# nalloc will be called to reserve the node immediately. If the node is 
# currently reserved, an entry will be added to the next_reserve table, and
# when the node is freed it will be reserved to the given experiment.
#
# usage: sched_reserve <pid> <eid> <node> [<node> ...]

sub usage() {
  die("Usage: sched_reserve <pid> <eid> <node> [<node> ...]\n".
      "Reserves nodes to eid when the are free.\n");
}

# Configure variables
my $TB     = "@prefix@";

# Load the Testbed support stuff.
27 28
use lib "@prefix@/lib";
use libdb;
29
use Experiment;
30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74

my $nalloc      = "$TB/bin/nalloc";
my $debug       = 0;
my @nodes       = ();

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

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

if (@ARGV < 2) {
  usage();
}

# Untaint args.
my $pid   = shift;
if ($pid =~ /^([-\@\w.\+]+)$/) {
  $pid = $1;
} else {
  die("Bad data in pid '$pid'.");
}

my $eid   = shift;
if ($eid =~ /^([-\@\w.\+]+)$/) {
  $eid = $1;
} else {
  die("Bad data in eid '$eid'.");
}

foreach my $node ( @ARGV ) {
  if ($node =~ /^([-\@\w]+)$/) {
    $node = $1;
  } else {
    die("Bad node name '$node'.");
  }
  push(@nodes, $node);
}

# Root and admin types can do whatever they want.
# Mere users cannot schedule reservations (yet?)
if ($UID && !TBAdmin($UID)) {
  die("Only root or TB administrators can schedule reservations.\n");
}

75 76 77 78
my $experiment = Experiment->Lookup($pid, $eid);
if (! $experiment) {
    die("*** $0:\n".
	"    No such experiment $pid/$eid in the Emulab Database.\n");
79
}
80
my $exptidx = $experiment->idx();
81

82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103
#
# Use the awesome power of left join:
#
# - if we get no row returned, then the node does not exist,
# - if we get a nodes entry but no reserved entry, the node is free,
# - if we get both, then it is allocated and pid/eid is where it is now.
#
# This single query on all nodes replaces the three queries per-node
# we used to do.
#
my $nlist = "(" . join(",", map("'$_'", @nodes)) . ")";
my $sth = DBQueryFatal("SELECT n.node_id AS nt,r.node_id AS rt,r.pid,r.eid".
		       " FROM nodes AS n LEFT JOIN reserved AS r".
		       " ON n.node_id=r.node_id WHERE n.node_id in $nlist");
#
# Make a list of the nodes we got nodes table info for, others don't exist
#
my %nmap = ();
while (my $rref = $sth->fetchrow_hashref()) {
  $nmap{$rref->{'nt'}} = $rref;
}

104 105 106
foreach my $node (@nodes) {
  my $pc = $node;
  my $allocated = 0;
107
  my $nref = $nmap{$node};
108

109
  if (!defined($nref)) {
110 111 112 113 114
    print STDERR "Node $pc doesn't exist. Skipping $pc.\n";
    next;
  }

  print "Checking if $pc is reserved...";
115
  if (!$nref->{'rt'}) {
116
    print "Available - Reserving...\n";
117
    #print STDERR "Using proj $pid, expt $eid, I am ",`whoami`;
118 119 120 121 122
    my $cmd = "$nalloc $pid $eid $pc";
    if ( system($cmd) != 0 ) {
      print STDERR "WARNING: Could not reserve $pc!\n";
    }
  } else {
123
    if (!($pid eq $nref->{'pid'} && $eid eq $nref->{'eid'})) {
124
      print "Reserved  - Scheduling next reservation...\n";
125
      $sth = DBQueryFatal("REPLACE INTO next_reserve ".
126
			  " (node_id,exptidx,pid,eid) ".
127
			  "VALUES ('$pc','$exptidx','$pid','$eid')");
128 129 130 131 132 133 134 135
    } else {
      print "Reserved  - Already reserved to $pid/$eid\n";
    }
  }
}

# If I haven't died yet, then this was successful.
exit 0;