nalloc.in 3.28 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 13
my $TB       = "@prefix@";
my $DBNAME   = "@TBDBNAME@";
my $TESTMODE = @TESTMODE@;
14 15

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

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

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

my $cmd = "";
my $sth = "";
30

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

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

36 37
$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'";
38
$sth = $dbh->query($cmd);
39 40
if ( ($sth->numrows < 1) && ($UID != 0) && ($EUID != 0)) {	
  die("You are not a member of experiment '$eid' in project '$pid'.\n");
41
}
42

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

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

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

mac's avatar
mac committed
90 91 92 93 94 95 96 97 98 99 100 101 102 103 104
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");

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

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

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

128
exit($error);