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 3.97 KB
Newer Older
1
#!/usr/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
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
44 45 46 47 48 49 50 51
# 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.
52
#
53
if ($UID) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
54 55
    if (!TBExptAccessCheck($UID, $pid, $eid, TB_EXPT_MODIFY)) {
        die("*** You not have permission to allocate nodes in $pid/$eid!\n");
56
    }
57
}
58 59 60 61 62 63 64

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

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

68
foreach my $n (@node_names) {
69 70 71 72 73 74 75 76 77 78 79 80 81 82 83
    # 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
84
    }
85 86 87

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

113 114 115 116 117 118 119
if ($debug) { print "List Ready: @vals\nError=$error\n"; }

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

mac's avatar
mac committed
121
if (!$error && @vals) {
122
  print "Reserving nodes...\n";
123 124
  my $cmd = "insert into reserved (node_id,pid,eid) values ".join(",",@vals);
  if (!DBQueryWarn($cmd)) { $error++; }
mac's avatar
mac committed
125 126
}

127 128 129 130 131 132 133
DBQueryFatal("unlock tables");

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

135
if (!$error && @nodes) {
136 137
    my @conlist=();
    my @sharks=();
138

139 140 141 142 143 144 145 146 147 148 149 150
    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);
	}
151
    }
152
    if ($debug) { print "Console setup list: @conlist\n"; }
153

154 155
    system("$consetup @conlist") == 0 or
	print STDERR "WARNING: $consetup @conlist failed!\n";
Mac Newbold's avatar
Mac Newbold committed
156 157
}

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