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 2.36 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
#
# Configure variables
#
mac's avatar
mac committed
8
my $TB     = "@prefix@/libexec";
9 10 11
my $DBNAME = "@TBDBNAME@";

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

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

15
my $consetup="$TB/console_setup";
16
my $error = 0;
17
my $pid = shift;
Mac Newbold's avatar
Mac Newbold committed
18 19
my $eid = shift;
my @node_names=@ARGV;
mac's avatar
mac committed
20 21
my @vals = ();
my @nodes= ();
Mac Newbold's avatar
Mac Newbold committed
22 23 24

my $cmd = "";
my $sth = "";
25

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

$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'";
31
$sth = $dbh->query($cmd);
32 33
if ( ($sth->numrows < 1) && ($UID != 0) && ($EUID != 0)) {	
  die("You are not a member of experiment '$eid' in project '$pid'.\n");
34
}
Mac Newbold's avatar
Mac Newbold committed
35
 
mac's avatar
mac committed
36 37 38 39 40
print "Locking tables.\n";
$cmd = "lock tables nodes read, reserved write";
$sth = $dbh->query($cmd) 
  || die("Locking error:\n$cmd\nError string is:".$dbh->errstr."\n");

Mac Newbold's avatar
Mac Newbold committed
41
foreach my $n (@node_names) { 
42 43 44 45 46 47
  $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";
48
      # Do not increment error code since that throws off tbprerun.
Mac Newbold's avatar
Mac Newbold committed
49
    } else {
50
      print "Someone else has already reserved node '$n'.\n";
51
      $error++;
52 53 54 55 56 57
    }
    next;
  } else {
    $sth = $dbh->query("select * from nodes where node_id='$n'");
    if ($sth->numrows < 1) {	
      print "Node '$n' does not exist.\n";
58
      $error++;
59
      next;
mac's avatar
mac committed
60 61 62 63
    } else {
      # No one has reserved it, and it exists, so add it to my list
      push(@vals,"('$n','$pid','$eid')");
      push(@nodes,"$n");
Mac Newbold's avatar
Mac Newbold committed
64
    }
65
  }
Mac Newbold's avatar
Mac Newbold committed
66
}
67

mac's avatar
mac committed
68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87
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";    
    foreach $n ( @nodes ) { 
      system("$consetup $n") == 0 or
	print STDERR "WARNING: $consetup $n failed!\n";
    }
  } else { 
    print "Failed Command:\n$cmd\nError string is:".$dbh->errstr."\n";
    $error++;
  }
}

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

88
exit($error);