nfree.in 7.48 KB
Newer Older
Mac Newbold's avatar
Mac Newbold committed
1
2
3
#!/usr/local/bin/perl -w
use Mysql;

4
5
6
#
# Configure variables
#
7
8
my $TB       = "@prefix@";
my $DBNAME   = "@TBDBNAME@";
9
10

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

12
13
14
15
16
if ($#ARGV < 1) {
  die("Usage: nfree <pid> <eid> [<node> <node> <...>]\n".
      "Releases all nodes in the specified experiment. If nodes are listed,\n".
      "nfree releases only the listed nodes.\n");
}
Mac Newbold's avatar
Mac Newbold committed
17

18
my $error = 0;
mac's avatar
mac committed
19
my $consetup="$TB/libexec/console_setup";
20
my $exportsetup="$TB/sbin/exports_setup";
21
22
my $reloadpid="emulab-ops";
my $reloadeid="reloadpending";
23
my $pid = shift;
Mac Newbold's avatar
Mac Newbold committed
24
my $eid = shift;
25
my @node_names=();
Mac Newbold's avatar
Mac Newbold committed
26
my @freed_nodes=();
Mac Newbold's avatar
Mac Newbold committed
27

28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
foreach my $n (@ARGV) {
  if ($n =~ /(sh\d+)/ ) {
    # its a shark - do the whole shelf if its not done already.
    my $shelf = $1;
    if ( ! (join(",",@node_names) =~ /,$shelf-\d,/)) {
      # Shelf hasn't been done yet...
      foreach my $n ( 1 .. 8 ) {
	push(@node_names,"$shelf-$n");
      }
    }
  } else {
    # its not a shark - just add it in...
    push(@node_names,"$n");
  }
}


Mac Newbold's avatar
Mac Newbold committed
45
46
my $cmd = "";
my $sth = "";
47

48
49
50
51
52
53
$cmd = "select * from experiments where eid='$eid' and pid='$pid'";
$sth = $dbh->query($cmd);
if ($sth->numrows < 1) {	
  die("There is no experiment '$eid' in project '$pid'.\n");
}
 
54
$cmd = "lock tables nodes write, node_types read, scheduled_reloads read, ".
55
56
  "interfaces write, delays write, reserved write, last_reservation write,".
  "next_reserve read";
mac's avatar
mac committed
57
58
59
$sth = $dbh->query($cmd) 
  || die("Locking error:\n$cmd\nError string is:".$dbh->errstr."\n");

60
61
62
63
64
65
66
67
68
69
# If list is empty, put in all the nodes
if ($#node_names == -1) {
  print "Releasing all nodes from experiment '$eid' in project '$pid'...\n";
  $sth = $dbh->
    query("select node_id from reserved where pid='$pid' and eid='$eid'");
  while (@row = $sth->fetchrow_array()) {
    push(@node_names, $row[0]);
  }
}

