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.31 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 University of Utah and the Flux Group.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
5 6
# All rights reserved.
#
7
use English;
8
use Getopt::Std;
Mac Newbold's avatar
Mac Newbold committed
9

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

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

#
# Testbed Support libraries
#
38 39
use lib '@prefix@/lib';
use libdb;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
40
use libtestbed;
41

Leigh B. Stoller's avatar
Leigh B. Stoller committed
42 43 44 45
#
# Turn off line buffering on output
#
$| = 1; 
46

Leigh B. Stoller's avatar
Leigh B. Stoller committed
47 48
# For perf analysis.
#TBDebugTimeStampsOn();
49

Leigh B. Stoller's avatar
Leigh B. Stoller committed
50 51 52 53 54 55 56 57 58
#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
%options = ();
if (! getopts($optlist, \%options)) {
    usage();
}
if (defined($options{"d"})) {
59 60
    $debug = 1;
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
61
if (defined($options{"p"})) {
62 63
    $partial = 1;
}
64
if (@ARGV < 2) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
65
    usage();
66
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
67 68 69
my $pid		= shift;
my $eid		= shift;
my @node_names	= @ARGV;
Mac Newbold's avatar
Mac Newbold committed
70

Leigh B. Stoller's avatar
Leigh B. Stoller committed
71 72 73 74 75
#
# Locals
# 
my $error	  = 0;
my $noalloc	  = 0;
76 77
my @newvals	  = ();
my @oldnodes	  = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
78 79
my @nodes	  = ();
my @need_consetup = 0;
80
my @need_history  = ();
Kirk Webb's avatar
 
Kirk Webb committed
81
my @need_clearbl  = ();
82

Leigh B. Stoller's avatar
Leigh B. Stoller committed
83
TBDebugTimeStamp("nalloc started");
84
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
85 86 87
# Experiment must exist.
# 
if (!ExpState($pid,$eid)) {
88 89
    warn "There is no experiment $eid in project $pid\n";
    exit -1;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
90
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
91
TBDebugTimeStamp("nalloc checked exp state");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
92 93 94

#
# User must have permission to modify the experiment.
95
#
96
if ($UID) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
97
    if (!TBExptAccessCheck($UID, $pid, $eid, TB_EXPT_MODIFY)) {
98 99
        warn("*** You not have permission to allocate nodes in $pid/$eid!\n");
        exit -1;
100
    }
101
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
102
TBDebugTimeStamp("nalloc checked exp permission");
103

104 105
#
# Before locking any tables, do a quick check to make sure the project
Leigh B. Stoller's avatar
Leigh B. Stoller committed
106
# is allowed to allocate the nodes, by type/class, plus other checks.
107 108
#
foreach my $n (@node_names) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
109 110
    # Make sure a valid node name first!
    if (! TBValidNodeName($n)) {
111 112 113
	warn("*** $0:\n".
	     "    No such node $n!\n");
        exit -1;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
114 115 116
    }

    # Project allowed to allocated this node type/class?
117
    if (! TBNodeAllocCheck($pid, $n)) {
118 119 120
	warn("*** $0:\n".
	     "    You are not allowed to allocate $n to project $pid!\n");
        exit -1;
121 122
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
123 124 125 126 127 128 129 130 131 132 133 134 135 136
    # 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.
    #
    my $tiplines_result =
	DBQueryFatal("select tipname,server from tiplines ".
		     "where node_id='$n'");

    if ($tiplines_result->numrows) {
	$need_consetup++;
    }
}
TBDebugTimeStamp("nalloc checked node permission ");
137

Leigh B. Stoller's avatar
Leigh B. Stoller committed
138 139 140
# Must lock this table!
DBQueryFatal("lock tables reserved write");
TBDebugTimeStamp("nalloc locked tables");
mac's avatar
mac committed
141

Leigh B. Stoller's avatar
Leigh B. Stoller committed
142
# Make a list of nodes to reserve.
143
foreach my $n (@node_names) {
144
    my ($r_pid, $r_eid);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
145 146
    
    if (NodeidToExp($n, \$r_pid, \$r_eid)) {
147 148
	# Someone has already reserved this node
	if (($r_pid eq $pid) && ($r_eid eq $eid)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
149 150
	    print "Already reserved: '$n'\n";
	    # Do not increment error code since that throws off caller.
151
	    next;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
152 153 154 155
	}
	elsif (NodeidToExpOldReserved($n, \$r_pid, \$r_eid) &&
	       (($r_pid eq $pid) && ($r_eid eq $eid))) {
	    print "Already reserved in holding reservation: '$n'\n";
156 157
	    push(@oldnodes, $n);
	    next;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
158 159
	}
	else {
160
	    print "Someone else has already reserved node '$n'.\n";
161
	    $noalloc++;
162
	    next;
163
	}
164
    }
165 166 167
    else {
	# Freshly allocated nodes need a history entry.
	push(@need_history, $n);
Kirk Webb's avatar
 
Kirk Webb committed
168 169
        # ... and need to have their bootlogs purged.
        push(@need_clearbl, $n);
170
    }
171

Leigh B. Stoller's avatar
Leigh B. Stoller committed
172 173 174
    #
    # Add info the list of nodes to reserve; done in a single query below.
    # 
175
    push(@newvals,  "('$n','$pid','$eid','$n','','')");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
176
    push(@nodes, "$n");
Mac Newbold's avatar
Mac Newbold committed
177
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
178
TBDebugTimeStamp("nalloc checked all nodes");
179

Leigh B. Stoller's avatar
Leigh B. Stoller committed
180
if ($debug) {
181
    print "List Ready: @newvals\nError=$error\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
182
}
183

Leigh B. Stoller's avatar
Leigh B. Stoller committed
184
# Now make the reservations in the DB.
185
if ((!$noalloc || $partial) && (@newvals || @oldnodes)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
186 187
    print "Reserving nodes...\n"
	if ($debug);
188

189 190
    if (@newvals &&
	! DBQueryWarn("replace into reserved ".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
191
		      "  (node_id,pid,eid,vname,old_pid,old_eid) ".
192
		      "values ". join(",",@newvals))) {
193 194
	$error++;
    }
195 196 197 198 199 200 201 202 203 204 205
    # 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) {
	if (!DBQueryWarn("update reserved " .
			 "set pid='$pid',eid='$eid', ".
			 "    old_pid='', old_eid='' ".
			 "where node_id='$node'")) {
	    $error++;
	}
    }
mac's avatar
mac committed
206
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
207
TBDebugTimeStamp("nalloc allocated all nodes");
mac's avatar
mac committed
208

Leigh B. Stoller's avatar
Leigh B. Stoller committed
209
# Unlock tables.
210
DBQueryFatal("unlock tables");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
211
TBDebugTimeStamp("nalloc unlocked tables");
212

213 214
# Okay, not safe to do this

Leigh B. Stoller's avatar
Leigh B. Stoller committed
215 216 217 218 219 220 221 222 223 224
# 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...
    DBQueryWarn("update node_activity set last_ext_act=now() ".
		"where " . join(" or ",map("node_id='$_'", @nodes)));

    TBDebugTimeStamp("nalloc updated node_activity table");
225 226 227 228

    foreach my $n (@need_history) {
	TBSetNodeHistory($n, TB_NODEHISTORY_OP_ALLOC, $UID, $pid, $eid);
    }
Kirk Webb's avatar
 
Kirk Webb committed
229 230 231 232 233 234 235 236

    # 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.
    foreach my $n (@need_clearbl) {
        DBQueryWarn("delete from node_bootlogs where node_id='$n'");
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
237
}
mac's avatar
mac committed
238

Leigh B. Stoller's avatar
Leigh B. Stoller committed
239 240
# Now setup consoles if needed.
if ($need_consetup && !$error && @nodes) {
241 242
    system("$consetup @nodes") == 0 or
	print STDERR "WARNING: $consetup @nodes failed!\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
243
    TBDebugTimeStamp("nalloc finished console setup");
Mac Newbold's avatar
Mac Newbold committed
244 245
}

246 247 248 249 250 251 252
#
# 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);