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 7.83 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 52 53 54 55
my $TB          = "@prefix@";
my $consetup    = "$TB/libexec/console_setup";
my $exportsetup = "$TB/sbin/exports_setup";

#
# 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

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

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

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

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

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
105
TBDebugTimeStamp("nalloc started");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
106

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

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

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

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

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

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

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

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

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

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

Leigh B Stoller's avatar
Leigh B Stoller committed
256
# Okay, now safe to do this
257

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

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

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

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

297 298 299 300 301 302 303
#
# 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);