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

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
166 167 168
# Must lock this table!
DBQueryFatal("lock tables reserved write");
TBDebugTimeStamp("nalloc locked tables");
mac's avatar
mac committed
169

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

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

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
221
# Now make the reservations in the DB.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
222
if ((!$noalloc || $partial) && (@nodes || @oldnodes)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
223 224
    print "Reserving nodes...\n"
	if ($debug);
225

Leigh B. Stoller's avatar
Leigh B. Stoller committed
226 227 228 229 230 231 232 233 234 235 236 237 238 239
    # 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++;
	}
240
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
241
    
242 243 244 245
    # 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
246 247
	my $node_id = $node->node_id();
	
248
	if (!DBQueryWarn("update reserved " .
249 250
			 "set exptidx=$exptidx,pid='$pid',eid='$eid', ".
			 "    old_exptidx=0, old_pid='', old_eid='' ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
251
			 "where node_id='$node_id'")) {
252 253 254
	    $error++;
	}
    }
mac's avatar
mac committed
255
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
256
TBDebugTimeStamp("nalloc allocated all nodes");
mac's avatar
mac committed
257

Leigh B. Stoller's avatar
Leigh B. Stoller committed
258
# Unlock tables.
259 260
DBQueryFatal("unlock tables");

Leigh B Stoller's avatar
Leigh B Stoller committed
261
# Okay, now safe to do this
262

Leigh B. Stoller's avatar
Leigh B. Stoller committed
263 264 265 266 267 268
# 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...
269 270 271
    DBQueryWarn("update node_activity set ".
		"  last_ext_act=now(), last_report=now() ".
		"where ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
272 273
		join(" or ",
		     map("node_id='" . $_->node_id() . "'", @nodes)));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
274

275 276 277
    foreach my $node (@nodes) {
	$node->NewRootPasswd();
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
278 279 280
    foreach my $node (@need_history) {
	$node->SetNodeHistory(TB_NODEHISTORY_OP_ALLOC,
			      $this_user, $experiment);
281
    }
Kirk Webb's avatar
 
Kirk Webb committed
282 283 284 285 286

    # 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
287 288
    foreach my $node (@need_clearbl) {
	$node->ClearBootLog();
Kirk Webb's avatar
 
Kirk Webb committed
289
    }
290 291 292 293 294 295 296

    # 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) {
	TBPxelinuxConfig($node)
	    if ($node->boot_method() eq "pxelinux");
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
297
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
298
TBDebugTimeStamp("updated node_activity, history, and bootlogs");
mac's avatar
mac committed
299

Leigh B. Stoller's avatar
Leigh B. Stoller committed
300 301
# Now setup consoles if needed.
if ($need_consetup && !$error && @nodes) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
302 303 304
    my @nodeids = map($_->node_id(), @nodes);
    
    system("$consetup @nodeids") == 0 or
305
	print STDERR "WARNING: $consetup @nodes failed!\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
306
    TBDebugTimeStamp("nalloc finished console setup");
Mac Newbold's avatar
Mac Newbold committed
307 308
}

309
$EmulabFeatures::verbose = 0;
310 311 312 313 314 315 316 317 318 319 320
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";
    }
}

321 322 323 324 325 326 327
#
# 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);