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.1 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
#
8
my $TB     = "@prefix@";
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 16
my $consetup="$TB/libexec/console_setup";
my $exportsetup="$TB/sbin/exports_setup";
17
my $error = 0;
18
my $pid = shift;
Mac Newbold's avatar
Mac Newbold committed
19 20
my $eid = shift;
my @node_names=@ARGV;
mac's avatar
mac committed
21 22
my @vals = ();
my @nodes= ();
Mac Newbold's avatar
Mac Newbold committed
23 24 25

my $cmd = "";
my $sth = "";
26

27 28 29 30 31
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'";
32
$sth = $dbh->query($cmd);
33 34
if ( ($sth->numrows < 1) && ($UID != 0) && ($EUID != 0)) {	
  die("You are not a member of experiment '$eid' in project '$pid'.\n");
35
}
36

mac's avatar
mac committed
37 38 39 40
$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
    } else {
      # No one has reserved it, and it exists, so add it to my list
62 63 64 65 66 67 68 69 70 71 72 73 74 75 76
      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
77
    }
78
  }
Mac Newbold's avatar
Mac Newbold committed
79
}
80

mac's avatar
mac committed
81 82 83 84 85 86 87 88 89 90 91 92 93 94 95
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");

Mac Newbold's avatar
Mac Newbold committed
96
if (!$error && @nodes) {
97 98 99 100 101 102 103 104 105 106 107 108 109 110 111
    my @conlist=();
    my @sharks=();
    
    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);
	}
112
    }
113 114
    system("$consetup @conlist") == 0 or
	print STDERR "WARNING: $consetup @conlist failed!\n";
115 116 117

    system("$exportsetup") == 0 or
	print STDERR "WARNING: $exportsetup failed!\n";
Mac Newbold's avatar
Mac Newbold committed
118 119
}

120
exit($error);