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.36 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 76 77 78
#
# Locals
# 
my $error	  = 0;
my $noalloc	  = 0;
my @vals	  = ();
my @nodes	  = ();
my @need_consetup = 0;
79
my @need_history  = ();
80

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

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

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

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

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

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

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

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
174 175 176
if ($debug) {
    print "List Ready: @vals\nError=$error\n";
}
177

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
183 184 185
    if (! DBQueryWarn("replace into reserved ".
		      "  (node_id,pid,eid,vname,old_pid,old_eid) ".
		      "values ". join(",",@vals))) {
186 187
	$error++;
    }
mac's avatar
mac committed
188
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
189
TBDebugTimeStamp("nalloc allocated all nodes");
mac's avatar
mac committed
190

Leigh B. Stoller's avatar
Leigh B. Stoller committed
191
# Unlock tables.
192
DBQueryFatal("unlock tables");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
193
TBDebugTimeStamp("nalloc unlocked tables");
194

195 196
# Okay, not safe to do this

Leigh B. Stoller's avatar
Leigh B. Stoller committed
197 198 199 200 201 202 203 204 205 206
# 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");
207 208 209 210

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
213 214
# Now setup consoles if needed.
if ($need_consetup && !$error && @nodes) {
215 216
    system("$consetup @nodes") == 0 or
	print STDERR "WARNING: $consetup @nodes failed!\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
217
    TBDebugTimeStamp("nalloc finished console setup");
Mac Newbold's avatar
Mac Newbold committed
218 219
}

220 221 222 223 224 225 226
#
# 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);