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.12 KB
Newer Older
1
#!/usr/bin/perl -w
Leigh B. Stoller's avatar
Leigh B. Stoller committed
2 3
#
# EMULAB-COPYRIGHT
4
# Copyright (c) 2000-2009 University of Utah and the Flux Group.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
5 6
# All rights reserved.
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
7
use strict;
8
use English;
9
use Getopt::Std;
Mac Newbold's avatar
Mac Newbold committed
10

11 12
#
# nalloc - allocate nodes to an experiment. Takes a pid, and eid, and
Leigh B. Stoller's avatar
Leigh B. Stoller committed
13
# a list of nodes. Only nodes that are free can be allocated.
14
#
15 16 17
# 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
18 19
sub usage()
{
Leigh B. Stoller's avatar
Leigh B. Stoller committed
20
    print("Usage: nalloc [-d] [-p] <pid> <eid> <node> <node> <...>\n".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
21
	  "		-p enables partial allocation mode\n".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
22
	  "		-d enables debugging output\n");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
23 24 25 26 27 28
    exit(-1);
}
my $optlist = "dp";
my $debug   = 0;
my $partial = 0;

29 30 31
#
# Configure variables
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
32 33 34 35 36 37 38
my $TB          = "@prefix@";
my $consetup    = "$TB/libexec/console_setup";
my $exportsetup = "$TB/sbin/exports_setup";

#
# Testbed Support libraries
#
39 40
use lib '@prefix@/lib';
use libdb;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
41
use libtestbed;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
42 43 44 45
use Experiment;
use Project;
use User;
use Node;
46

Leigh B. Stoller's avatar
Leigh B. Stoller committed
47 48 49 50
#
# Turn off line buffering on output
#
$| = 1; 
51

Leigh B. Stoller's avatar
Leigh B. Stoller committed
52 53
# For perf analysis.
#TBDebugTimeStampsOn();
54

Leigh B. Stoller's avatar
Leigh B. Stoller committed
55 56 57 58
#
# 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
59 60
my %options = ();

