readycount.in 4.18 KB
Newer Older
1
#!/usr/bin/perl -wT
Robert Ricci's avatar
Robert Ricci committed
2 3

#
4
# Copyright (c) 2000-2004 University of Utah and the Flux Group.
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
# 
# {{{EMULAB-LICENSE
# 
# This file is part of the Emulab network testbed software.
# 
# This file is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
# 
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General Public
# License for more details.
# 
# You should have received a copy of the GNU Affero General Public License
# along with this file.  If not, see <http://www.gnu.org/licenses/>.
# 
# }}}
Robert Ricci's avatar
Robert Ricci committed
24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43
#

#
# readycount - Command-line tool to get at the ready bits in the database
#


#
# Configure variables
#
use lib '@prefix@/lib';

use libdb;

use English;
use Getopt::Long;
use strict;

sub usage {
    print << "END";
44
Usage: $0 [-h] [-c | -s] [-l] <pid> <eid> [node ...]
Robert Ricci's avatar
Robert Ricci committed
45
-h    This message
46 47 48 49
-s    Set ready bits
-c    Clear ready bits
-p    Use physical node IDs with -c or -s, rather than virtual ones. In
      this case, no pid and eid should be given.
Robert Ricci's avatar
Robert Ricci committed
50 51 52
-l    List ready status for each node in the experiment

If no nodes are given, gives a summary of the nodes that have reported ready.
53 54 55
If nodes are given, reports just status for the listed nodes. If -s or -c is
given, sets or clears ready bits for the listed nodes, or all
them as being ready (or clears their ready bits
Robert Ricci's avatar
Robert Ricci committed
56 57 58 59 60 61 62 63 64 65
if -c is given)
END

    return 1;
}

#
# Process command-line arguments
#
my %opt = ();
66 67
GetOptions(\%opt,'l','h','c','s','p');
if (($opt{p} && (@ARGV < 1)) || (!$opt{p} && (@ARGV < 2))) {
Robert Ricci's avatar
Robert Ricci committed
68 69
    exit &usage;
}
70 71 72 73

my ($pid, $eid);
if (!$opt{p}) {
    ($pid, $eid) = (shift @ARGV, shift @ARGV);
74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105

    #
    # Untaint args.
    #
    if ($pid =~ /^([-\w]+)$/) {
        $pid = $1;
    }
    else {
        die("*** Bad data in pid: $pid.\n");
    }
    if ($eid =~ /^([-\w]+)$/) {
        $eid = $1;
    }
    else {
        die("*** Bad data in eid: $eid.\n");
    }
}

#
# Scan the rest of the arguments, doing a generic taint check. More
# specific patterns are below.
# 
my @nodes = ();

foreach my $arg (@ARGV) {
    if ($arg =~ /^([-\w\.]+)$/) {
        $arg = $1;
    }
    else {
        die("*** Bad data in arg: $arg.\n");
    }
    push(@nodes, $arg);
106
}
Robert Ricci's avatar
Robert Ricci committed
107 108 109 110 111

if ($opt{h}) {
    exit &usage;
}

112
if ($opt{l} && ($opt{c} || $opt{s})) {
Robert Ricci's avatar
Robert Ricci committed
113 114 115
    exit &usage;
}

116 117
if ($opt{s} && $opt{c}) {
    die "-s and -c are mutually exclusive\n";
Robert Ricci's avatar
Robert Ricci committed
118 119
}

120 121 122 123 124 125 126 127 128 129 130 131 132 133 134
# Make sure that the user has permission to modify the experiment, if using
# virtual mode, or modify the nodes, if using physical names.
if ($opt{p}) {
    if (!TBNodeAccessCheck($UID,TB_NODEACCESS_MODIFYINFO,@nodes)) {
	die "You do not have permission to modify one or more nodes\n";
    }
} else {
    if (!ExpState($pid,$eid)) {
	die("There is no experiment '$eid' in project '$pid'.\n");
    }

    # Make sure the user has the ability to modify this experiment
    if (!TBExptAccessCheck($UID, $pid, $eid, TB_EXPT_MODIFY)) {
	die("You do not have permission to modify '$eid' in project '$pid'.\n");
    }
Robert Ricci's avatar
Robert Ricci committed
135 136
}

137 138 139 140
my @pnodes;
if ($opt{p}) {
    @pnodes = @nodes;
} else {
Robert Ricci's avatar
Robert Ricci committed
141 142 143 144 145 146 147 148 149 150 151 152
    if (!@nodes) {
	@pnodes = ExpNodes($pid,$eid);
    } else {
	foreach my $vnode (@nodes) {
	    my $pnode;
	    if (VnameToNodeid($pid, $eid, $vnode, \$pnode)) {
		push @pnodes, $pnode;
	    } else {
		die "No such node $vnode in $pid/$eid!\n";
	    }
	}
    }
153 154 155
}

if ($opt{c} || $opt{s}) {
Robert Ricci's avatar
Robert Ricci committed
156 157 158 159 160 161 162 163 164 165
    my $newbit = 1;
    if ($opt{c}) {
	$newbit = 0;
    }
    foreach my $pnode (@pnodes) {
	DBQueryFatal("update nodes set ready=$newbit where node_id='$pnode'");
    }
} else {
    my $ready = 0;
    my $total = 0;
166 167 168 169 170 171
    foreach my $pnode (@pnodes) {
	my $result = DBQueryFatal("select ready, vname, nodes.node_id " .
	    "from nodes left join reserved on nodes.node_id=reserved.node_id ".
	    "where nodes.node_id='$pnode'");
	my ($isready, $vname, $pname) = $result->fetchrow();
	my $name = $opt{p}? $pname : $vname;
Robert Ricci's avatar
Robert Ricci committed
172
	if ($opt{l}) {
173
	    print "$name\t$isready\n";
Robert Ricci's avatar
Robert Ricci committed
174 175 176 177 178 179 180 181 182 183
	}
	if ($isready) {
	    $ready++;
	}
	$total++;
    }
    print "READY=$ready TOTAL=$total\n";
}

exit(0);