sched_reload.in 8.37 KB
Newer Older
1
#!/usr/bin/perl -wT
Leigh Stoller's avatar
Leigh Stoller committed
2 3
#
# EMULAB-COPYRIGHT
Leigh Stoller's avatar
Leigh Stoller committed
4
# Copyright (c) 2000-2007 University of Utah and the Flux Group.
Leigh Stoller's avatar
Leigh Stoller committed
5 6
# All rights reserved.
#
Leigh Stoller's avatar
Leigh Stoller committed
7
use strict;
8
use English;
9
use Getopt::Std;
10 11 12 13 14 15 16
   
#
# Schedule the reloading of a disk partition on a node. If the node is
# currently not reserved, start the loading now after reserving it to 
# testbed:reloading. Otherwise, put the right info into the database, and 
# nfree will do it when the node gets freed.
# 
17 18
sub usage()
{
19
    print STDOUT "Usage: sched_reload [-f | -n] [-m <imageid>] ".
20
	         "[[-p <pid>] -i <imagename>] <node> [node ...]\n".
21
		 "       sched_reload <options> -e pid,eid\n".
22
		 "       sched_reload <options> -t type [type ...]\n".
23
		 "       sched_reload <options> -c class\n".
24 25
	"Use -i to specify an image name. Use node default otherwise.\n".
	"Use -m to specify an image ID (internal name, TB admins only!).\n".
Leigh Stoller's avatar
Leigh Stoller committed
26
	"Use -f to force reload. Fail if node cannot be reserved.\n".
27
	"Use -n to pend reload for the reload daemon.\n".
28
        "Use -e to schedule a reload for all nodes in an experiment.\n".
29 30
        "Use -t to schedule a reload for all nodes of a particular type.\n".
        "Use -c to schedule a reload for all nodes of a particular class.\n";
31 32
    exit(-1);
}
33
my  $optlist = "fnp:i:e:m:tc:";
34 35 36 37

#
# Configure variables
#
38
my $TB     = "@prefix@";
39

40 41 42
#
# Load the Testbed support stuff. 
#
43 44
use lib "@prefix@/lib";
use libdb;
Leigh Stoller's avatar
Leigh Stoller committed
45 46 47 48 49
use Project;
use User;
use Node;
use Image;
use Experiment;
50

51
#
52
# These come from the library.
53
# 
54 55 56
my $RELOADPID	= NODERELOADING_PID;
my $RELOADEID	= NODERELOADING_EID;
my $PENDINGEID	= NODERELOADPENDING_EID;
57

Leigh Stoller's avatar
Leigh Stoller committed
58
my $osload      = "$TB/bin/os_load -s";
59
my $nalloc      = "$TB/bin/nalloc";
60
my $name        = "";
61 62 63
my $error       = 0;
my $debug       = 0;
my $force	= 0;
64
my $pend	= 0;
65
my @nodes       = ();
66
my $type	= TB_DEFAULT_RELOADTYPE;
Leigh Stoller's avatar
Leigh Stoller committed
67 68 69
my $project;
my $experiment;
my $image;
Leigh Stoller's avatar
Leigh Stoller committed
70
my $imageid;
71
my $imagepid    = TB_OPSPID;
Leigh Stoller's avatar
Leigh Stoller committed
72
my %imagenodes  = ();
73 74 75 76 77 78 79

# un-taint path
$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

$| = 1; #Turn off line buffering on output

Leigh Stoller's avatar
Leigh Stoller committed
80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96
#
# Verify user and get his DB uid and other info for later.
#
my $this_user = User->ThisUser();
if (! defined($this_user)) {
    die("*** $0:\n".
	"    You ($UID) do not exist!\n");
}

#
# Mere users cannot schedule reloads.
#
if ($UID && !$this_user->IsAdmin()) {
    die("*** $0:\n".
	"     Only root or TB administrators can schedule disk reloads.\n");
}

97
#
98 99 100
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
Leigh Stoller's avatar
Leigh Stoller committed
101
my %options = ();
102 103 104 105
if (! getopts($optlist, \%options)) {
    usage();
}
if (defined($options{"f"})) {
106
    $force = 1;
107 108
}
if (defined($options{"n"})) {
109
    $pend = 1;
110
}
111 112 113
if ($pend and $force) {
    usage();
}
114 115 116
if (defined($options{"i"}) && defined($options{"m"})) {
    usage();
}
Leigh Stoller's avatar
Leigh Stoller committed
117

