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 KB
Newer Older
1
#!/usr/bin/perl -w
Leigh B. Stoller's avatar
Leigh B. Stoller committed
2 3 4

#
# EMULAB-COPYRIGHT
5
# Copyright (c) 2000-2003 University of Utah and the Flux Group.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
6 7
# All rights reserved.
#
8
use English;
9
use Getopt::Std;
Mac Newbold's avatar
Mac Newbold committed
10

11 12 13 14 15 16
#
# nalloc - allocate nodes to an experiment. Takes a pid, and eid, and
# a list of nodes. Only nodes that are free can be allocated, and a
# special hack for sharks is included - allocating 'sh*' expands to
# allocation of the entire rack.
#
17 18 19
# Exit status is important! Exit with -1 if an error, else the number
# of nodes that could not be allocated. Otherwise zero.
#
20 21 22
#
# Configure variables
#
23
my $TB       = "@prefix@";
24 25 26 27
use lib '@prefix@/lib';
use libdb;

my %opt = ();
28 29 30 31
getopts('vp', \%opt);

my $debug   = 0;
my $partial = 0;
32

33 34 35
if ($opt{v}) {
    $debug = 1;
}
36 37 38
if ($opt{p}) {
    $partial = 1;
}
Mac Newbold's avatar
Mac Newbold committed
39

40
if (@ARGV < 2) {
41 42
    die("Usage: nalloc [-v] [-p] <pid> <eid> <node> <node> <...>\n".
	 "		-p enables partial allocation mode\n".
43 44
	 "		-v enables debugging output\n");
}
Mac Newbold's avatar
Mac Newbold committed
45

46 47
my $consetup="$TB/libexec/console_setup";
my $exportsetup="$TB/sbin/exports_setup";
48
my $error = 0;
49
my $noalloc = 0;
50
my $pid = shift;
Mac Newbold's avatar
Mac Newbold committed
51 52
my $eid = shift;
my @node_names=@ARGV;
mac's avatar
mac committed
53 54
my @vals = ();
my @nodes= ();
55 56
my $oldreserved_pid = OLDRESERVED_PID;
my $oldreserved_eid = OLDRESERVED_EID;
Mac Newbold's avatar
Mac Newbold committed
57

58
if ($debug) { print "Expt '$eid', proj '$pid'\n"; }
59

60
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
61 62 63 64 65 66 67 68
# Experiment must exist.
# 
if (!ExpState($pid,$eid)) {
    die "There is no experiment $eid in project $pid\n";
}

#
# User must have permission to modify the experiment.
69
#
70
if ($UID) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
71 72
    if (!TBExptAccessCheck($UID, $pid, $eid, TB_EXPT_MODIFY)) {
        die("*** You not have permission to allocate nodes in $pid/$eid!\n");
73
    }
74
}
75

76 77 78 79 80 81 82 83 84 85 86
#
# Before locking any tables, do a quick check to make sure the project
# is allowed to allocate the nodes, by type/class. 
#
foreach my $n (@node_names) {
    if (! TBNodeAllocCheck($pid, $n)) {
	die("*** $0:\n".
	    "    You are not allowed to allocate $n to project $pid!\n");
    }
}

87 88 89 90 91 92
######################################################################
# Step 1 - Make a list of nodes to reserve
#
# We prune nodes that are already reserved, etc., from the list, and
# do expansion of shark shelves
######################################################################
93

94
DBQueryFatal("lock tables nodes read, reserved write, node_activity write");
mac's avatar
mac committed
95

96
foreach my $n (@node_names) {
97 98 99 100 101 102 103 104 105 106
    # Shark hack
    if ($n =~ /(sh\d+)/ ) { $n = $1."-1"; }
    # End shark hack

    my ($r_pid, $r_eid);
    if (NodeidToExp($n,\$r_pid,\$r_eid)) {
	# Someone has already reserved this node
	if (($r_pid eq $pid) && ($r_eid eq $eid)) {
	    print "You have already reserved node '$n'.\n";
	    # Do not increment error code since that throws off tbprerun.
107 108 109 110 111
	    next;
	} elsif(NodeidToExpOldReserved($n, \$r_pid, \$r_eid) &&
		(($r_pid eq $pid) && ($r_eid eq $eid)) ) {
	    print "You have already reserved node '$n' which was moved to ".
	    	   "a holding reservation: $oldreserved_pid/$oldreserved_eid.\n";
112 113
	} else {
	    print "Someone else has already reserved node '$n'.\n";
114
	    $noalloc++;
115
	    next;
116
	}
117
    }
118 119 120

    my $result = DBQueryFatal("select * from nodes where node_id='$n'");
    if ($result->numrows() < 1) {
121
      print "Node '$n' does not exist.\n";
122
      $error++;
123
      next;
mac's avatar
mac committed
124
    } else {
125 126 127 128 129 130 131 132 133 134 135 136 137 138 139
	# No one has reserved it, and it exists, so add it to my list
	# Shark hack
	if ($n =~ /(sh\d+)/ ) {
	    # its a shark - do the whole shelf if its not done already.
	    my $shelf = $1;
	    if ( ! (join(",",@nodes) =~ /,$shelf-\d,/)) {
		# Shelf hasn't been done yet...
		foreach my $n ( 1 .. 8 ) {
		    push(@vals,"('$shelf-$n','$pid','$eid')");
		    push(@nodes,"$shelf-$n");
		}
	    }
	    # End shark hack
	} else {
	    # its not a shark - just add it in...
140
	    push(@vals,"('$n','$pid','$eid','$n','','')");
141
	    push(@nodes,"$n");
142
	}
Mac Newbold's avatar
Mac Newbold committed
143 144
    }
}
145

146 147 148 149 150 151 152
if ($debug) { print "List Ready: @vals\nError=$error\n"; }

######################################################################
# Step 2 - Make the reservations in the database
#
# Uses the list built in step 1
######################################################################
153

154
if (!$error && (!$noalloc || $partial) && @vals) {
155 156 157 158 159 160 161 162
    if ($debug) {
	print "Resetting node activity...\n";
    }
    my $cmd = "update node_activity set last_ext_act = now() where ".
      join(" or ",map("node_id='$_'",@nodes));
    DBQueryWarn($cmd);
    # It isn't an error if this fails...

163 164 165
    if ($debug) {
	print "Reserving nodes...\n";
    }
166
    $cmd = "replace into reserved (node_id,pid,eid,vname,old_pid,old_eid) values ".
167
      join(",",@vals);
168 169 170
    if (!DBQueryWarn($cmd)) {
	$error++;
    }
mac's avatar
mac committed
171 172
}

173 174 175 176 177 178 179
DBQueryFatal("unlock tables");

######################################################################
# Step 3 - Setup consoles
#
# Uses the list built in step 1
######################################################################
mac's avatar
mac committed
180

181
if (!$error && @nodes) {
182 183
    system("$consetup @nodes") == 0 or
	print STDERR "WARNING: $consetup @nodes failed!\n";
Mac Newbold's avatar
Mac Newbold committed
184 185
}

186 187 188 189 190 191 192
#
# 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);