All new accounts created on Gitlab now require administrator approval. If you invite any collaborators, please let Flux staff know so they can approve the accounts.

nalloc.in 12.1 KB
Newer Older
1
#!/usr/bin/perl -w
Leigh B. Stoller's avatar
Leigh B. Stoller committed
2
#
3
# Copyright (c) 2000-2017 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()
{
37
    print("Usage: nalloc [-d] [-f] [-p] <pid> <eid> <node> <node> <...>\n".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
38
	  "		-p enables partial allocation mode\n".
39
	  "		-f forces allocation, overriding admission control\n" .
Leigh B. Stoller's avatar
Leigh B. Stoller committed
40
	  "		-d enables debugging output\n");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
41 42
    exit(-1);
}
43
my $optlist = "dfp";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
44
my $debug   = 0;
45
my $force   = 0;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
46 47
my $partial = 0;

48 49 50
#
# Configure variables
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
51 52
my $TB          = "@prefix@";
my $consetup    = "$TB/libexec/console_setup";
53
my $makeconf    = "$TB/sbin/dhcpd_makeconf";
54
my $PGENISUPPORT= @PROTOGENI_SUPPORT@;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
55 56 57 58

#
# Testbed Support libraries
#
59 60
use lib '@prefix@/lib';
use libdb;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
61
use libtestbed;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
62 63 64 65
use Experiment;
use Project;
use User;
use Node;
66
use EmulabFeatures;
67
use Reservation;
68

Leigh B. Stoller's avatar
Leigh B. Stoller committed
69 70 71 72
#
# Turn off line buffering on output
#
$| = 1; 
73

Leigh B. Stoller's avatar
Leigh B. Stoller committed
74 75
# For perf analysis.
#TBDebugTimeStampsOn();
76

Leigh B. Stoller's avatar
Leigh B. Stoller committed
77 78 79 80
#
# 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
81 82
my %options = ();

