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.24 KB
Newer Older
Mac Newbold's avatar
Mac Newbold committed
1 2
#!/usr/local/bin/perl -w
use Mysql;
3
use English;
Mac Newbold's avatar
Mac Newbold committed
4

5 6 7
# debug
my $d = 0;

8 9 10
#
# Configure variables
#
11 12
my $TB       = "@prefix@";
my $DBNAME   = "@TBDBNAME@";
13 14

my $dbh = Mysql->connect("localhost",$DBNAME,"script","none");
Mac Newbold's avatar
Mac Newbold committed
15

16
if ($#ARGV < 1) {die("Usage: nalloc <pid> <eid> <node> <node> <...>\n");}
Mac Newbold's avatar
Mac Newbold committed
17

18 19
my $consetup="$TB/libexec/console_setup";
my $exportsetup="$TB/sbin/exports_setup";
20
my $error = 0;
21
my $pid = shift;
Mac Newbold's avatar
Mac Newbold committed
22 23
my $eid = shift;
my @node_names=@ARGV;
mac's avatar
mac committed
24 25
my @vals = ();
my @nodes= ();
Mac Newbold's avatar
Mac Newbold committed
26 27 28

my $cmd = "";
my $sth = "";
29

30 31 32
my $self = (getpwuid($UID))[0]
  || die "Cannot figure out who you are!\n";

33 34
if ($d) { print "You are '$self', expt '$eid', proj '$pid'\n"; }

35 36
$cmd = "select uid from proj_memb as pm left join experiments as e on ".
  "e.pid=pm.pid where e.eid='$eid' and uid='$self' and e.pid='$pid'";
37
$sth = $dbh->query($cmd);
38 39
if ( ($sth->numrows < 1) && ($UID != 0) && ($EUID != 0)) {	
  die("You are not a member of experiment '$eid' in project '$pid'.\n");
40
}
41

mac's avatar
mac committed
42 43 44 45
$cmd = "lock tables nodes read, reserved write";
$sth = $dbh->query($cmd) 
  || die("Locking error:\n$cmd\nError string is:".$dbh->errstr."\n");

46 47
foreach my $n (@node_names) {
  if ($n =~ /(sh\d+)/ ) { $n = $1."-1"; }
48 49 50 51 52 53
  $sth = $dbh->query("select * from reserved where node_id='$n'");
  if ($sth->numrows > 0) {
    $cmd="select * from reserved where node_id='$n' and eid='$eid' and pid='$pid'";
    $sth = $dbh->query($cmd);
    if ($sth->numrows > 0) {	
      print "You have already reserved node '$n'.\n";
54
      # Do not increment error code since that throws off tbprerun.
Mac Newbold's avatar
Mac Newbold committed
55
    } else {
56
      print "Someone else has already reserved node '$n'.\n";
57
      $error++;
58 59 60 61 62 63
    }
    next;
  } else {
    $sth = $dbh->query("select * from nodes where node_id='$n'");
    if ($sth->numrows < 1) {	
      print "Node '$n' does not exist.\n";
64
      $error++;
65
      next;
mac's avatar
mac committed
66 67
    } else {
      # No one has reserved it, and it exists, so add it to my list
68 69 70 71 72 73 74 75 76 77 78 79 80 81 82
      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");
	  }
	}
      } else {
	# its not a shark - just add it in...
	push(@vals,"('$n','$pid','$eid')");
	push(@nodes,"$n");
      }
Mac Newbold's avatar
Mac Newbold committed
83
    }
84
  }
Mac Newbold's avatar
Mac Newbold committed
85
}
86

87 88
print "List Ready: @vals\nError=$error\n" if $d;

mac's avatar
mac committed
89 90 91 92 93 94 95 96 97 98 99 100 101 102 103
if (!$error && @vals) {
  print "Reserving nodes...";
  $cmd = "insert into reserved (node_id,pid,eid) values ".join(",",@vals);
  if ($sth = $dbh->query($cmd)) {
    print "Succeeded.\n";    
  } else { 
    print "Failed Command:\n$cmd\nError string is:".$dbh->errstr."\n";
    $error++;
  }
}

$cmd = "unlock tables";
$sth = $dbh->query($cmd) 
  || die("Locking error:\n$cmd\nError string is:".$dbh->errstr."\n");

104
if (!$error && @nodes) {
105 106
    my @conlist=();
    my @sharks=();
107

108 109 110 111 112 113 114 115 116 117 118 119
    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);
	}
120
    }
121 122
    print "Console setup list: @conlist\n" if $d;

123 124
    system("$consetup @conlist") == 0 or
	print STDERR "WARNING: $consetup @conlist failed!\n";
Mac Newbold's avatar
Mac Newbold committed
125 126
}

127
exit($error);