nalloc.in 3.9 KB
Newer Older
Mac Newbold's avatar
Mac Newbold committed
1
#!/usr/local/bin/perl -w
2
use English;
3
use Getopt::Std;
Mac Newbold's avatar
Mac Newbold committed
4

5 6 7 8 9 10
#
# 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.
#
11

12 13 14
#
# Configure variables
#
15
my $TB       = "@prefix@";
16 17 18 19 20
use lib '@prefix@/lib';
use libdb;

my %opt = ();
getopts(\%opt,'v');
21

22 23 24 25
my $debug = 0;
if ($opt{v}) {
    $debug = 1;
}
Mac Newbold's avatar
Mac Newbold committed
26

27 28 29 30
if (@ARGV < 2) {
    die("Usage: nalloc [-v] <pid> <eid> <node> <node> <...>\n".
	 "		-v enables debugging output\n");
}
Mac Newbold's avatar
Mac Newbold committed
31

32 33
my $consetup="$TB/libexec/console_setup";
my $exportsetup="$TB/sbin/exports_setup";
34
my $error = 0;
35
my $pid = shift;
Mac Newbold's avatar
Mac Newbold committed
36 37
my $eid = shift;
my @node_names=@ARGV;
mac's avatar
mac committed
38 39
my @vals = ();
my @nodes= ();
Mac Newbold's avatar
Mac Newbold committed
40

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

43 44 45 46 47 48
#
# Make sure the user is a member of the correct project, and that the
# experiment exists
#
if (!ProjMember($pid)) {
    die "You are not a member of project $pid\n";
49
}
50 51 52 53 54 55 56 57 58 59
if (!ExpState($pid,$eid)) {
    die "There is no experiment $eid in project $pid\n";
}

######################################################################
# 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
######################################################################
60

61
DBQueryFatal("lock tables nodes read, reserved write");
mac's avatar
mac committed
62

63
foreach my $n (@node_names) {
64 65 66 67 68 69 70 71 72 73 74 75 76 77 78
    # 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.
	} else {
	    print "Someone else has already reserved node '$n'.\n";
	    $error++;
	}
	next; # Go on to the next node if this one is reserved
79
    }
80 81 82

    my $result = DBQueryFatal("select * from nodes where node_id='$n'");
    if ($result->numrows() < 1) {
83
      print "Node '$n' does not exist.\n";
84
      $error++;
85
      next;
mac's avatar
mac committed
86
    } else {
87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103
	# 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...
	    push(@vals,"('$n','$pid','$eid')");
	    push(@nodes,"$n");
104
	}
Mac Newbold's avatar
Mac Newbold committed
105 106
    }
}
107

108 109 110 111 112 113 114
if ($debug) { print "List Ready: @vals\nError=$error\n"; }

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

mac's avatar
mac committed
116
if (!$error && @vals) {
117
  print "Reserving nodes...\n";
118 119
  my $cmd = "insert into reserved (node_id,pid,eid) values ".join(",",@vals);
  if (!DBQueryWarn($cmd)) { $error++; }
mac's avatar
mac committed
120 121
}

122 123 124 125 126 127 128
DBQueryFatal("unlock tables");

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

130
if (!$error && @nodes) {
131 132
    my @conlist=();
    my @sharks=();
133

134 135 136 137 138 139 140 141 142 143 144 145
    foreach $n ( @nodes ) { 
	if ($n =~ /(sh\d+)/) {
	    # Its a shark - do the shelf if it hasn't been done yet
	    my $shelf = $1;
	    if (!(join(",",@sharks) =~ /\b$shelf\b/)) {
		push(@sharks,$shelf);
		push(@conlist,$shelf);
	    }
	}
	else {
	    push(@conlist,$n);
	}
146
    }
147
    if ($debug) { print "Console setup list: @conlist\n"; }
148

149 150
    system("$consetup @conlist") == 0 or
	print STDERR "WARNING: $consetup @conlist failed!\n";
Mac Newbold's avatar
Mac Newbold committed
151 152
}

153
if ($debug) { print "Returning with value $error\n"; }
154
exit($error);