assign_wrapper2.in 8.43 KB
Newer Older
1 2
#!/usr/bin/perl -w
#
3
# Copyright (c) 2000-2016 University of Utah and the Flux Group.
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
# 
# {{{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/>.
# 
# }}}
23 24 25 26 27 28 29 30 31 32
#

#
# Hack to get assign error messages into the database correctly.  Will
# be removed once the API is ported to other languages besides perl
#

BEGIN {$FAKE_SCRIPTNAME = $ARGV[0];}

use lib "@prefix@/lib";
33
use OSImage;  # To look up OS by idx.
34
use libtblog qw(:DEFAULT dblog *SOUT *SERR);
35

Leigh B. Stoller's avatar
Leigh B. Stoller committed
36 37
$ENV{'PATH'} = "/usr/bin:@prefix@/libexec";

38 39 40 41 42
use constant false => 0;
use constant true  => 1;

sub parse_error($);

43
tblog_set_default_cause('temp');
44 45 46 47 48 49 50 51 52 53

use strict;

open P, join(' ', @ARGV, ' |');

my @out;
my @err;
my $obvious_error = 0;

while (<P>) {
54 55 56 57 58 59 60 61 62 63 64
    #
    # Fix up "No physical nodes have feature OS-335!" errors.  This just means
    # that the chosen OS image doesn't run on the hardware type.
    #
    # Look up the osname from the number here.  Assign is run underneath, but
    # can't do any better with this message because the OS-id is just a token
    # in the PTOP files to it, and assign doesn't read the DB to do the Lookup.
    # Also can't do it back in assign_wrapper, which does read the DB, because
    # we log the error messages here and want them to be right.
    #
    if (/(.*)No physical nodes have feature OS-(\d+)!(.*)/) {
65
	my $OS = OSImage->Lookup($2);
66 67 68 69 70
	my $os_tag =  $OS->pid() . "/" . $OS->osname();
	$_ = "$1 OS '$os_tag' (OS-$2) does not run on this hardware type!\n$3"
	    if (defined($OS));
    }

71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87
    print SOUT $_;
    push @out, $_;
}
close P;

my $exitcode = $? >> 8;

#
# Now parse out relevent info and echo it to stderr.  Also, pull out
# any obvious errors (prefixed with ***) and log them sepertly.  The
# rest will go in te database as one big error.
#
if ($exitcode) {
    my $violations = 0;
    
    # Pull out relevent info
    print SERR "ASSIGN FAILED:\n";
88 89 90 91 92
    while (($_ = shift @out) && !/^[\w\s]*precheck:$/) {}
    if (not defined $_) {
	tberror({cause=>'internal'}, 
		"Invalid Assign Output (expected \"precheck:\" line).");
    }
93 94 95 96 97 98 99 100 101 102 103 104
    while (($_ = shift @out)) {
	/^[\w\s]*precheck:$/ && do {
	    next;
	};
	/^With ([0-9]+) violations$/ && do {
	    $violations = $1;
	    last;
	};
	print SERR  $_;
	push @err, $_;
    }
    if ($violations) {
105 106 107 108 109
	while (($_ = shift @out) && !/^Violations:/) {}
	if (not defined $_) {
	    tberror({cause=>'internal'}, 
		    "Invalid Assign Output (expected \"Violations:\" line).");
	}
110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132
	while (($_ = shift @out)) {
	    if (/^Nodes:/) {
		last;
	    }
	    print SERR $_;
	    push @err, $_;
	}
    }

    # See if there are any obvious errors
    my $err = '';
    while (($_ = shift @err)) {
	$err .= $_;
	if (/^(\s*)\*\*\*+\s*(.+)/) {
	    $obvious_error = 1;
	    my $space = $1;
	    my $mesg = $2;
	    while (@err && $err[0] =~ /^$space    \s*(.+)/) {
		$mesg .= "\n$1";
		shift @err;
	    }
	    my $sublevel = length($space) > 0 ? 1 : 0;
	    if ($mesg =~ s/^warning:\s+//i) {
Kevin Atkinson's avatar
Kevin Atkinson committed
133
		dblog(TBLOG_WARNING, {sublevel=>$sublevel, type=>'primary'}, $mesg);
134
	    } else {
135
		parse_error($mesg);
Kevin Atkinson's avatar
Kevin Atkinson committed
136
		dblog(TBLOG_ERR, {sublevel=>$sublevel, type=>'primary'}, $mesg);
137 138 139 140 141 142
	    }
	}
    }

    # log all relevent output as one entry unless an obvious_error was
    # already found
143 144
    if (!$obvious_error) {
	parse_error($err);
Kevin Atkinson's avatar
Kevin Atkinson committed
145
	dblog(TBLOG_ERR, {type=>'primary'}, $err);
146
    }
147 148

    # create a log entry that assign failed
149 150 151 152 153 154 155 156 157 158

    dblog(TBLOG_ERR, {sublevel => -1}, "Assign Failed.");
    
    dblog(TBLOG_ERR, {sublevel => -1, type=>'extra'}, 
	  "Failed to find a set of physical testbed nodes to run your ".
          "experiment on. This might mean that there are not enough ".
          "nodes or switch resources free, or your experiment might ".
          "require certain hardware which is not available.  If you ".
          "believe this message is in error, contact @TBOPSEMAIL@.")
	unless $obvious_error;
159 160 161
}

exit $exitcode;
162

