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 5.83 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  = ();
81

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

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

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

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
122 123 124 125 126 127 128 129 130 131 132 133 134 135
    # 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 ");
136

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

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

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

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

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

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
206
# Unlock tables.
207
DBQueryFatal("unlock tables");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
208
TBDebugTimeStamp("nalloc unlocked tables");
209

210 211
# Okay, not safe to do this

Leigh B. Stoller's avatar
Leigh B. Stoller committed
212 213 214 215 216 217 218 219 220 221
# 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");
222 223 224 225

    foreach my $n (@need_history) {
	TBSetNodeHistory($n, TB_NODEHISTORY_OP_ALLOC, $UID, $pid, $eid);
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
226
}
mac's avatar
mac committed
227

Leigh B. Stoller's avatar
Leigh B. Stoller committed
228 229
# Now setup consoles if needed.
if ($need_consetup && !$error && @nodes) {
230 231
    system("$consetup @nodes") == 0 or
	print STDERR "WARNING: $consetup @nodes failed!\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
232
    TBDebugTimeStamp("nalloc finished console setup");
Mac Newbold's avatar
Mac Newbold committed
233 234
}

235 236 237 238 239 240 241
#
# 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);