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 10.1 KB
Newer Older
1
#!/usr/bin/perl -w
Leigh B. Stoller's avatar
Leigh B. Stoller committed
2
#
3
# Copyright (c) 2000-2015 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
my $TB          = "@prefix@";
my $consetup    = "$TB/libexec/console_setup";
51
my $makeconf    = "$TB/sbin/dhcpd_makeconf";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
52 53 54 55

#
# 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
use EmulabFeatures;
64
use Reservation;
65

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

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

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

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

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
108
TBDebugTimeStamp("nalloc started");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
109

110
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
111 112
# Experiment must exist.
# 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
113 114 115 116
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
117
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
118 119 120 121 122 123 124
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
125 126
#
# User must have permission to modify the experiment.
127
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
128 129 130 131
my $this_user = User->ThisUser();
if (! defined($this_user)) {
    die("*** $0:\n".
	"    You ($UID) do not exist in the Emulab DB!\n");
132
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
133 134 135
if (!$experiment->AccessCheck($this_user, TB_EXPT_MODIFY)) {
    die("*** $0:\n".
	"    You do not have permission to allocate nodes in $pid/$eid\n");
136 137
}

138 139
#
# Before locking any tables, do a quick check to make sure the project
Leigh B. Stoller's avatar
Leigh B. Stoller committed
140
# is allowed to allocate the nodes, by type/class, plus other checks.
141 142
#
foreach my $n (@node_names) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
143 144 145 146
    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
147
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
148 149 150 151
    # 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");
152 153
    }

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

166 167 168 169
# 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...
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");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
170
TBDebugTimeStamp("nalloc locked tables");
mac's avatar
mac committed
171

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
212 213 214
    #
    # Add info the list of nodes to reserve; done in a single query below.
    # 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
215
    push(@nodes, $node);
Mac Newbold's avatar
Mac Newbold committed
216
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
217
TBDebugTimeStamp("nalloc checked all nodes");
218

Leigh B. Stoller's avatar
Leigh B. Stoller committed
219
if ($debug) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
220
    print "List Ready: @nodes\nError=$error\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
221
}
222

223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265
# Admission control check -- advisory only, for now.

if ($debug) {
    print "Running advisory admission control verification...\n";
}

my %types = ();
foreach my $node (@nodes) {
    $types{ $node->type() } = 1;
}
foreach my $type ( keys( %types ) ) {
    my $reservations = Reservation->LookupAll( $type );
    if( !Reservation->IsFeasible( $reservations, \$error ) ) {
	print "Existing admission control violation for type $type: $error\n";
	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 );
	}
    }
    if( !Reservation->IsFeasible( $reservations, \$error ) ) {
	print "Admission control violation for type $type: $error\n";
	goto admissionfailure;
    }
}

 admissionfailure:

Leigh B. Stoller's avatar
Leigh B. Stoller committed
266
# Now make the reservations in the DB.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
267
if ((!$noalloc || $partial) && (@nodes || @oldnodes)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
268 269
    print "Reserving nodes...\n"
	if ($debug);
270

Leigh B. Stoller's avatar
Leigh B. Stoller committed
271 272 273 274 275 276 277 278 279 280 281 282 283 284
    # 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++;
	}
285
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
286
    
287 288 289 290
    # 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
291 292
	my $node_id = $node->node_id();
	
293
	if (!DBQueryWarn("update reserved " .
294 295
			 "set exptidx=$exptidx,pid='$pid',eid='$eid', ".
			 "    old_exptidx=0, old_pid='', old_eid='' ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
296
			 "where node_id='$node_id'")) {
297 298 299
	    $error++;
	}
    }
mac's avatar
mac committed
300
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
301
TBDebugTimeStamp("nalloc allocated all nodes");
mac's avatar
mac committed
302

Leigh B. Stoller's avatar
Leigh B. Stoller committed
303
# Unlock tables.
304 305
DBQueryFatal("unlock tables");

Leigh B Stoller's avatar
Leigh B Stoller committed
306
# Okay, now safe to do this
307

Leigh B. Stoller's avatar
Leigh B. Stoller committed
308 309 310 311 312 313
# 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...
314 315 316
    DBQueryWarn("update node_activity set ".
		"  last_ext_act=now(), last_report=now() ".
		"where ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
317 318
		join(" or ",
		     map("node_id='" . $_->node_id() . "'", @nodes)));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
319

320 321 322
    foreach my $node (@nodes) {
	$node->NewRootPasswd();
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
323 324 325
    foreach my $node (@need_history) {
	$node->SetNodeHistory(TB_NODEHISTORY_OP_ALLOC,
			      $this_user, $experiment);
326
    }
Kirk Webb's avatar
 
Kirk Webb committed
327 328 329 330 331

    # 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
332 333
    foreach my $node (@need_clearbl) {
	$node->ClearBootLog();
Kirk Webb's avatar
 
Kirk Webb committed
334
    }
335 336 337 338

    # 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) {
339 340 341
	if ($node->boot_method() eq "pxelinux") {
	    TBPxelinuxConfig($node);
	}
342
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
343
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
344
TBDebugTimeStamp("updated node_activity, history, and bootlogs");
mac's avatar
mac committed
345

Leigh B. Stoller's avatar
Leigh B. Stoller committed
346 347
# Now setup consoles if needed.
if ($need_consetup && !$error && @nodes) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
348 349 350
    my @nodeids = map($_->node_id(), @nodes);
    
    system("$consetup @nodeids") == 0 or
351
	print STDERR "WARNING: $consetup @nodes failed!\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
352
    TBDebugTimeStamp("nalloc finished console setup");
Mac Newbold's avatar
Mac Newbold committed
353 354
}

355
$EmulabFeatures::verbose = 0;
356 357 358 359 360 361 362 363 364 365 366
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";
    }
}

367 368 369 370 371 372 373
#
# 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);