163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180
sub parse_error($) {
    my ($mesg) = @_;

    return if parse_type_precheck_error($mesg);
    return if parse_mapping_precheck_error($mesg);
    return if parse_violation_error($mesg);
    return if parse_fixed_node_error($mesg);

    return;
}

sub parse_type_precheck_error($) {
    my ($mesg) = @_;
    my ($vtype, $requested, $slots, $max, $round);

    if ($mesg =~ /^No (\w+) physical nodes of type (\S+) found \((\d+) requested\)$/) {
	($round, $vtype, $requested) = ($1, $2, $3);
	$slots = 0;
181
    } elsif ($mesg =~ /^(\d+) nodes of type (\S+) requested, but only (\d+) (\w+) nodes of type \S+ found$/) {
182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214
	($requested, $vtype, $slots, $round) = ($1, $2, $3, $4);
    } elsif ($mesg =~ /^(\d+) nodes of type (\S+) requested, but you are only allowed to use (\d+)$/) {
	($requested, $vtype, $max) = ($1, $2, $3);
    } else {
	return false;
    }

    tbreport(SEV_WARNING, 'assign_type_precheck',
             $vtype, $requested, $slots, $max, $round);

    return true;
}

sub parse_mapping_precheck_error($) {
    my ($mesg) = @_;

    if ($mesg =~ /^No possible mapping for (\S+)\n/) {
	my $vnode = $1;
	my (undef, @lines) = split("\n", $mesg);

	foreach my $line (@lines) {
	    my ($class, $type, $requested, $count);

	    if ($line =~ /^No links of type (\S+) found! \((\d+) requested\)$/) {
		($type, $requested) = ($1, $2);
		$class = 'link';
		$count = 0;
	    } elsif ($line =~ /^Too many links of type (\S+)! \((\d+) requested, (\d+) found\)$/) {
		($type, $requested, $count) = ($1, $2, $3);
		$class = 'link';
	    } elsif ($line =~ /^Too much bandwidth on emulated links!$/) {
		$class = 'bandwidth';
		$count = 1; # Necessary?
215 216
	    } elsif ($line =~ /^No physical nodes have feature (\S+)!$/ ||
		     $line =~ /OS \S+ (\S+) does not run on this hardware type!/) {
217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233
		$type  = $1;
		$class = 'feature';
		$count = 0; # Necessary?
	    } else {
		# Unknown?
		next;
	    }

	    tbreport(SEV_WARNING, 'assign_mapping_precheck',
		     $vnode, $class, $type, $requested, $count);
	}

	return true;
    }

    return false;
}
234

235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258
sub parse_violation_error($) {
    my ($mesg) = @_;

    if ($mesg =~ /^Type precheck passed\.\n/) {
	my ($unassigned, $pnode_load, $no_connect, $link_users, $bandwidth,
	    $desires, $vclass, $delay, $trivial_mix, $subnodes, $max_types,
	    $endpoints);

	my (undef, @lines) = split("\n", $mesg);

	foreach my $line (@lines) {
	    if    ($line =~ /^  unassigned: +(\d+)$/)  { $unassigned  = $1 }
	    elsif ($line =~ /^  pnode_load: +(\d+)$/)  { $pnode_load  = $1 }
	    elsif ($line =~ /^  no_connect: +(\d+)$/)  { $no_connect  = $1 }
	    elsif ($line =~ /^  link_users: +(\d+)$/)  { $link_users  = $1 }
	    elsif ($line =~ /^  bandwidth: +(\d+)$/)   { $bandwidth   = $1 }
	    elsif ($line =~ /^  desires: +(\d+)$/)     { $desires     = $1 }
	    elsif ($line =~ /^  vclass: +(\d+)$/)      { $vclass      = $1 }
	    elsif ($line =~ /^  delay: +(\d+)$/)       { $delay       = $1 }
	    elsif ($line =~ /^  trivial mix: +(\d+)$/) { $trivial_mix = $1 }
	    elsif ($line =~ /^  subnodes: +(\d+)$/)    { $subnodes    = $1 }
	    elsif ($line =~ /^  max_types: +(\d+)$/)   { $max_types   = $1 }
	    elsif ($line =~ /^  endpoints: +(\d+)$/)   { $endpoints   = $1 }
	}
259

260 261 262 263
	tbreport(SEV_WARNING, 'assign_violation',
		 $unassigned, $pnode_load, $no_connect, $link_users, $bandwidth,
		 $desires, $vclass, $delay, $trivial_mix, $subnodes, $max_types,
		 $endpoints);
264

265 266
	return true;
    }
267

268 269
    return false;
}
270

271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289
sub parse_fixed_node_error($) {
    my ($mesg) = @_;
    my ($class, $vnode, $pnode);

    if ($mesg =~ /^Fixed node: (\S+) does not exist\.$/) {
	$vnode = $1;
	$class = 'exist';
    } elsif ($mesg =~ /^Fixed node: (\S+) not available\.$/) {
	$pnode = $1;
	$class = 'available';
    } elsif ($mesg =~ /^Unable to find a type for fixed, vtyped, node (\S+)$/) {
	$vnode = $1;
	$class = 'type';
    } elsif ($mesg =~ /^Fixed node: Could not map (\S+) to (\S+)$/) {
	($vnode, $pnode) = ($1, $2);
	$class = 'map';
    } else {
	return false;
    }
290

291
    tbreport(SEV_WARNING, 'assign_fixed_node', $class, $vnode, $pnode);
292

293 294
    return true;
}