predict.in 7.28 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
#!/usr/bin/perl -w
#
# Copyright (c) 2016 University of Utah and the Flux Group.
# 
# {{{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/>.
# 
# }}}
#
use strict;
use English;
use Getopt::Std;
use Date::Parse;
use POSIX;

#
# Configure variables
#
my $TB		 = "@prefix@";
my $TBOPS        = "@TBOPSEMAIL@";

#
# Testbed Support libraries
#
use lib "@prefix@/lib";
use emdb;
use libtestbed;
use Project;
use Reservation;

sub usage()
{
    print STDERR "Usage: predict [-p] [-u] [-t time] type\n";
48
    print STDERR "       predict -c type [pid...]\n";
49
    print STDERR "       predict -l type [pid...]\n";
50
    print STDERR "       predict -P type [pid...]\n";
51
    print STDERR "       predict -x [-T type] pid...\n";
52
    print STDERR "   -h   This message\n";
53
    print STDERR "   -c   Give an oversimplified free node count\n";
54 55
    print STDERR "   -l   Give a list of node allocation status counts " .
	"over time\n";
56 57
    print STDERR "   -P   Identify periods of node pressure\n";
    print STDERR "   -x   Show earliest unfulfilled reservation\n";
58 59 60 61 62 63 64
    print STDERR "   -p   Identify by pid only, not pid/eid\n";
    print STDERR "   -t   Give time/date for prediction (defaults to now)\n";
    print STDERR "   -u   Interpret/display all times in UTC\n";
    
    exit( -1 );
}

65
my $optlist     = "cdhlpPt:T:x";
66 67 68 69 70 71 72
my $debug       = 0;
my $time        = time; # default to now
my $pidonly     = 0;
my $countonly   = 0;
my $pressure    = 0;
my $timeseries  = 0;
my $unfulfilled = 0;
73 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 106 107 108 109 110 111 112 113 114 115 116
my $type;

sub fatal($)
{
    my ($mesg) = $_[0];

    die("*** $0:\n".
	"    $mesg\n");
}

sub convert($) {
    my ($unixtime) = @_;

    return strftime( "%Y-%m-%d %H:%M", localtime( $unixtime ) );
}

#
# Turn off line buffering on output
#
$| = 1;

#
# Untaint the path
# 
$ENV{'PATH'} = "/bin:/sbin:/usr/bin:";

#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
my %options = ();
if (! getopts($optlist, \%options)) {
    usage();
}
if (defined($options{"u"})) {
    # handle this option ASAP, since it affects parsing of other options!
    $ENV{ "TZ" } = "UTC";
}
if (defined($options{h})) {
    usage();
}
if (defined($options{p})) {
    $pidonly = 1;
}
117 118 119
if (defined($options{P})) {
    $pressure = 1;
}
120 121 122 123 124 125 126 127 128
if (defined($options{"t"})) {
    $time = $options{"t"};
    if ($time !~ /^\d+$/) {
	$time = str2time($time);
	if( !defined( $time ) ) {
	    fatal("Could not parse -t option.");
	}
    }
}
129 130 131
if (defined($options{T})) {
    $type = $options{T};
}
132 133 134
if (defined($options{"c"})) {
    $countonly = 1;
}
135 136 137
if (defined($options{"l"})) {
    $timeseries = 1;
}
138 139 140 141 142 143 144 145 146 147
if (defined($options{"x"})) {
    $unfulfilled = 1;
}
usage() if( ( $countonly || $timeseries || $pressure || $unfulfilled ) ?
	    @ARGV < 1 : @ARGV != 1 );
if( !$unfulfilled ) {
    $type = shift( @ARGV );
    unless( $type =~ /^[-\w]+$/ ) {
	fatal( "Invalid node type." );
    }
148 149
}

150 151 152 153 154 155
if( $countonly ) {
    print( int( Reservation->FreeCount( $type, \@ARGV ) + 0.5 ) . "\n" );
    
    exit( 0 );
}

156 157 158 159 160 161 162 163 164 165 166 167 168
if( $timeseries ) {
    print "Time       Unavailable  Held  Free\n";
    print "----------       -----  ----  ----\n";
    
    foreach my $rec ( Reservation->Forecast( $type, \@ARGV ) ) {
	printf( "%s %5d %5d %5d\n",
		strftime( "%Y-%m-%d %H:%M", localtime( $rec->{'t'} ) ),
		$rec->{'unavailable'}, $rec->{'held'}, $rec->{'free'} );
    }
    
    exit( 0 );
}

169 170 171 172 173 174 175 176 177 178 179 180
if( $pressure ) {
    foreach ( Reservation->FuturePressure( [ $type ], \@ARGV ) ) {
        my ( $start, $end ) = @$_;

	print strftime( "%Y-%m-%d %H:%M-", localtime( $start ) ) .
	    strftime( "%Y-%m-%d %H:%M\n", localtime( $end ) );
    }
    
    exit( 0 );
}

