nalloc.in 7.8 KB
Newer Older
1
#!/usr/bin/perl -w
Leigh B. Stoller's avatar
Leigh B. Stoller committed
2
#
Leigh B Stoller's avatar
Leigh B Stoller committed
3
# Copyright (c) 2000-2013 University of Utah and the Flux Group.
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
# 
# {{{EMULAB-LICENSE
# 
# This file is part of the Emulab network testbed software.
# 
# This file is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
# 
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General Public
# License for more details.
# 
# You should have received a copy of the GNU Affero General Public License
# along with this file.  If not, see <http://www.gnu.org/licenses/>.
# 
# }}}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
23
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
24
use strict;
25
use English;
26
use Getopt::Std;
Mac Newbold's avatar
Mac Newbold committed
27

28 29
#
# nalloc - allocate nodes to an experiment. Takes a pid, and eid, and
Leigh B. Stoller's avatar
Leigh B. Stoller committed
30
# a list of nodes. Only nodes that are free can be allocated.
31
#
32 33 34
# 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
35 36
sub usage()
{
Leigh B. Stoller's avatar
Leigh B. Stoller committed
37
    print("Usage: nalloc [-d] [-p] <pid> <eid> <node> <node> <...>\n".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
38
	  "		-p enables partial allocation mode\n".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
39
	  "		-d enables debugging output\n");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
40 41 42 43 44 45
    exit(-1);
}
my $optlist = "dp";
my $debug   = 0;
my $partial = 0;

46 47 48
#
# Configure variables
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
49 50 51 52 53 54 55
my $TB          = "@prefix@";
my $consetup    = "$TB/libexec/console_setup";
my $exportsetup = "$TB/sbin/exports_setup";

#
# Testbed Support libraries
#
56 57
use lib '@prefix@/lib';
use libdb;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
58
use libtestbed;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
59 60 61 62
use Experiment;
use Project;
use User;
use Node;
63

Leigh B. Stoller's avatar
Leigh B. Stoller committed
64 65 66 67
#
# Turn off line buffering on output
#
$| = 1; 
68

Leigh B. Stoller's avatar
Leigh B. Stoller committed
69 70
# For perf analysis.
#TBDebugTimeStampsOn();
71

Leigh B. Stoller's avatar
Leigh B. Stoller committed
72 73 74 75
#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
76 77
my %options = ();