70
my @reloads = ();
71
my %reserves= ();
Mac Newbold's avatar
Mac Newbold committed
72
foreach my $n (@node_names) { 
73
  $sth = $dbh->query("select * from reserved where node_id='$n' ".
Mac Newbold's avatar
Mac Newbold committed
74
		     "and eid='$eid' and pid='$pid'");
75
76
77
78
  if ($sth->numrows == 0) {
    print "Node '$n' is not reserved by your experiment.\n";
    $error++;
    next;
Mac Newbold's avatar
Mac Newbold committed
79
80
81
  } else {
    push(@freed_nodes,$n);
  }
82

83
84
85
86
  # This little sillyness is for disk reloading. Kill the last reservation.
  $cmd = "delete from last_reservation where node_id='$n'";
  $dbh->query($cmd);

87
  # If the node has a reloads entry, change the reservation and start it
88
  $cmd = "select node_id,image_id from scheduled_reloads where node_id='$n'";
89
90
91
  $sth = $dbh->query($cmd)
    || (print "Failed Command:\n$cmd\nError string is:".$dbh->errstr."\n"
	&& $error++);
92

93
  if ( ($sth->num_rows()) > 0) {
94
95
    print "Adding scheduled reload for $n to the list.\n";
    push(@reloads,$n);
96
  } else {
97
98
99
    # If the node has a next_reserve entry, change the reservation and start it
    $cmd = "select node_id,pid,eid from next_reserve where node_id='$n'";
    $sth = $dbh->query($cmd)
100
101
      || (print "Failed Command:\n$cmd\nError string is:".$dbh->errstr."\n"
	  && $error++);
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
    if ( ($sth->num_rows()) > 0) {
      my @reserve;
      print "Adding next reservation for $n to the list.\n";
      my $i = 0;
      my $max = $sth->num_rows();
      while ( $i < $max  ) {
	$i++;
	@reserve = $sth->fetchrow_array();
	my ($node, $next_pid, $next_eid) = @reserve;
	$reserves{$node} = "$next_pid:$next_eid";
      }
    } else {
      # No reloads or reservation changes, so really free the node
      # This little sillyness is for disk reloading. Remember the last
      # project a node was reserved into.
      $cmd = "insert into last_reservation values ('$n', '$pid')";
      $dbh->query($cmd);
      print "Releasing node '$n'...";
      $cmd = "delete from reserved where node_id='$n' and eid='$eid'";
      $sth = $dbh->query($cmd) && print "Succeeded.\n"
	|| (print "Failed Command:\n$cmd\nError string is:".$dbh->errstr."\n"
	    && $error++);
    }
125
  }
mac's avatar
mac committed
126

127
128
  # Find the control net interface for this node type
  $sth = 
129
    $dbh->query("select control_net,osid,node_types.pxe_boot_path " .
130
131
		"from node_types " .
		"left join nodes on nodes.type=node_types.type " .
132
		"where node_id='$n'");
133
134
135
  my @row= $sth->fetchrow_array();
  my $control= $row[0];
  my $osid= $row[1];
136
  my $pxe_boot_path = $row[2];
137
  if (! ($n =~ /sh\d+/)) { #If its not a shark
mac's avatar
mac committed
138
139
140
141
142
143
    # Clean out all IPs except the control net
    $cmd = 
      "update interfaces set IP='' where node_id='$n' and card!='$control'";
    $sth = $dbh->query($cmd)
      || (print "Failed Command:\n$cmd\nError string is:".$dbh->errstr."\n"
	  && $error++);
144
145
146
147
148
149
  } else {
    # it is a shark, so clear out the alias(es)
    $cmd = "update interfaces set IPalias='' where node_id='$n'";
    $sth = $dbh->query($cmd)
      || (print "Failed Command:\n$cmd\nError string is:".$dbh->errstr."\n"
	  && $error++);
mac's avatar
mac committed
150
  }
Mac Newbold's avatar
Mac Newbold committed
151
152
153
154
155
156

  # Clean out all delays
  $cmd = 
    "delete from delays where node_id='$n'";
  $sth = $dbh->query($cmd)
    || (print "Failed Command:\n$cmd\nError string is:".$dbh->errstr."\n"
157
158
159
	&& $error++);

  # And clean out various tidbits from the nodes table.
160
  $cmd = "update nodes set def_boot_osid='$osid', def_boot_cmd_line='',".
161
162
      "def_boot_path='',startupcmd='',rpms='',deltas='',tarballs='',".
	  "pxe_boot_path='$pxe_boot_path' where node_id='$n'";
163
164
165
  $sth = $dbh->query($cmd)
    || (print "Failed Command:\n$cmd\nError string is:".$dbh->errstr."\n"
	&& $error++);
166
167
168
169
170
171
172
173

  # Clean out the current_reloads table
  $cmd = "delete from current_reloads where node_id='$'";
  $sth = $dbh->query($cmd)
    || (print "Failed Command:\n$cmd\nError string is:".$dbh->errstr."\n"
	&& $error++);


174
175
}

mac's avatar
mac committed
176
177
178
179
$cmd = "unlock tables";
$sth = $dbh->query($cmd) 
  || die("Locking error:\n$cmd\nError string is:".$dbh->errstr."\n");

180
if ( (@reloads > 0) || (keys %reserves > 0) ) {
181
  print "Locking tables.\n";
182
  $cmd = "lock tables nodes read, node_types read, scheduled_reloads read, ".
183
    "interfaces write, reserved write, next_reserve write";
184
185
186
  $sth = $dbh->query($cmd) 
    || die("Locking error:\n$cmd\nError string is:".$dbh->errstr."\n");
  
187
  foreach $n ( @reloads ) {
188
    # Change reservation (don't delete or we'll get races)
Mac Newbold's avatar
Mac Newbold committed
189
    print "Changing reservation for $n to $reloadpid/$reloadeid...\n";
190
191
192
193
194
195
196
    $cmd = "update reserved set pid='$reloadpid',eid='$reloadeid' where ".
      "node_id='$n'";
    $sth = $dbh->query($cmd)
      || (print "Failed Command:\n$cmd\nError string is:".$dbh->errstr."\n"
	  && $error++ && next);
  }
  
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
  foreach $n ( keys %reserves ) {
    my ($next_pid,$next_eid) = split (":",$reserves{$n});
    # Change reservation (don't delete or we'll get races)
    print "Changing reservation for $n to $next_pid/$next_eid...\n";
    $cmd = "update reserved set pid='$next_pid',eid='$next_eid' where ".
      "node_id='$n'";
    $sth = $dbh->query($cmd)
      || (print "Failed Command:\n$cmd\nError string is:".$dbh->errstr."\n"
	  && $error++ && next);
    $cmd = "delete from next_reserve where node_id='$n'";
    $sth = $dbh->query($cmd)
      || (print "Failed Command:\n$cmd\nError string is:".$dbh->errstr."\n"
	  && $error++ && next);
  }

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

218
if (@freed_nodes) {
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
    my @conlist=();
    my @sharks=();
    
    foreach $n ( @freed_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);
	}
234
    }
235
236
    system("$consetup @conlist") == 0 or
	print STDERR "WARNING: $consetup @conlist failed!\n";
Mac Newbold's avatar
Mac Newbold committed
237
238
}

239
exit($error);
240