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 11.8 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

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

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
133 134
#
# User must have permission to modify the experiment.
135
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
136 137 138 139
my $this_user = User->ThisUser();
if (! defined($this_user)) {
    die("*** $0:\n".
	"    You ($UID) do not exist in the Emulab DB!\n");
140
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
141 142 143
if (!$experiment->AccessCheck($this_user, TB_EXPT_MODIFY)) {
    die("*** $0:\n".
	"    You do not have permission to allocate nodes in $pid/$eid\n");
144 145
}

146 147 148
$admission_ctrl = TBGetSiteVar( "general/admission_control" );
$admission_ctrl = defined( $admission_ctrl ) && $admission_ctrl;

149 150
#
# Before locking any tables, do a quick check to make sure the project
Leigh B. Stoller's avatar
Leigh B. Stoller committed
151
# is allowed to allocate the nodes, by type/class, plus other checks.
152 153
#
foreach my $n (@node_names) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
154 155 156 157
    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
158
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
159 160 161 162
    # 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");
163 164
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
165 166 167 168 169
    # 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
170 171
    my $tipserver;
    if ($node->TipServer(\$tipserver) == 0 && defined($tipserver)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
172 173 174
	$need_consetup++;
    }
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
175
TBDebugTimeStamp("nalloc checked all node permissions");
176

177 178
my $endtime = Reservation->ExpectedEnd( $experiment );

179 180 181
# 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...
182
if( $PGENISUPPORT ) {
183
    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");
184
} else {
185
    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");
186
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
187
TBDebugTimeStamp("nalloc locked tables");
mac's avatar
mac committed
188

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
221 222 223
    #
    # Add info the list of nodes to reserve; done in a single query below.
    # 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
224
    push(@nodes, $node);
Mac Newbold's avatar
Mac Newbold committed
225
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
226
TBDebugTimeStamp("nalloc checked all nodes");
227

Leigh B. Stoller's avatar
Leigh B. Stoller committed
228
if ($debug) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
229
    print "List Ready: @nodes\nError=$error\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
230
}
231

232 233
# Admission control check -- advisory only, unless sitevar
# general/admission_control is turned on.
234 235

if ($debug) {
236 237 238 239 240
    if( $admission_ctrl ) {
	print "Running admission control verification...\n";
    } else {
	print "Running advisory admission control verification...\n";
    }
241 242 243
}

my %types = ();
244
my %unavail_types = ();
245 246 247 248 249
foreach my $node (@nodes) {
    $types{ $node->type() } = 1;
}
foreach my $type ( keys( %types ) ) {
    my $reservations = Reservation->LookupAll( $type );
250 251
    if( !Reservation->IsFeasible( $reservations, \$errormsg ) ) {
	print "Existing admission control violation for type $type: $errormsg\n";
252 253
	print "Omitting $type admission control verification.\n";
	$unavail_types{ $type } = 1;
254 255 256 257
    }
}

foreach my $type ( keys( %types ) ) {
258 259
    next if( $unavail_types{ $type } );
    
260
    my $reservations = Reservation->LookupAll( $type );
261
    my $count = 0;
262
    foreach my $node (@nodes) {
263
	$count++ if( $node->type() eq $type );
264
    }
265 266 267 268 269 270 271 272 273 274
    
    my $res = Reservation->CreateImmediate( $pid, $eid,
					    $this_user->uid(),
					    $endtime, $type, $count );
    if ($debug) {
	print "$res\n";
    }
    
    push( @$reservations, $res );
    
275 276
    if( !Reservation->IsFeasible( $reservations, \$errormsg ) ) {
	print "Admission control violation for type $type: $errormsg\n";
277 278 279 280 281 282

	if( $debug ) {
	    foreach my $res (@$reservations) {
		print "$res\n";
	    }
	}
283
	
284 285 286 287
	if( $force ) {
	    print "Forcing allocation anyway...\n";
	    print STDERR "WARNING: SCHEDULED RESERVATIONS ARE NOW INFEASIBLE!\n";
	    # FIXME notify admins about violation
288 289 290 291 292 293 294 295 296 297 298
	}
	$unavail_types{ $type } = 1;
    }
}

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

    foreach my $node (@nodes) {
	if( !exists( $unavail_types{ $node->type() } ) ) {
	    push( @goodnodes, $node );
299
	} else {
300 301 302
	    # FIXME if some but not all nodes of a given type are
	    # admissable, it would be nice to try harder
	    $noalloc++;
303
	}
304
    }
305 306

    @nodes = @goodnodes;
307 308
}

309 310 311 312 313 314 315 316
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);
}
317

Leigh B. Stoller's avatar
Leigh B. Stoller committed
318
# Now make the reservations in the DB.
319
if ((!$noalloc || $partial) && (@nodes || @oldnodes) && !$error) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
320 321
    print "Reserving nodes...\n"
	if ($debug);
322

323 324 325 326 327
    # 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
328 329 330 331 332 333 334 335 336 337 338 339 340 341
    # 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++;
	}
342
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
343
    
344 345 346 347
    # 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
348 349
	my $node_id = $node->node_id();
	
350
	if (!DBQueryWarn("update reserved " .
351 352
			 "set exptidx=$exptidx,pid='$pid',eid='$eid', ".
			 "    old_exptidx=0, old_pid='', old_eid='' ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
353
			 "where node_id='$node_id'")) {
354 355 356
	    $error++;
	}
    }
mac's avatar
mac committed
357
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
358
TBDebugTimeStamp("nalloc allocated all nodes");
mac's avatar
mac committed
359

Leigh B. Stoller's avatar
Leigh B. Stoller committed
360
# Unlock tables.
361 362
DBQueryFatal("unlock tables");

Leigh B Stoller's avatar
Leigh B Stoller committed
363
# Okay, now safe to do this
364

Leigh B. Stoller's avatar
Leigh B. Stoller committed
365 366 367 368 369 370
# 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...
371 372 373
    DBQueryWarn("update node_activity set ".
		"  last_ext_act=now(), last_report=now() ".
		"where ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
374 375
		join(" or ",
		     map("node_id='" . $_->node_id() . "'", @nodes)));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
376

377 378 379
    foreach my $node (@nodes) {
	$node->NewRootPasswd();
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
380 381 382
    foreach my $node (@need_history) {
	$node->SetNodeHistory(TB_NODEHISTORY_OP_ALLOC,
			      $this_user, $experiment);
383
    }
Kirk Webb's avatar
 
Kirk Webb committed
384 385 386 387 388

    # 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
389 390
    foreach my $node (@need_clearbl) {
	$node->ClearBootLog();
Kirk Webb's avatar
 
Kirk Webb committed
391
    }
392 393 394 395

    # 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) {
396 397 398
	if ($node->boot_method() eq "pxelinux") {
	    TBPxelinuxConfig($node);
	}
399
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
400
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
401
TBDebugTimeStamp("updated node_activity, history, and bootlogs");
mac's avatar
mac committed
402

Leigh B. Stoller's avatar
Leigh B. Stoller committed
403 404
# Now setup consoles if needed.
if ($need_consetup && !$error && @nodes) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
405 406 407
    my @nodeids = map($_->node_id(), @nodes);
    
    system("$consetup @nodeids") == 0 or
408
	print STDERR "WARNING: $consetup @nodes failed!\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
409
    TBDebugTimeStamp("nalloc finished console setup");
Mac Newbold's avatar
Mac Newbold committed
410 411
}

412
$EmulabFeatures::verbose = 0;
413 414 415 416 417 418 419 420 421 422 423
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";
    }
}

424 425 426 427 428 429 430
#
# 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);