nalloc.in 6.5 KB
Newer Older
1
#!/usr/bin/perl -w
Leigh B. Stoller's avatar
Leigh B. Stoller committed
2 3
#
# EMULAB-COPYRIGHT
4
# Copyright (c) 2000-2005, 2007 University of Utah and the Flux Group.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
5 6
# All rights reserved.
#
7
use English;
8
use Getopt::Std;
Mac Newbold's avatar
Mac Newbold committed
9

10 11
#
# nalloc - allocate nodes to an experiment. Takes a pid, and eid, and
Leigh B. Stoller's avatar
Leigh B. Stoller committed
12
# a list of nodes. Only nodes that are free can be allocated.
13
#
14 15 16
# Exit status is important! Exit with -1 if an error, else the number
# of nodes that could not be allocated. Otherwise zero.
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
17 18 19 20 21 22 23 24 25 26 27
sub usage()
{
    print("Usage: nalloc [-v] [-p] <pid> <eid> <node> <node> <...>\n".
	  "		-p enables partial allocation mode\n".
	  "		-v enables debugging output\n");
    exit(-1);
}
my $optlist = "dp";
my $debug   = 0;
my $partial = 0;

28 29 30
#
# Configure variables
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
31 32 33 34 35 36 37
my $TB          = "@prefix@";
my $consetup    = "$TB/libexec/console_setup";
my $exportsetup = "$TB/sbin/exports_setup";

#
# Testbed Support libraries
#
38 39
use lib '@prefix@/lib';
use libdb;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
40
use libtestbed;
41

Leigh B. Stoller's avatar
Leigh B. Stoller committed
42 43 44 45
#
# Turn off line buffering on output
#
$| = 1; 
46

Leigh B. Stoller's avatar
Leigh B. Stoller committed
47 48
# For perf analysis.
#TBDebugTimeStampsOn();
49