Leigh B. Stoller's avatar
Leigh B. Stoller committed
83 84 85 86
if (! getopts($optlist, \%options)) {
    usage();
}
if (defined($options{"d"})) {
87 88
    $debug = 1;
}
89 90 91
if (defined($options{"f"})) {
    $force = 1;
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
92
if (defined($options{"p"})) {
93 94
    $partial = 1;
}
95
if (@ARGV < 2) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
96
    usage();
97
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
98 99 100
my $pid		= shift;
my $eid		= shift;
my @node_names	= @ARGV;
Mac Newbold's avatar
Mac Newbold committed
101

Leigh B. Stoller's avatar
Leigh B. Stoller committed
102 103 104
#
# Locals
# 
105 106 107 108 109 110 111 112 113 114
my $error	   = 0;
my $noalloc	   = 0;
my @oldnodes	   = ();
my @nodes	   = ();
my $need_consetup  = 0;
my @need_history   = ();
my @need_clearbl   = ();
my @need_pxeconfig = ();
my $errormsg       = "";
my $admission_ctrl = 0;
115
my $slice_expires;
116

Leigh B. Stoller's avatar
Leigh B. Stoller committed
117
TBDebugTimeStamp("nalloc started");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
118

119
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
120 121
# Experiment must exist.
# 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
122 123 124 125
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
126
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
127 128 129 130 131 132
my $exptidx = $experiment->idx();
my $project = $experiment->GetProject();
if (!defined($project)) {
    die("*** $0:\n".
	"    Could not get project for experiment $experiment!\n");
}
133 134 135 136 137 138 139 140

if( $PGENISUPPORT ) {
    require GeniSlice;
    my $slice = GeniSlice->LookupByExperiment( $experiment );
    if( defined( $slice ) ) {
	$slice_expires = $slice->expires();
    }
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
141
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
142 143
#
# User must have permission to modify the experiment.
144
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
145 146 147 148
my $this_user = User->ThisUser();
if (! defined($this_user)) {
    die("*** $0:\n".
	"    You ($UID) do not exist in the Emulab DB!\n");
149
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
150 151 152
if (!$experiment->AccessCheck($this_user, TB_EXPT_MODIFY)) {
    die("*** $0:\n".
	"    You do not have permission to allocate nodes in $pid/$eid\n");
153 154
}

155 156 157
$admission_ctrl = TBGetSiteVar( "general/admission_control" );
$admission_ctrl = defined( $admission_ctrl ) && $admission_ctrl;

158 159
#
# Before locking any tables, do a quick check to make sure the project
Leigh B. Stoller's avatar
Leigh B. Stoller committed
160
# is allowed to allocate the nodes, by type/class, plus other checks.
161 162
#
foreach my $n (@node_names) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
163 164 165 166
    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
167
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
168 169 170 171
    # 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");
172 173
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
174 175 176 177 178
    # 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
179 180
    my $tipserver;
    if ($node->TipServer(\$tipserver) == 0 && defined($tipserver)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
181 182 183
	$need_consetup++;
    }
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
184
TBDebugTimeStamp("nalloc checked all node permissions");
185

186 187 188
# Argh, MySQL locking rules are horrendous!  These locks are required by
# low-level library routines; this is a horrible violation of abstraction;
# and it's all MySQL's fault...
189
if( $PGENISUPPORT ) {
190
    DBQueryFatal("lock tables reserved write, users read, groups read, projects read, future_reservations read, nodes as n read, reserved as r read, experiments as e read, next_reserve as nr read, `geni-cm`.geni_slices as s read, reservation_version write");
191
} else {
192
    DBQueryFatal("lock tables reserved write, users read, groups read, projects read, future_reservations read, nodes as n read, reserved as r read, experiments as e read, next_reserve as nr read, reservation_version write");
193
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
194
TBDebugTimeStamp("nalloc locked tables");
mac's avatar
mac committed
195

Leigh B. Stoller's avatar
Leigh B. Stoller committed
196
# Make a list of nodes to reserve.
197
foreach my $n (@node_names) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
198 199 200 201 202
    my $node = Node->Lookup($n);
    if (!defined($node)) {
	die("*** $0:\n".
	    "    No such node $n!\n");
    }
203 204 205
    # Force reload after table lock.
    $node->FlushReserved();
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
206 207
    my $reserved_experiment = $node->ReservationID();
    if ($reserved_experiment) {
208
	# Someone has already reserved this node
Leigh B. Stoller's avatar
Leigh B. Stoller committed
209 210
	if ($reserved_experiment == $experiment->idx()) {
	    print "$node already reserved to $experiment.\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
211
	    # Do not increment error code since that throws off caller.
212
	    next;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
213
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
214 215 216 217 218
	my $oldreserved_experiment = $node->OldReservationID();
	if ($oldreserved_experiment &&
	    $oldreserved_experiment eq $experiment->idx()) {
	    print "$node already reserved in holding reservation.\n";
	    push(@oldnodes, $node);
219
	    next;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
220 221
	}
	else {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
222
	    print "Someone else has already reserved node $node.\n";
223
	    $noalloc++;
224
	    next;
225
	}
226
    }
227

Leigh B. Stoller's avatar
Leigh B. Stoller committed
228 229 230
    #
    # Add info the list of nodes to reserve; done in a single query below.
    # 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
231
    push(@nodes, $node);
Mac Newbold's avatar
Mac Newbold committed
232
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
233
TBDebugTimeStamp("nalloc checked all nodes");
234

Leigh B. Stoller's avatar
Leigh B. Stoller committed
235
if ($debug) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
236
    print "List Ready: @nodes\nError=$error\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
237
}
238

239 240
# Admission control check -- advisory only, unless sitevar
# general/admission_control is turned on.
241 242

if ($debug) {
243 244 245 246 247
    if( $admission_ctrl ) {
	print "Running admission control verification...\n";
    } else {
	print "Running advisory admission control verification...\n";
    }
248 249 250
}

my %types = ();
251
my %unavail_types = ();
252 253 254 255 256
foreach my $node (@nodes) {
    $types{ $node->type() } = 1;
}
foreach my $type ( keys( %types ) ) {
    my $reservations = Reservation->LookupAll( $type );
257 258
    if( !Reservation->IsFeasible( $reservations, \$errormsg ) ) {
	print "Existing admission control violation for type $type: $errormsg\n";
259 260
	print "Omitting $type admission control verification.\n";
	$unavail_types{ $type } = 1;
261 262 263 264
    }
}

my $endtime = $experiment->autoswap() ?
265
    time() + $experiment->autoswap_timeout * 60 : $slice_expires;
266 267

foreach my $type ( keys( %types ) ) {
268 269
    next if( $unavail_types{ $type } );
    
270
    my $reservations = Reservation->LookupAll( $type );
271
    my $count = 0;
272
    foreach my $node (@nodes) {
273
	$count++ if( $node->type() eq $type );
274
    }
275 276 277 278 279 280 281 282 283 284
    
    my $res = Reservation->CreateImmediate( $pid, $eid,
					    $this_user->uid(),
					    $endtime, $type, $count );
    if ($debug) {
	print "$res\n";
    }
    
    push( @$reservations, $res );
    
285 286
    if( !Reservation->IsFeasible( $reservations, \$errormsg ) ) {
	print "Admission control violation for type $type: $errormsg\n";
287 288 289 290 291 292

	if( $debug ) {
	    foreach my $res (@$reservations) {
		print "$res\n";
	    }
	}
293
	
294 295 296 297
	if( $force ) {
	    print "Forcing allocation anyway...\n";
	    print STDERR "WARNING: SCHEDULED RESERVATIONS ARE NOW INFEASIBLE!\n";
	    # FIXME notify admins about violation
298 299 300 301 302 303 304 305 306 307 308
	}
	$unavail_types{ $type } = 1;
    }
}

if( $admission_ctrl && !$force ) {
    my @goodnodes = ();

    foreach my $node (@nodes) {
	if( !exists( $unavail_types{ $node->type() } ) ) {
	    push( @goodnodes, $node );
309
	} else {
310 311 312
	    # FIXME if some but not all nodes of a given type are
	    # admissable, it would be nice to try harder
	    $noalloc++;
313
	}
314
    }
315 316

    @nodes = @goodnodes;
317 318
}

319 320 321 322 323 324 325 326
foreach my $node (@nodes) {
    # Freshly allocated nodes need a history entry.
    push(@need_history, $node);
    # ... and need to have their bootlogs purged.
    push(@need_clearbl, $node);
    # ... and may need to recreate its pxelinux conf
    push(@need_pxeconfig, $node);
}
327

Leigh B. Stoller's avatar
Leigh B. Stoller committed
328
# Now make the reservations in the DB.
329
if ((!$noalloc || $partial) && (@nodes || @oldnodes) && !$error) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
330 331
    print "Reserving nodes...\n"
	if ($debug);
332

333 334 335 336 337
    # Must do this while we have the tables locked and before we apply
    # any updates, otherwise concurrent readers might fail to detect
    # inconsistencies.
    DBQueryFatal( "UPDATE reservation_version SET version=version+1" );
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
338 339 340 341 342 343 344 345 346 347 348 349 350 351
    # 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++;
	}
352
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
353
    
354 355 356 357
    # 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
358 359
	my $node_id = $node->node_id();
	
360
	if (!DBQueryWarn("update reserved " .
361 362
			 "set exptidx=$exptidx,pid='$pid',eid='$eid', ".
			 "    old_exptidx=0, old_pid='', old_eid='' ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
363
			 "where node_id='$node_id'")) {
364 365 366
	    $error++;
	}
    }
mac's avatar
mac committed
367
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
368
TBDebugTimeStamp("nalloc allocated all nodes");
mac's avatar
mac committed
369

Leigh B. Stoller's avatar
Leigh B. Stoller committed
370
# Unlock tables.
371 372
DBQueryFatal("unlock tables");

Leigh B Stoller's avatar
Leigh B Stoller committed
373
# Okay, now safe to do this
374

Leigh B. Stoller's avatar
Leigh B. Stoller committed
375 376 377 378 379 380
# 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...
381 382 383
    DBQueryWarn("update node_activity set ".
		"  last_ext_act=now(), last_report=now() ".
		"where ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
384 385
		join(" or ",
		     map("node_id='" . $_->node_id() . "'", @nodes)));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
386

387 388 389
    foreach my $node (@nodes) {
	$node->NewRootPasswd();
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
390 391 392
    foreach my $node (@need_history) {
	$node->SetNodeHistory(TB_NODEHISTORY_OP_ALLOC,
			      $this_user, $experiment);
393
    }
Kirk Webb's avatar
 
Kirk Webb committed
394 395 396 397 398

    # 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
399 400
    foreach my $node (@need_clearbl) {
	$node->ClearBootLog();
Kirk Webb's avatar
 
Kirk Webb committed
401
    }
402 403 404 405

    # And since the node is now allocated, we need to redo its pxelinux
    # config file so it won't be stuck in pxewait
    foreach my $node (@need_pxeconfig) {
406 407 408
	if ($node->boot_method() eq "pxelinux") {
	    TBPxelinuxConfig($node);
	}
409
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
410
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
411
TBDebugTimeStamp("updated node_activity, history, and bootlogs");
mac's avatar
mac committed
412

Leigh B. Stoller's avatar
Leigh B. Stoller committed
413 414
# Now setup consoles if needed.
if ($need_consetup && !$error && @nodes) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
415 416 417
    my @nodeids = map($_->node_id(), @nodes);
    
    system("$consetup @nodeids") == 0 or
418
	print STDERR "WARNING: $consetup @nodes failed!\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
419
    TBDebugTimeStamp("nalloc finished console setup");
Mac Newbold's avatar
Mac Newbold committed
420 421
}

422
$EmulabFeatures::verbose = 0;
423 424 425 426 427 428 429 430 431 432 433
if (EmulabFeatures->FeatureEnabled("ExternalNodeManagement",
				   undef, undef,
				   $experiment)) {
    print "ExternalNodeManagement feature is set: Disabling Emulab ".
	  "management of nodes in $experiment ...\n";
    # Shut off dhcp response for nodes in this experiment.
    if (system("$makeconf -i -r")) {
	print STDERR "WARNING: Failed to reconfigure dhcp!\n";
    }
}

434 435 436 437 438 439 440
#
# 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);