assign_wrapper2.in 7.75 KB
Newer Older
1 2 3
#!/usr/bin/perl -w
#
# EMULAB-COPYRIGHT
4
# Copyright (c) 2000-2005, 2009 University of Utah and the Flux Group.
5 6 7 8 9 10 11 12 13 14 15
# All rights reserved.
#

#
# 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";
16
use OSinfo;  # To look up OS by idx.
17
use libtblog qw(:DEFAULT dblog *SOUT *SERR);
18

Leigh Stoller's avatar
Leigh Stoller committed
19 20
$ENV{'PATH'} = "/usr/bin:@prefix@/libexec";

21 22 23 24 25
use constant false => 0;
use constant true  => 1;

sub parse_error($);

26
tblog_set_default_cause('temp');
27 28 29 30 31 32 33 34 35 36

use strict;

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

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

while (<P>) {
37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53
    #
    # 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+)!(.*)/) {
	my $OS = OSinfo->Lookup($2);
	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));
    }

54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70
    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";
71 72 73 74 75
    while (($_ = shift @out) && !/^[\w\s]*precheck:$/) {}
    if (not defined $_) {
	tberror({cause=>'internal'}, 
		"Invalid Assign Output (expected \"precheck:\" line).");
    }
76 77 78 79 80 81 82 83 84 85 86 87
    while (($_ = shift @out)) {
	/^[\w\s]*precheck:$/ && do {
	    next;
	};
	/^With ([0-9]+) violations$/ && do {
	    $violations = $1;
	    last;
	};
	print SERR  $_;
	push @err, $_;
    }
    if ($violations) {
88 89 90 91 92
	while (($_ = shift @out) && !/^Violations:/) {}
	if (not defined $_) {
	    tberror({cause=>'internal'}, 
		    "Invalid Assign Output (expected \"Violations:\" line).");
	}
93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115
	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
116
		dblog(TBLOG_WARNING, {sublevel=>$sublevel, type=>'primary'}, $mesg);
117
	    } else {
118
		parse_error($mesg);
Kevin Atkinson's avatar
Kevin Atkinson committed
119
		dblog(TBLOG_ERR, {sublevel=>$sublevel, type=>'primary'}, $mesg);
120 121 122 123 124 125
	    }
	}
    }

    # log all relevent output as one entry unless an obvious_error was
    # already found
126 127
    if (!$obvious_error) {
	parse_error($err);
Kevin Atkinson's avatar
Kevin Atkinson committed
128
	dblog(TBLOG_ERR, {type=>'primary'}, $err);
129
    }
130 131

    # create a log entry that assign failed
132 133 134 135 136 137 138 139 140 141

    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;
142 143 144
}

exit $exitcode;
145

146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163
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;
164
    } elsif ($mesg =~ /^(\d+) nodes of type (\S+) requested, but only (\d+) (\w+) nodes of type \S+ found$/) {
165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197
	($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?
198 199
	    } elsif ($line =~ /^No physical nodes have feature (\S+)!$/ ||
		     $line =~ /OS \S+ (\S+) does not run on this hardware type!/) {
200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216
		$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;
}
217

218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241
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 }
	}
242

243 244 245 246
	tbreport(SEV_WARNING, 'assign_violation',
		 $unassigned, $pnode_load, $no_connect, $link_users, $bandwidth,
		 $desires, $vclass, $delay, $trivial_mix, $subnodes, $max_types,
		 $endpoints);
247

248 249
	return true;
    }
250

251 252
    return false;
}
253

254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272
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;
    }
273

274
    tbreport(SEV_WARNING, 'assign_fixed_node', $class, $vnode, $pnode);
275

276 277
    return true;
}