nalloc.in 10.8 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()
{
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 105 106
#
# Locals
# 
my $error	  = 0;
my $noalloc	  = 0;
107
my @oldnodes	  = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
108
my @nodes	  = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
109
my $need_consetup = 0;
110
my @need_history  = ();
Kirk Webb's avatar
 
Kirk Webb committed
111
my @need_clearbl  = ();
112
my @need_pxeconfig= ();
113

Leigh B. Stoller's avatar
Leigh B. Stoller committed
114
TBDebugTimeStamp("nalloc started");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
115

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

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

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

172 173 174
# 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...
175 176 177 178 179
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
180
TBDebugTimeStamp("nalloc locked tables");
mac's avatar
mac committed
181

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

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
229
if ($debug) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
230
    print "List Ready: @nodes\nError=$error\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
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
# 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";
270 271 272 273 274 275 276
	if( $force ) {
	    print "Forcing allocation anyway...\n";
	    print STDERR "WARNING: SCHEDULED RESERVATIONS ARE NOW INFEASIBLE!\n";
	    # FIXME notify admins about violation
	} else {
	    # FIXME once we enforce admission control, we will abort here!
	}
277 278 279 280 281 282
	goto admissionfailure;
    }
}

 admissionfailure:

Leigh B. Stoller's avatar
Leigh B. Stoller committed
283
# Now make the reservations in the DB.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
284
if ((!$noalloc || $partial) && (@nodes || @oldnodes)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
285 286
    print "Reserving nodes...\n"
	if ($debug);
287

Leigh B. Stoller's avatar
Leigh B. Stoller committed
288 289 290 291 292 293 294 295 296 297 298 299 300 301
    # 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++;
	}
302
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
303
    
304 305 306 307
    # 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
308 309
	my $node_id = $node->node_id();
	
310
	if (!DBQueryWarn("update reserved " .
311 312
			 "set exptidx=$exptidx,pid='$pid',eid='$eid', ".
			 "    old_exptidx=0, old_pid='', old_eid='' ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
313
			 "where node_id='$node_id'")) {
314 315 316
	    $error++;
	}
    }
mac's avatar
mac committed
317
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
318
TBDebugTimeStamp("nalloc allocated all nodes");
mac's avatar
mac committed
319

Leigh B. Stoller's avatar
Leigh B. Stoller committed
320
# Unlock tables.
321 322
DBQueryFatal("unlock tables");

Leigh B Stoller's avatar
Leigh B Stoller committed
323
# Okay, now safe to do this
324

Leigh B. Stoller's avatar
Leigh B. Stoller committed
325 326 327 328 329 330
# 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...
331 332 333
    DBQueryWarn("update node_activity set ".
		"  last_ext_act=now(), last_report=now() ".
		"where ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
334 335
		join(" or ",
		     map("node_id='" . $_->node_id() . "'", @nodes)));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
336

337 338 339
    foreach my $node (@nodes) {
	$node->NewRootPasswd();
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
340 341 342
    foreach my $node (@need_history) {
	$node->SetNodeHistory(TB_NODEHISTORY_OP_ALLOC,
			      $this_user, $experiment);
343
    }
Kirk Webb's avatar
 
Kirk Webb committed
344 345 346 347 348

    # 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
349 350
    foreach my $node (@need_clearbl) {
	$node->ClearBootLog();
Kirk Webb's avatar
 
Kirk Webb committed
351
    }
352 353 354 355

    # 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) {
356 357 358
	if ($node->boot_method() eq "pxelinux") {
	    TBPxelinuxConfig($node);
	}
359
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
360
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
361
TBDebugTimeStamp("updated node_activity, history, and bootlogs");
mac's avatar
mac committed
362

Leigh B. Stoller's avatar
Leigh B. Stoller committed
363 364
# Now setup consoles if needed.
if ($need_consetup && !$error && @nodes) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
365 366 367
    my @nodeids = map($_->node_id(), @nodes);
    
    system("$consetup @nodeids") == 0 or
368
	print STDERR "WARNING: $consetup @nodes failed!\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
369
    TBDebugTimeStamp("nalloc finished console setup");
Mac Newbold's avatar
Mac Newbold committed
370 371
}

372
$EmulabFeatures::verbose = 0;
373 374 375 376 377 378 379 380 381 382 383
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";
    }
}

384 385 386 387 388 389 390
#
# 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);