Leigh B. Stoller's avatar
Leigh B. Stoller committed
50 51 52 53 54 55 56 57 58
#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
%options = ();
if (! getopts($optlist, \%options)) {
    usage();
}
if (defined($options{"d"})) {
59 60
    $debug = 1;
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
61
if (defined($options{"p"})) {
62 63
    $partial = 1;
}
64
if (@ARGV < 2) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
65
    usage();
66
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
67 68 69
my $pid		= shift;
my $eid		= shift;
my @node_names	= @ARGV;
Mac Newbold's avatar
Mac Newbold committed
70

Leigh B. Stoller's avatar
Leigh B. Stoller committed
71 72 73 74 75
#
# Locals
# 
my $error	  = 0;
my $noalloc	  = 0;
76 77
my @newvals	  = ();
my @oldnodes	  = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
78 79
my @nodes	  = ();
my @need_consetup = 0;
80
my @need_history  = ();
Kirk Webb's avatar
 
Kirk Webb committed
81
my @need_clearbl  = ();
82

Leigh B. Stoller's avatar
Leigh B. Stoller committed
83
TBDebugTimeStamp("nalloc started");
84
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
85 86 87
# Experiment must exist.
# 
if (!ExpState($pid,$eid)) {
88 89
    warn "There is no experiment $eid in project $pid\n";
    exit -1;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
90
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
91
TBDebugTimeStamp("nalloc checked exp state");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
92 93 94

#
# User must have permission to modify the experiment.
95
#
96
if ($UID) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
97
    if (!TBExptAccessCheck($UID, $pid, $eid, TB_EXPT_MODIFY)) {
98 99
        warn("*** You do not have permission to allocate nodes in ".
	     "$pid/$eid!\n");
100
        exit -1;
101
    }
102
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
103
TBDebugTimeStamp("nalloc checked exp permission");
104

105 106 107 108 109 110
my $exptidx;
if (!TBExptIDX($pid, $eid, \$exptidx)) {
    print "*** WARNING: No such experiment $pid/$eid!\n";
    exit -1;
}

111 112
#
# Before locking any tables, do a quick check to make sure the project
Leigh B. Stoller's avatar
Leigh B. Stoller committed
113
# is allowed to allocate the nodes, by type/class, plus other checks.
114 115
#
foreach my $n (@node_names) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
116 117
    # Make sure a valid node name first!
    if (! TBValidNodeName($n)) {
118 119 120
	warn("*** $0:\n".
	     "    No such node $n!\n");
        exit -1;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
121 122 123
    }

    # Project allowed to allocated this node type/class?
124
    if (! TBNodeAllocCheck($pid, $n)) {
125 126 127
	warn("*** $0:\n".
	     "    You are not allowed to allocate $n to project $pid!\n");
        exit -1;
128 129
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
130 131 132 133 134 135 136 137 138 139 140 141 142 143
    # XXX
    # If the node has a tipline, then indicate that we want to call
    # console_setup. We want to avoid calling console_setup if all we
    # got is a zillion virtual nodes on the command line; wasted work.
    #
    my $tiplines_result =
	DBQueryFatal("select tipname,server from tiplines ".
		     "where node_id='$n'");

    if ($tiplines_result->numrows) {
	$need_consetup++;
    }
}
TBDebugTimeStamp("nalloc checked node permission ");
144

Leigh B. Stoller's avatar
Leigh B. Stoller committed
145 146 147
# Must lock this table!
DBQueryFatal("lock tables reserved write");
TBDebugTimeStamp("nalloc locked tables");
mac's avatar
mac committed
148

Leigh B. Stoller's avatar
Leigh B. Stoller committed
149
# Make a list of nodes to reserve.
150
foreach my $n (@node_names) {
151
    my ($r_pid, $r_eid);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
152 153
    
    if (NodeidToExp($n, \$r_pid, \$r_eid)) {
154 155
	# Someone has already reserved this node
	if (($r_pid eq $pid) && ($r_eid eq $eid)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
156 157
	    print "Already reserved: '$n'\n";
	    # Do not increment error code since that throws off caller.
158
	    next;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
159 160 161 162
	}
	elsif (NodeidToExpOldReserved($n, \$r_pid, \$r_eid) &&
	       (($r_pid eq $pid) && ($r_eid eq $eid))) {
	    print "Already reserved in holding reservation: '$n'\n";
163 164
	    push(@oldnodes, $n);
	    next;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
165 166
	}
	else {
167
	    print "Someone else has already reserved node '$n'.\n";
168
	    $noalloc++;
169
	    next;
170
	}
171
    }
172 173 174
    else {
	# Freshly allocated nodes need a history entry.
	push(@need_history, $n);
Kirk Webb's avatar
 
Kirk Webb committed
175 176
        # ... and need to have their bootlogs purged.
        push(@need_clearbl, $n);
177
    }
178

Leigh B. Stoller's avatar
Leigh B. Stoller committed
179 180 181
    #
    # Add info the list of nodes to reserve; done in a single query below.
    # 
182
    push(@newvals,  "('$n',$exptidx,'$pid','$eid','$n','','')");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
183
    push(@nodes, "$n");
Mac Newbold's avatar
Mac Newbold committed
184
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
185
TBDebugTimeStamp("nalloc checked all nodes");
186

Leigh B. Stoller's avatar
Leigh B. Stoller committed
187
if ($debug) {
188
    print "List Ready: @newvals\nError=$error\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
189
}
190

Leigh B. Stoller's avatar
Leigh B. Stoller committed
191
# Now make the reservations in the DB.
192
if ((!$noalloc || $partial) && (@newvals || @oldnodes)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
193 194
    print "Reserving nodes...\n"
	if ($debug);
195

196 197
    if (@newvals &&
	! DBQueryWarn("replace into reserved ".
198
		      "  (node_id,exptidx,pid,eid,vname,old_pid,old_eid) ".
199
		      "values ". join(",",@newvals))) {
200 201
	$error++;
    }
202 203 204 205 206
    # Do this instead of creating new entries so as not to lose any
    # other info in the reserved table entries. I think this might be;
    # wrong; might need to rethink this.
    foreach my $node (@oldnodes) {
	if (!DBQueryWarn("update reserved " .
207 208
			 "set exptidx=$exptidx,pid='$pid',eid='$eid', ".
			 "    old_exptidx=0, old_pid='', old_eid='' ".
209 210 211 212
			 "where node_id='$node'")) {
	    $error++;
	}
    }
mac's avatar
mac committed
213
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
214
TBDebugTimeStamp("nalloc allocated all nodes");
mac's avatar
mac committed
215

Leigh B. Stoller's avatar
Leigh B. Stoller committed
216
# Unlock tables.
217
DBQueryFatal("unlock tables");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
218
TBDebugTimeStamp("nalloc unlocked tables");
219

220 221
# Okay, not safe to do this

Leigh B. Stoller's avatar
Leigh B. Stoller committed
222 223 224 225 226 227 228 229 230 231
# Update node_activity table; no need to do this with tables locked.
if (!$error && (!$noalloc || $partial) && @nodes) {
    print "Resetting node activity\n"
	if ($debug);

    # It isn't an error if this fails...
    DBQueryWarn("update node_activity set last_ext_act=now() ".
		"where " . join(" or ",map("node_id='$_'", @nodes)));

    TBDebugTimeStamp("nalloc updated node_activity table");
232 233 234 235

    foreach my $n (@need_history) {
	TBSetNodeHistory($n, TB_NODEHISTORY_OP_ALLOC, $UID, $pid, $eid);
    }
Kirk Webb's avatar
 
Kirk Webb committed
236 237 238 239 240 241 242 243

    # Clear boot logs - maybe this should be done before alloc?
    #  - only a small window of opportunity at any rate.
    # This is sort of wasteful as it should be the same set of nodes
    # as in the node history loop above, but that could change at some point.
    foreach my $n (@need_clearbl) {
        DBQueryWarn("delete from node_bootlogs where node_id='$n'");
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
244
}
mac's avatar
mac committed
245

Leigh B. Stoller's avatar
Leigh B. Stoller committed
246 247
# Now setup consoles if needed.
if ($need_consetup && !$error && @nodes) {
248 249
    system("$consetup @nodes") == 0 or
	print STDERR "WARNING: $consetup @nodes failed!\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
250
    TBDebugTimeStamp("nalloc finished console setup");
Mac Newbold's avatar
Mac Newbold committed
251 252
}

253 254 255 256 257 258 259
#
# 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);