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

#
# EMULAB-COPYRIGHT
5
# Copyright (c) 2000-2003 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 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

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");
}

74 75 76 77
if (! ExpLeader($pid,$eid)) {
    die("You experiment $pid/$eid does not exist.\n");
}

78 79 80 81 82 83 84 85 86 87 88 89 90 91 92
foreach my $node (@nodes) {
  my $pc = $node;
  my $allocated = 0;

  $sth = DBQueryFatal("select * from nodes where node_id='$pc'");
  if ($sth->num_rows() != 1) {
    print STDERR "Node $pc doesn't exist. Skipping $pc.\n";
    next;
  }

  print "Checking if $pc is reserved...";
  $sth = DBQueryFatal("select * from reserved where node_id='$pc'");

  if ( ($sth->num_rows()) < 1) {
    print "Available - Reserving...\n";
93
    #print STDERR "Using proj $pid, expt $eid, I am ",`whoami`;
94 95 96 97 98 99 100 101 102
    my $cmd = "$nalloc $pid $eid $pc";
    if ( system($cmd) != 0 ) {
      print STDERR "WARNING: Could not reserve $pc!\n";
    }
  } else {
    $sth = DBQueryFatal("select * from reserved where node_id='$pc' and ".
		       "pid='$pid' and eid='$eid'");
    if ( ($sth->num_rows()) < 1) {
      print "Reserved  - Scheduling next reservation...\n";
103 104
      $sth = DBQueryFatal("replace into next_reserve (node_id,pid,eid) ".
			  "values ('$pc','$pid','$eid')");
105 106 107 108 109 110 111 112
    } else {
      print "Reserved  - Already reserved to $pid/$eid\n";
    }
  }
}

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