Leigh Stoller's avatar
Leigh Stoller committed
118 119 120 121
#
# Find the image (if not the default).
#
if (defined($options{"i"})) {
122 123 124
    if (defined($options{"p"})) {
	$imagepid = $options{"p"};
    }
Leigh Stoller's avatar
Leigh Stoller committed
125 126 127 128 129 130 131
    $project = Project->Lookup($imagepid);
    if (!defined($project)) {
	die("*** $:\n".
	    "    No such project $imagepid!\n");
    }
    # This is untainted.
    $imagepid = $project->pid();
132

Leigh Stoller's avatar
Leigh Stoller committed
133 134 135 136 137
    # Look up image in project.
    $image = Image->Lookup($imagepid, $options{"i"});
    if (!defined($image)) {
	die("*** $:\n".
	    "    No such image!\n");
Leigh Stoller's avatar
Leigh Stoller committed
138
    }
Leigh Stoller's avatar
Leigh Stoller committed
139 140 141 142 143 144 145 146
    # This is untainted.
    $imageid = $image->imageid();
}
elsif (defined($options{"m"})) {
    $image = Image->Lookup($options{"m"});
    if (!defined($image)) {
	die("*** $:\n".
	    "    No such image!\n");
Leigh Stoller's avatar
Leigh Stoller committed
147
    }
Leigh Stoller's avatar
Leigh Stoller committed
148 149
    # This is untainted.
    $imageid = $image->imageid();
Leigh Stoller's avatar
Leigh Stoller committed
150
}
Leigh Stoller's avatar
Leigh Stoller committed
151 152 153 154

#
# Figure out what nodes to reload.
#
155
if (defined($options{"e"})) {
Leigh Stoller's avatar
Leigh Stoller committed
156 157 158 159 160 161 162
    usage()
	if (@ARGV);

    $experiment = Experiment->Lookup($options{"e"});
    if (!defined($experiment)) {
	die("*** $:\n".
	    "    No such experiment!\n");
163
    }
Leigh Stoller's avatar
Leigh Stoller committed
164 165 166 167
    @nodes = $experiment->NodeList();
    if (!@nodes) {
	die("*** $0:\n".
	    "    There are no nodes allocated to $experiment!\n");
168 169
    }
}
170
elsif (defined($options{"t"})) {
Leigh Stoller's avatar
Leigh Stoller committed
171 172
    usage()
	if (!@ARGV);
173 174 175 176
    
    #
    # Untaint types,
    #
Leigh Stoller's avatar
Leigh Stoller committed
177
    foreach my $type (@ARGV) {
178 179 180 181 182 183
	if ($type =~ /^([-\w]+)$/) {
	    $type = $1;
	}
	else {
	    die("Bad type name: $type.");
	}
Leigh Stoller's avatar
Leigh Stoller committed
184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199
	my $query_result =
	    DBQueryFatal("select node_id from nodes ".
			 "where type='$type' and role='testnode'");

	while (my ($nodeid) = $query_result->fetchrow_array()) {
	    my $node = Node->Lookup($nodeid);
	    if (!defined($node)) {
		die("*** $0:\n".
		    "    Could not map node $nodeid to its object!\n");
	    }
	    push(@nodes, $node);
	}
    }
    if (!@nodes) {
	die("*** $0:\n".
	    "    There are no nodes of any type!\n");
200 201
    }
}
202
elsif (defined($options{"c"})) {
Leigh Stoller's avatar
Leigh Stoller committed
203
    my $class     = $options{"c"};
204 205 206 207 208 209 210 211 212 213 214

    if ($class =~ /^([-\w]+)$/) {
	$class = $1;
    }
    else {
	die("*** Bad data in $class\n");
    }
    my $query_result =
	    DBQueryFatal("select n.node_id from nodes as n ".
			 "left join node_types as nt on n.type=nt.type ".
			 "where nt.class='$class' and n.role='testnode'");
Leigh Stoller's avatar
Leigh Stoller committed
215 216 217 218 219 220 221
    
    while (my ($nodeid) = $query_result->fetchrow_array()) {
	my $node = Node->Lookup($nodeid);
	if (!defined($node)) {
	    die("*** $0:\n".
		"    Could not map node $nodeid to its object!\n");
	}
222 223
	push(@nodes, $node);
    }
Leigh Stoller's avatar
Leigh Stoller committed
224 225 226 227
    if (!@nodes) {
	die("*** $0:\n".
	    "    There are no nodes of class $class!\n");
    }
228
}
229
else {
Leigh Stoller's avatar
Leigh Stoller committed
230 231 232 233 234 235 236 237 238
    # Nodes on command line
    usage()
	if (@ARGV < 1);

    foreach my $n (@ARGV) {
	my $node = Node->Lookup($n);
	if (!defined($node)) {
	    die("*** $0:\n".
		"    Node $n does not exist!\n");
239 240 241
	}
	push(@nodes, $node);
    }
242
}
243