Leigh B. Stoller's avatar
Leigh B. Stoller committed
78 79 80 81
if (! getopts($optlist, \%options)) {
    usage();
}
if (defined($options{"d"})) {
82 83
    $debug = 1;
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
84
if (defined($options{"p"})) {
85 86
    $partial = 1;
}
87
if (@ARGV < 2) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
88
    usage();
89
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
90 91 92
my $pid		= shift;
my $eid		= shift;
my @node_names	= @ARGV;
Mac Newbold's avatar
Mac Newbold committed
93

Leigh B. Stoller's avatar
Leigh B. Stoller committed
94 95 96 97 98
#
# Locals
# 
my $error	  = 0;
my $noalloc	  = 0;
99
my @oldnodes	  = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
100
my @nodes	  = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
101
my $need_consetup = 0;
102
my @need_history  = ();
Kirk Webb's avatar
 
Kirk Webb committed
103
my @need_clearbl  = ();
104

Leigh B. Stoller's avatar
Leigh B. Stoller committed
105
TBDebugTimeStamp("nalloc started");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
106

107
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
108 109
# Experiment must exist.
# 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
110 111 112 113
my $experiment = Experiment->Lookup($pid, $eid);
if (! $experiment) {
    die("*** $0:\n".
	"    No such experiment $pid/$eid in the Emulab Database.\n");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
114
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
115 116 117 118 119 120 121
my $exptidx = $experiment->idx();
my $project = $experiment->GetProject();
if (!defined($project)) {
    die("*** $0:\n".
	"    Could not get project for experiment $experiment!\n");
}
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
122 123
#
# User must have permission to modify the experiment.
124
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
125 126 127 128
my $this_user = User->ThisUser();
if (! defined($this_user)) {
    die("*** $0:\n".
	"    You ($UID) do not exist in the Emulab DB!\n");
129
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
130 131 132
if (!$experiment->AccessCheck($this_user, TB_EXPT_MODIFY)) {
    die("*** $0:\n".
	"    You do not have permission to allocate nodes in $pid/$eid\n");
133 134
}

135 136
#
# Before locking any tables, do a quick check to make sure the project
Leigh B. Stoller's avatar
Leigh B. Stoller committed
137
# is allowed to allocate the nodes, by type/class, plus other checks.
138 139
#
foreach my $n (@node_names) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
140 141 142 143
    my $node = Node->Lookup($n);
    if (!defined($node)) {
	die("*** $0:\n".
	    "    No such node $n!\n");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
144
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
145 146 147 148
    # Project allowed to allocate this node type/class?
    if (!$this_user->IsAdmin() && !$node->AllocCheck($project)) {
	die("*** $0:\n".
	    "    You are not allowed to allocate $n to project $pid!\n");
149 150
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
151 152 153 154 155
    # 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.
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
156 157
    my $tipserver;
    if ($node->TipServer(\$tipserver) == 0 && defined($tipserver)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
158 159 160
	$need_consetup++;
    }
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
161
TBDebugTimeStamp("nalloc checked all node permissions");
162

Leigh B. Stoller's avatar
Leigh B. Stoller committed
163 164 165
# Must lock this table!
DBQueryFatal("lock tables reserved write");
TBDebugTimeStamp("nalloc locked tables");
mac's avatar
mac committed
166

Leigh B. Stoller's avatar
Leigh B. Stoller committed
167
# Make a list of nodes to reserve.
168
foreach my $n (@node_names) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
169 170 171 172 173
    my $node = Node->Lookup($n);
    if (!defined($node)) {
	die("*** $0:\n".
	    "    No such node $n!\n");
    }
174 175 176
    # Force reload after table lock.
    $node->FlushReserved();
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
177 178
    my $reserved_experiment = $node->ReservationID();
    if ($reserved_experiment) {
179
	# Someone has already reserved this node
Leigh B. Stoller's avatar
Leigh B. Stoller committed
180 181
	if ($reserved_experiment == $experiment->idx()) {
	    print "$node already reserved to $experiment.\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
182
	    # Do not increment error code since that throws off caller.
183
	    next;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
184
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
185 186 187 188 189
	my $oldreserved_experiment = $node->OldReservationID();
	if ($oldreserved_experiment &&
	    $oldreserved_experiment eq $experiment->idx()) {
	    print "$node already reserved in holding reservation.\n";
	    push(@oldnodes, $node);
190
	    next;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
191 192
	}
	else {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
193
	    print "Someone else has already reserved node $node.\n";
194
	    $noalloc++;
195
	    next;
196
	}
197
    }
198 199
    else {
	# Freshly allocated nodes need a history entry.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
200
	push(@need_history, $node);
Kirk Webb's avatar
 
Kirk Webb committed
201
        # ... and need to have their bootlogs purged.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
202
        push(@need_clearbl, $node);
203
    }
204

Leigh B. Stoller's avatar
Leigh B. Stoller committed
205 206 207
    #
    # Add info the list of nodes to reserve; done in a single query below.
    # 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
208
    push(@nodes, $node);
Mac Newbold's avatar
Mac Newbold committed
209
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
210
TBDebugTimeStamp("nalloc checked all nodes");
211

Leigh B. Stoller's avatar
Leigh B. Stoller committed
212
if ($debug) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
213
    print "List Ready: @nodes\nError=$error\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
214
}
215

Leigh B. Stoller's avatar
Leigh B. Stoller committed
216
# Now make the reservations in the DB.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
217
if ((!$noalloc || $partial) && (@nodes || @oldnodes)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
218 219
    print "Reserving nodes...\n"
	if ($debug);
220

Leigh B. Stoller's avatar
Leigh B. Stoller committed
221 222 223 224 225 226 227 228 229 230 231 232 233 234
    # Generate strings for a single query. Could use perl map().
    if (@nodes) {
	my @values = ();
	foreach my $node (@nodes) {
	    my $node_id = $node->node_id();
	    
	    push(@values,
		 "('$node_id',$exptidx,'$pid','$eid','$node_id','','')");
	}
	if (! DBQueryWarn("replace into reserved ".
			  " (node_id,exptidx,pid,eid,vname,old_pid,old_eid) ".
			  "values ". join(",",@values))) {
	    $error++;
	}
235
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
236
    
237 238 239 240
    # 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) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
241 242
	my $node_id = $node->node_id();
	
243
	if (!DBQueryWarn("update reserved " .
244 245
			 "set exptidx=$exptidx,pid='$pid',eid='$eid', ".
			 "    old_exptidx=0, old_pid='', old_eid='' ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
246
			 "where node_id='$node_id'")) {
247 248 249
	    $error++;
	}
    }
mac's avatar
mac committed
250
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
251
TBDebugTimeStamp("nalloc allocated all nodes");
mac's avatar
mac committed
252

Leigh B. Stoller's avatar
Leigh B. Stoller committed
253
# Unlock tables.
254 255
DBQueryFatal("unlock tables");

Leigh B Stoller's avatar
Leigh B Stoller committed
256
# Okay, now safe to do this
257

Leigh B. Stoller's avatar
Leigh B. Stoller committed
258 259 260 261 262 263
# 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...
Leigh B. Stoller's avatar
Leigh B. Stoller committed
264 265 266
    DBQueryWarn("update node_activity set last_ext_act=now() where ".
		join(" or ",
		     map("node_id='" . $_->node_id() . "'", @nodes)));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
267

268 269 270
    foreach my $node (@nodes) {
	$node->NewRootPasswd();
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
271 272 273
    foreach my $node (@need_history) {
	$node->SetNodeHistory(TB_NODEHISTORY_OP_ALLOC,
			      $this_user, $experiment);
274
    }
Kirk Webb's avatar
 
Kirk Webb committed
275 276 277 278 279

    # 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.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
280 281
    foreach my $node (@need_clearbl) {
	$node->ClearBootLog();
Kirk Webb's avatar
 
Kirk Webb committed
282
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
283
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
284
TBDebugTimeStamp("updated node_activity, history, and bootlogs");
mac's avatar
mac committed
285

Leigh B. Stoller's avatar
Leigh B. Stoller committed
286 287
# Now setup consoles if needed.
if ($need_consetup && !$error && @nodes) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
288 289 290
    my @nodeids = map($_->node_id(), @nodes);
    
    system("$consetup @nodeids") == 0 or
291
	print STDERR "WARNING: $consetup @nodes failed!\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
292
    TBDebugTimeStamp("nalloc finished console setup");
Mac Newbold's avatar
Mac Newbold committed
293 294
}

295 296 297 298 299 300 301
#
# 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);