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.4 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";
52
my $PGENISUPPORT= @PROTOGENI_SUPPORT@;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
53 54 55 56

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

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

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

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

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

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

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

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

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

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

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

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
224
if ($debug) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
225
    print "List Ready: @nodes\nError=$error\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
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 266 267 268 269 270
# 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
271
# Now make the reservations in the DB.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
272
if ((!$noalloc || $partial) && (@nodes || @oldnodes)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
273 274
    print "Reserving nodes...\n"
	if ($debug);
275

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
308
# Unlock tables.
309 310
DBQueryFatal("unlock tables");

Leigh B Stoller's avatar
Leigh B Stoller committed
311
# Okay, now safe to do this
312

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

325 326 327
    foreach my $node (@nodes) {
	$node->NewRootPasswd();
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
328 329 330
    foreach my $node (@need_history) {
	$node->SetNodeHistory(TB_NODEHISTORY_OP_ALLOC,
			      $this_user, $experiment);
331
    }
Kirk Webb's avatar
 
Kirk Webb committed
332 333 334 335 336

    # 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
337 338
    foreach my $node (@need_clearbl) {
	$node->ClearBootLog();
Kirk Webb's avatar
 
Kirk Webb committed
339
    }
340 341 342 343

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

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

360
$EmulabFeatures::verbose = 0;
361 362 363 364 365 366 367 368 369 370 371
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";
    }
}

372 373 374 375 376 377 378
#
# 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);