244 245 246 247
#
# VIRTNODE HACK: Virtual nodes are special. Do not reload!
#
my @temp = ();
Leigh Stoller's avatar
Leigh Stoller committed
248 249
foreach my $node (@nodes) {
    if ($node->isvirtnode()) {
250 251 252 253 254 255 256 257 258 259 260
	print "*** Skipping virtual node $node ...\n";
	next;
    }
    push(@temp, $node);
}
@nodes = @temp;
if (! @nodes) {
    print "No nodes to load. Exiting ...\n";
    exit(0);
}

261
#
262
# Loop through each node.
263 264 265
# 
my @load_list=();
foreach my $node (@nodes) {
Leigh Stoller's avatar
Leigh Stoller committed
266 267 268
    my $pc = $node->node_id();
    my $allocated  = 0;
    my $this_image = $image;
Leigh Stoller's avatar
Leigh Stoller committed
269 270 271 272

    #
    # Get default imageid for this node if none specified on comand line.
    #
Leigh Stoller's avatar
Leigh Stoller committed
273 274 275
    if (!defined($this_image)) {
	$this_image = Image->Lookup($node->default_imageid());
	if (!defined($this_image)) {
276 277 278
	    print STDERR
		"*** Node $pc does not have a default imageid. Skipping!\n";
	    next;
Leigh Stoller's avatar
Leigh Stoller committed
279 280
	}
    }
Leigh Stoller's avatar
Leigh Stoller committed
281 282 283

    if (!$node->IsReserved()) {
        print STDERR "Reserving $node and adding to list.\n";
284 285 286 287 288 289 290 291 292
	my $eid;
	if ($pend) {
	    $eid = $PENDINGEID;
	}
	else {
	    $eid = $RELOADEID;
	}
	my $cmd = "$nalloc $RELOADPID $eid $pc";

293 294 295
        if ( system($cmd) != 0 ) {
	    print STDERR "WARNING: Could not reserve $pc!\n";
	} else {
296 297 298 299
	    #
	    # Kill the last_reservation so that whoever gets the node next
	    # won't be fooled into thinking a reload is required.
	    #
300
	    DBQueryFatal("delete from last_reservation where node_id='$pc'");
301
	    $allocated = 1;
302
	}
Leigh Stoller's avatar
Leigh Stoller committed
303 304 305
    }
    else {
        print STDERR "$node is already reserved.\n";      
306
    }
307 308 309 310 311 312 313 314 315 316

    #
    # If force and not able to reserve, do not pend a reload.
    # 
    if ($force && !$allocated) {
	$error++;
	next;
    }

    # Put it in the reloads table so TMCD knows to free it.
Leigh Stoller's avatar
Leigh Stoller committed
317
    if ($node->SetSchedReload($this_image, $type) != 0) {
318 319 320 321
	die("*** $0:\n".
	    "    Could not set scheduled reload for $pc!"); 
    }
    
Leigh Stoller's avatar
Leigh Stoller committed
322 323 324 325 326 327 328 329 330 331
    #
    # The point of this hash table is so that we can gather up all the
    # nodes per imageid and issue single requests to os_load, so that it
    # can optimize things (say, for Frisbee). It is possible to get multiple
    # imageids when using the node defaults instead of a command line imageid.
    #
    # Note that building up a hashed array of lists is a mighty odd operation
    # in PERL, hence this funny looking code!
    #
    if ($allocated) {
Leigh Stoller's avatar
Leigh Stoller committed
332 333
	if (! defined($imagenodes{$this_image->imageid()})) {
	    $imagenodes{$this_image->imageid()} = [ $pc ];
Leigh Stoller's avatar
Leigh Stoller committed
334 335
	}
	else {
Leigh Stoller's avatar
Leigh Stoller committed
336
	    push(@{ $imagenodes{$this_image->imageid()} }, $pc);
Leigh Stoller's avatar
Leigh Stoller committed
337 338
	}
    }
339 340
}

341
if ($pend) {
Leigh Stoller's avatar
Leigh Stoller committed
342
    print STDOUT "Reload Scheduling Done! There were $error failures!\n";
343 344 345
    exit $error;
}

Leigh Stoller's avatar
Leigh Stoller committed
346 347 348 349 350
#
# Now issue the reloads, one per imageid. The hash table we created above
# stores a list of nodes for each imageid.
#
foreach my $id ( keys(%imagenodes) ) {
Leigh Stoller's avatar
Leigh Stoller committed
351
    my @nodelist = @{ $imagenodes{$id} };
Leigh Stoller's avatar
Leigh Stoller committed
352

353
    my $cmd = "$osload -m $id @nodelist";
Leigh Stoller's avatar
Leigh Stoller committed
354 355 356 357 358 359

    print "Issuing $cmd\n";
    if (system($cmd)) {
	print STDERR "*** WARNING: Failed $cmd\n";
	$error++;
    }
360 361
}

Leigh Stoller's avatar
Leigh Stoller committed
362
print STDOUT "Reload Scheduling Done! There were $error failures!\n";
363
exit $error;