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.1 KB
Newer Older
1
#!/usr/bin/perl -w
Leigh B. Stoller's avatar
Leigh B. Stoller committed
2
#
3
# Copyright (c) 2000-2016 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 132
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
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 179
# 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...
180 181 182 183 184
if( $PGENISUPPORT ) {
    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");
} else {
    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");
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
185
TBDebugTimeStamp("nalloc locked tables");
mac's avatar
mac committed
186

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

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

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

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

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

my %types = ();
foreach my $node (@nodes) {
    $types{ $node->type() } = 1;
}
foreach my $type ( keys( %types ) ) {
    my $reservations = Reservation->LookupAll( $type );
255 256
    if( !Reservation->IsFeasible( $reservations, \$errormsg ) ) {
	print "Existing admission control violation for type $type: $errormsg\n";
257
	if( $admission_ctrl ) {
258
	    $error++;
259
	}
260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280
	print "Omitting admission control verification.\n";
	goto admissionfailure;
    }
}

my $endtime = $experiment->autoswap() ?
    time() + $experiment->autoswap_timeout * 60 : undef;

foreach my $type ( keys( %types ) ) {
    my $reservations = Reservation->LookupAll( $type );
    foreach my $node (@nodes) {
	if( $node->type() eq $type ) {
	    my $res = Reservation->CreateImmediate( $pid, undef,
						    $this_user->uid(),
						    $endtime, $type, 1 );
	    if ($debug) {
		print "$res\n";
	    }
	    push( @$reservations, $res );
	}
    }
281 282
    if( !Reservation->IsFeasible( $reservations, \$errormsg ) ) {
	print "Admission control violation for type $type: $errormsg\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
	} else {
288
	    if( $admission_ctrl ) {
289
		$error++;
290
	    }
291
	}
292 293 294 295 296 297
	goto admissionfailure;
    }
}

 admissionfailure:

Leigh B. Stoller's avatar
Leigh B. Stoller committed
298
# Now make the reservations in the DB.
299
if ((!$noalloc || $partial) && (@nodes || @oldnodes) && !$error) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
300 301
    print "Reserving nodes...\n"
	if ($debug);
302

Leigh B. Stoller's avatar
Leigh B. Stoller committed
303 304 305 306 307 308 309 310 311 312 313 314 315 316
    # 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++;
	}
317
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
318
    
319 320 321 322
    # 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
323 324
	my $node_id = $node->node_id();
	
325
	if (!DBQueryWarn("update reserved " .
326 327
			 "set exptidx=$exptidx,pid='$pid',eid='$eid', ".
			 "    old_exptidx=0, old_pid='', old_eid='' ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
328
			 "where node_id='$node_id'")) {
329 330 331
	    $error++;
	}
    }
mac's avatar
mac committed
332
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
333
TBDebugTimeStamp("nalloc allocated all nodes");
mac's avatar
mac committed
334

Leigh B. Stoller's avatar
Leigh B. Stoller committed
335
# Unlock tables.
336 337
DBQueryFatal("unlock tables");

Leigh B Stoller's avatar
Leigh B Stoller committed
338
# Okay, now safe to do this
339

Leigh B. Stoller's avatar
Leigh B. Stoller committed
340 341 342 343 344 345
# 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...
346 347 348
    DBQueryWarn("update node_activity set ".
		"  last_ext_act=now(), last_report=now() ".
		"where ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
349 350
		join(" or ",
		     map("node_id='" . $_->node_id() . "'", @nodes)));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
351

352 353 354
    foreach my $node (@nodes) {
	$node->NewRootPasswd();
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
355 356 357
    foreach my $node (@need_history) {
	$node->SetNodeHistory(TB_NODEHISTORY_OP_ALLOC,
			      $this_user, $experiment);
358
    }
Kirk Webb's avatar
 
Kirk Webb committed
359 360 361 362 363

    # 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
364 365
    foreach my $node (@need_clearbl) {
	$node->ClearBootLog();
Kirk Webb's avatar
 
Kirk Webb committed
366
    }
367 368 369 370

    # 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) {
371 372 373
	if ($node->boot_method() eq "pxelinux") {
	    TBPxelinuxConfig($node);
	}
374
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
375
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
376
TBDebugTimeStamp("updated node_activity, history, and bootlogs");
mac's avatar
mac committed
377

Leigh B. Stoller's avatar
Leigh B. Stoller committed
378 379
# Now setup consoles if needed.
if ($need_consetup && !$error && @nodes) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
380 381 382
    my @nodeids = map($_->node_id(), @nodes);
    
    system("$consetup @nodeids") == 0 or
383
	print STDERR "WARNING: $consetup @nodes failed!\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
384
    TBDebugTimeStamp("nalloc finished console setup");
Mac Newbold's avatar
Mac Newbold committed
385 386
}

387
$EmulabFeatures::verbose = 0;
388 389 390 391 392 393 394 395 396 397 398
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";
    }
}

399 400 401 402 403 404 405
#
# 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);