Leigh B. Stoller's avatar
Leigh B. Stoller committed
61 62 63 64
if (! getopts($optlist, \%options)) {
    usage();
}
if (defined($options{"d"})) {
65 66
    $debug = 1;
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
67
if (defined($options{"p"})) {
68 69
    $partial = 1;
}
70
if (@ARGV < 2) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
71
    usage();
72
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
73 74 75
my $pid		= shift;
my $eid		= shift;
my @node_names	= @ARGV;
Mac Newbold's avatar
Mac Newbold committed
76

Leigh B. Stoller's avatar
Leigh B. Stoller committed
77 78 79 80 81
#
# Locals
# 
my $error	  = 0;
my $noalloc	  = 0;
82
my @oldnodes	  = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
83
my @nodes	  = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
84
my $need_consetup = 0;
85
my @need_history  = ();
Kirk Webb's avatar
 
Kirk Webb committed
86
my @need_clearbl  = ();
87

Leigh B. Stoller's avatar
Leigh B. Stoller committed
88
TBDebugTimeStamp("nalloc started");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
89

90
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
91 92
# Experiment must exist.
# 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
93 94 95 96
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
97
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
98 99 100 101 102 103 104
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
105 106
#
# User must have permission to modify the experiment.
107
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
108 109 110 111
my $this_user = User->ThisUser();
if (! defined($this_user)) {
    die("*** $0:\n".
	"    You ($UID) do not exist in the Emulab DB!\n");
112
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
113 114 115
if (!$experiment->AccessCheck($this_user, TB_EXPT_MODIFY)) {
    die("*** $0:\n".
	"    You do not have permission to allocate nodes in $pid/$eid\n");
116 117
}

118 119
#
# Before locking any tables, do a quick check to make sure the project
Leigh B. Stoller's avatar
Leigh B. Stoller committed
120
# is allowed to allocate the nodes, by type/class, plus other checks.
121 122
#
foreach my $n (@node_names) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
123 124 125 126
    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
127
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
128 129 130 131
    # 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");
132 133
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
134 135 136 137 138
    # 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
139 140
    my $tipserver;
    if ($node->TipServer(\$tipserver) == 0 && defined($tipserver)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
141 142 143
	$need_consetup++;
    }
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
144
TBDebugTimeStamp("nalloc checked all node permissions");
145

Leigh B. Stoller's avatar
Leigh B. Stoller committed
146 147 148
# Must lock this table!
DBQueryFatal("lock tables reserved write");
TBDebugTimeStamp("nalloc locked tables");
mac's avatar
mac committed
149

Leigh B. Stoller's avatar
Leigh B. Stoller committed
150
# Make a list of nodes to reserve.
151
foreach my $n (@node_names) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
152 153 154 155 156
    my $node = Node->Lookup($n);
    if (!defined($node)) {
	die("*** $0:\n".
	    "    No such node $n!\n");
    }
157 158 159
    # Force reload after table lock.
    $node->FlushReserved();
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
160 161
    my $reserved_experiment = $node->ReservationID();
    if ($reserved_experiment) {
162
	# Someone has already reserved this node
Leigh B. Stoller's avatar
Leigh B. Stoller committed
163 164
	if ($reserved_experiment == $experiment->idx()) {
	    print "$node already reserved to $experiment.\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
165
	    # Do not increment error code since that throws off caller.
166
	    next;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
167
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
168 169 170 171 172
	my $oldreserved_experiment = $node->OldReservationID();
	if ($oldreserved_experiment &&
	    $oldreserved_experiment eq $experiment->idx()) {
	    print "$node already reserved in holding reservation.\n";
	    push(@oldnodes, $node);
173
	    next;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
174 175
	}
	else {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
176
	    print "Someone else has already reserved node $node.\n";
177
	    $noalloc++;
178
	    next;
179
	}
180
    }
181 182
    else {
	# Freshly allocated nodes need a history entry.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
183
	push(@need_history, $node);
Kirk Webb's avatar
 
Kirk Webb committed
184
        # ... and need to have their bootlogs purged.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
185
        push(@need_clearbl, $node);
186
    }
187

Leigh B. Stoller's avatar
Leigh B. Stoller committed
188 189 190
    #
    # Add info the list of nodes to reserve; done in a single query below.
    # 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
191
    push(@nodes, $node);
Mac Newbold's avatar
Mac Newbold committed
192
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
193
TBDebugTimeStamp("nalloc checked all nodes");
194

Leigh B. Stoller's avatar
Leigh B. Stoller committed
195
if ($debug) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
196
    print "List Ready: @nodes\nError=$error\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
197
}
198

Leigh B. Stoller's avatar
Leigh B. Stoller committed
199
# Now make the reservations in the DB.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
200
if ((!$noalloc || $partial) && (@nodes || @oldnodes)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
201 202
    print "Reserving nodes...\n"
	if ($debug);
203

Leigh B. Stoller's avatar
Leigh B. Stoller committed
204 205 206 207 208 209 210 211 212 213 214 215 216 217
    # 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++;
	}
218
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
219
    
220 221 222 223
    # 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
224 225
	my $node_id = $node->node_id();
	
226
	if (!DBQueryWarn("update reserved " .
227 228
			 "set exptidx=$exptidx,pid='$pid',eid='$eid', ".
			 "    old_exptidx=0, old_pid='', old_eid='' ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
229
			 "where node_id='$node_id'")) {
230 231 232
	    $error++;
	}
    }
mac's avatar
mac committed
233
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
234
TBDebugTimeStamp("nalloc allocated all nodes");
mac's avatar
mac committed
235

Leigh B. Stoller's avatar
Leigh B. Stoller committed
236
# Unlock tables.
237 238
DBQueryFatal("unlock tables");

239 240
# Okay, not safe to do this

Leigh B. Stoller's avatar
Leigh B. Stoller committed
241 242 243 244 245 246
# 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...
Leigh B. Stoller's avatar
Leigh B. Stoller committed
247 248 249
    DBQueryWarn("update node_activity set last_ext_act=now() where ".
		join(" or ",
		     map("node_id='" . $_->node_id() . "'", @nodes)));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
250

251 252 253
    foreach my $node (@nodes) {
	$node->NewRootPasswd();
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
254 255 256
    foreach my $node (@need_history) {
	$node->SetNodeHistory(TB_NODEHISTORY_OP_ALLOC,
			      $this_user, $experiment);
257
    }
Kirk Webb's avatar
 
Kirk Webb committed
258 259 260 261 262

    # 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
263 264
    foreach my $node (@need_clearbl) {
	$node->ClearBootLog();
Kirk Webb's avatar
 
Kirk Webb committed
265
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
266
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
267
TBDebugTimeStamp("updated node_activity, history, and bootlogs");
mac's avatar
mac committed
268

Leigh B. Stoller's avatar
Leigh B. Stoller committed
269 270
# Now setup consoles if needed.
if ($need_consetup && !$error && @nodes) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
271 272 273
    my @nodeids = map($_->node_id(), @nodes);
    
    system("$consetup @nodeids") == 0 or
274
	print STDERR "WARNING: $consetup @nodes failed!\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
275
    TBDebugTimeStamp("nalloc finished console setup");
Mac Newbold's avatar
Mac Newbold committed
276 277
}

278 279 280 281 282 283 284
#
# 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);