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.3 KB
Newer Older
1
#!/usr/bin/perl -w
Leigh B. Stoller's avatar
Leigh B. Stoller committed
2
#
Leigh B Stoller's avatar
Leigh B Stoller committed
3
# Copyright (c) 2000-2013 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

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

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

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

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

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

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

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

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

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

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
255
# Unlock tables.
256 257
DBQueryFatal("unlock tables");

Leigh B Stoller's avatar
Leigh B Stoller committed
258
# Okay, now safe to do this
259

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

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

    # 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
284 285
    foreach my $node (@need_clearbl) {
	$node->ClearBootLog();
Kirk Webb's avatar
 
Kirk Webb committed
286
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
287
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
288
TBDebugTimeStamp("updated node_activity, history, and bootlogs");
mac's avatar
mac committed
289

Leigh B. Stoller's avatar
Leigh B. Stoller committed
290 291
# Now setup consoles if needed.
if ($need_consetup && !$error && @nodes) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
292 293 294
    my @nodeids = map($_->node_id(), @nodes);
    
    system("$consetup @nodeids") == 0 or
295
	print STDERR "WARNING: $consetup @nodes failed!\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
296
    TBDebugTimeStamp("nalloc finished console setup");
Mac Newbold's avatar
Mac Newbold committed
297 298
}

299
$EmulabFeatures::verbose = 0;
300 301 302 303 304 305 306 307 308 309 310
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";
    }
}

311 312 313 314 315 316 317
#
# 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);