nalloc.in 4.69 KB
Newer Older
1
#!/usr/bin/perl -w
Leigh B. Stoller's avatar
Leigh B. Stoller committed
2 3 4

#
# EMULAB-COPYRIGHT
5
# Copyright (c) 2000-2003 University of Utah and the Flux Group.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
6 7
# All rights reserved.
#
8
use English;
9
use Getopt::Std;
Mac Newbold's avatar
Mac Newbold committed
10

11 12 13 14 15 16
#
# nalloc - allocate nodes to an experiment. Takes a pid, and eid, and
# a list of nodes. Only nodes that are free can be allocated, and a
# special hack for sharks is included - allocating 'sh*' expands to
# allocation of the entire rack.
#
17 18 19
# Exit status is important! Exit with -1 if an error, else the number
# of nodes that could not be allocated. Otherwise zero.
#
20 21 22
#
# Configure variables
#
23
my $TB       = "@prefix@";
24 25 26 27
use lib '@prefix@/lib';
use libdb;

my %opt = ();
28 29 30 31
getopts('vp', \%opt);

my $debug   = 0;
my $partial = 0;
32

33 34 35
if ($opt{v}) {
    $debug = 1;
}
36 37 38
if ($opt{p}) {
    $partial = 1;
}
Mac Newbold's avatar
Mac Newbold committed
39

40
if (@ARGV < 2) {
41 42
    die("Usage: nalloc [-v] [-p] <pid> <eid> <node> <node> <...>\n".
	 "		-p enables partial allocation mode\n".
43 44
	 "		-v enables debugging output\n");
}
Mac Newbold's avatar
Mac Newbold committed
45

46 47
my $consetup="$TB/libexec/console_setup";
my $exportsetup="$TB/sbin/exports_setup";
48
my $error = 0;
49
my $noalloc = 0;
50
my $pid = shift;
Mac Newbold's avatar
Mac Newbold committed
51 52
my $eid = shift;
my @node_names=@ARGV;
mac's avatar
mac committed
53 54
my @vals = ();
my @nodes= ();
Mac Newbold's avatar
Mac Newbold committed
55

56
if ($debug) { print "Expt '$eid', proj '$pid'\n"; }
57

58
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
59 60 61 62 63 64 65 66
# Experiment must exist.
# 
if (!ExpState($pid,$eid)) {
    die "There is no experiment $eid in project $pid\n";
}

#
# User must have permission to modify the experiment.
67
#
68
if ($UID) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
69 70
    if (!TBExptAccessCheck($UID, $pid, $eid, TB_EXPT_MODIFY)) {
        die("*** You not have permission to allocate nodes in $pid/$eid!\n");
71
    }
72
}
73

74 75 76 77 78 79 80 81 82 83 84
#
# Before locking any tables, do a quick check to make sure the project
# is allowed to allocate the nodes, by type/class. 
#
foreach my $n (@node_names) {
    if (! TBNodeAllocCheck($pid, $n)) {
	die("*** $0:\n".
	    "    You are not allowed to allocate $n to project $pid!\n");
    }
}

85 86 87 88 89 90
######################################################################
# Step 1 - Make a list of nodes to reserve
#
# We prune nodes that are already reserved, etc., from the list, and
# do expansion of shark shelves
######################################################################
91

92
DBQueryFatal("lock tables nodes read, reserved write, node_activity write");
mac's avatar
mac committed
93

94
foreach my $n (@node_names) {
95 96 97 98 99 100 101 102 103 104 105 106
    # Shark hack
    if ($n =~ /(sh\d+)/ ) { $n = $1."-1"; }
    # End shark hack

    my ($r_pid, $r_eid);
    if (NodeidToExp($n,\$r_pid,\$r_eid)) {
	# Someone has already reserved this node
	if (($r_pid eq $pid) && ($r_eid eq $eid)) {
	    print "You have already reserved node '$n'.\n";
	    # Do not increment error code since that throws off tbprerun.
	} else {
	    print "Someone else has already reserved node '$n'.\n";
107
	    $noalloc++;
108 109
	}
	next; # Go on to the next node if this one is reserved
110
    }
111 112 113

    my $result = DBQueryFatal("select * from nodes where node_id='$n'");
    if ($result->numrows() < 1) {
114
      print "Node '$n' does not exist.\n";
115
      $error++;
116
      next;
mac's avatar
mac committed
117
    } else {
118 119 120 121 122 123 124 125 126 127 128 129 130 131 132
	# No one has reserved it, and it exists, so add it to my list
	# Shark hack
	if ($n =~ /(sh\d+)/ ) {
	    # its a shark - do the whole shelf if its not done already.
	    my $shelf = $1;
	    if ( ! (join(",",@nodes) =~ /,$shelf-\d,/)) {
		# Shelf hasn't been done yet...
		foreach my $n ( 1 .. 8 ) {
		    push(@vals,"('$shelf-$n','$pid','$eid')");
		    push(@nodes,"$shelf-$n");
		}
	    }
	    # End shark hack
	} else {
	    # its not a shark - just add it in...
133
	    push(@vals,"('$n','$pid','$eid','$n')");
134
	    push(@nodes,"$n");
135
	}
Mac Newbold's avatar
Mac Newbold committed
136 137
    }
}
138

139 140 141 142 143 144 145
if ($debug) { print "List Ready: @vals\nError=$error\n"; }

######################################################################
# Step 2 - Make the reservations in the database
#
# Uses the list built in step 1
######################################################################
146

147
if (!$error && (!$noalloc || $partial) && @vals) {
148 149 150 151 152 153 154 155
    if ($debug) {
	print "Resetting node activity...\n";
    }
    my $cmd = "update node_activity set last_ext_act = now() where ".
      join(" or ",map("node_id='$_'",@nodes));
    DBQueryWarn($cmd);
    # It isn't an error if this fails...

156 157 158
    if ($debug) {
	print "Reserving nodes...\n";
    }
159
    $cmd = "insert into reserved (node_id,pid,eid,vname) values ".
160
      join(",",@vals);
161 162 163
    if (!DBQueryWarn($cmd)) {
	$error++;
    }
mac's avatar
mac committed
164 165
}

166 167 168 169 170 171 172
DBQueryFatal("unlock tables");

######################################################################
# Step 3 - Setup consoles
#
# Uses the list built in step 1
######################################################################
mac's avatar
mac committed
173

174
if (!$error && @nodes) {
175 176
    system("$consetup @nodes") == 0 or
	print STDERR "WARNING: $consetup @nodes failed!\n";
Mac Newbold's avatar
Mac Newbold committed
177 178
}

179 180 181 182 183 184 185
#
# Exit with -1 if an error, else the number of nodes that could not
# be allocated.
#
my $exitval = ($error ? -1 : $noalloc);
if ($debug) { print "Returning with value $exitval\n"; }
exit($exitval);