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 6.99 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-2005, 2007 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 157 158
    my $node = Node->Lookup($n);
    if (!defined($node)) {
	die("*** $0:\n".
	    "    No such node $n!\n");
    }
    my $reserved_experiment = $node->ReservationID();
    if ($reserved_experiment) {
159
	# Someone has already reserved this node
Leigh B. Stoller's avatar
Leigh B. Stoller committed
160 161
	if ($reserved_experiment == $experiment->idx()) {
	    print "$node already reserved to $experiment.\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
162
	    # Do not increment error code since that throws off caller.
163
	    next;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
164
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
165 166 167 168 169
	my $oldreserved_experiment = $node->OldReservationID();
	if ($oldreserved_experiment &&
	    $oldreserved_experiment eq $experiment->idx()) {
	    print "$node already reserved in holding reservation.\n";
	    push(@oldnodes, $node);
170
	    next;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
171 172
	}
	else {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
173
	    print "Someone else has already reserved node $node.\n";
174
	    $noalloc++;
175
	    next;
176
	}
177
    }
178 179
    else {
	# Freshly allocated nodes need a history entry.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
180
	push(@need_history, $node);
Kirk Webb's avatar
 
Kirk Webb committed
181
        # ... and need to have their bootlogs purged.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
182
        push(@need_clearbl, $node);
183
    }
184

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

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

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

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
233
# Unlock tables.
234 235
DBQueryFatal("unlock tables");

236 237
# Okay, not safe to do this

Leigh B. Stoller's avatar
Leigh B. Stoller committed
238 239 240 241 242 243
# 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
244 245 246
    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
247

Leigh B. Stoller's avatar
Leigh B. Stoller committed
248 249 250
    foreach my $node (@need_history) {
	$node->SetNodeHistory(TB_NODEHISTORY_OP_ALLOC,
			      $this_user, $experiment);
251
    }
Kirk Webb's avatar
 
Kirk Webb committed
252 253 254 255 256

    # 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
257 258
    foreach my $node (@need_clearbl) {
	$node->ClearBootLog();
Kirk Webb's avatar
 
Kirk Webb committed
259
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
260
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
261
TBDebugTimeStamp("updated node_activity, history, and bootlogs");
mac's avatar
mac committed
262

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

272 273 274 275 276 277 278
#
# 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);