if( $unfulfilled ) {
181 182 183
    my $t = Reservation->OutstandingReservation( \@ARGV,
						 defined( $type ) ? [ $type ] :
						 undef );
184 185 186 187 188 189 190 191 192 193

    if( defined( $t ) ) {
	print strftime( "%Y-%m-%d %H:%M\n", localtime( $t ) );
    } else {
	print "No outstanding reservations found.\n";
    }
    
    exit( 0 );
}

194 195
my $reservations = Reservation->LookupAll( $type );
my @timeline = ();
196
my $free = 0;
197 198
my %used = ();
my %reserved = ();
199
my %usedexp = ();
200 201 202 203 204 205 206 207 208

foreach my $reservation ( @$reservations ) {
    my $start;
    my $end;

    if( defined( $reservation->eid() ) ) {
	# A swapped-in experiment.  Already using nodes (so no
	# need to save a start event), and will later release real nodes.
	my $pid = $reservation->pid();
209 210 211
	my $exp = $reservation->pid() . "/" . $reservation->eid();
	if( !exists( $usedexp{ $exp } ) ) {
	    $usedexp{ $exp } = 0;
212
	}
213 214 215 216 217 218 219 220
	if( !exists( $used{ $pid } ) ) {
	    $used{ $pid } = 0;
	    $reserved{ $pid } = 0;
	}
	$used{ $pid } += $reservation->nodes();
	$usedexp{ $exp } += $reservation->nodes();
	$end = { 'pid' => $pid,
		 'exp' => $exp,
221 222 223 224 225
		 't' => $reservation->end(),
		 'used' => -$reservation->nodes(),
		 'reserved' => 0 };
    } elsif( defined( $reservation->pid() ) ) {
	# A reservation.  Uses then releases reserved nodes.
226
	$start = { 'pid' => $reservation->pid(),
227 228 229
		   't' => $reservation->start(),
		   'used' => 0,
		   'reserved' => $reservation->nodes() };
230
	$end = { 'pid' => $reservation->pid(),
231 232 233 234 235
		 't' => $reservation->end(),
		 'used' => 0,
		 'reserved' => -$reservation->nodes() };
    } else {
	# Available resources.  Provides nodes for all time.
236
	$free += $reservation->nodes();
237 238 239 240 241 242 243 244 245 246 247
    }

    push( @timeline, $start ) if( defined( $start->{'t'} ) );
    push( @timeline, $end ) if( defined( $end->{'t'} ) );
}

my @events = sort { $a->{'t'} <=> $b->{'t'} } @timeline;
    
foreach my $event ( @events ) {
    last if( $event->{'t'} > $time );
		     
248 249 250 251
    my $pid = $event->{'pid'};
    if( !exists( $used{ $pid } ) ) {
	$used{ $pid } = 0;
	$reserved{ $pid } = 0;
252 253
    }

254 255
    my $oldsum = $used{ $pid } > $reserved{ $pid } ?
	$used{ $pid }: $reserved{ $pid };
256

257 258 259 260 261
    $used{ $pid } += $event->{ 'used' };
    $reserved{ $pid } += $event->{ 'reserved' };
    if( exists( $event->{ 'exp' } ) ) {
	$usedexp{ $event->{ 'exp' } } += $event->{ 'used' };
    }
262

263 264
    my $newsum = $used{ $pid } > $reserved{ $pid } ?
	$used{ $pid }: $reserved{ $pid };
265 266 267 268

    $free += $oldsum - $newsum;
}

269 270 271 272 273 274 275 276 277 278
if( $pidonly ) {
    foreach my $used ( sort { $used{$b} <=> $used{$a} } keys( %used ) ) {
	my $val = $used{ $used };
	print "$used: $val\n" if( $val > 0 );
    }
} else {
    foreach my $used ( sort { $usedexp{$b} <=> $usedexp{$a} } keys( %usedexp ) ) {
	my $val = $usedexp{ $used };
	print "$used: $val\n" if( $val > 0 );
    }
279 280 281 282 283 284 285 286 287 288 289 290 291 292 293
}

foreach my $reserved ( sort { $reserved{$b} <=> $reserved{$a} }
		       keys( %reserved ) ) {
    my $val = $reserved{ $reserved };
    print "[$reserved: $val]\n" if( $val > 0 );
}

if( $free >= 0 ) {
    print $free . " free node";
    print ( $free == 1 ? ".\n" : "s.\n" );
} else {
    print "Overbooked by " . -$free . " node";
    print ( $free == -1 ? ".\n" : "s.\n" );
}
294 295

exit( 0 );