checkprofile.in 8.36 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
#!/usr/bin/perl -w

#
# Copyright (c) 2000-2017 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 File::Temp qw(tempfile unlink0 :POSIX );
use Data::Dumper;

#
# Convert rspec to geni lib (non destructive, we do not change anything
# in the database). See below for additional regression testing options.
#
sub usage()
{
    print STDERR "Usage: checkprofile [-a | pid,name]\n";
    print STDERR "Options:\n";
Leigh Stoller's avatar
Leigh Stoller committed
39 40 41 42 43 44 45 46
    print STDERR "  -a  : Run rspec2genilib converter on all rspec profiles\n";
    print STDERR "  -r  : Run converted geni-lib\n";
    print STDERR "  -c  : Compare rspecs after running geni-lib\n";
    print STDERR "  -t  : Run RTE check on converted geni-lib script\n";
    print STDERR "  -g  : Print the geni-lib\n";
    print STDERR "  -s  : Print rspec before and after\n";
    print STDERR "  -x  : Only include rspecs with matching token\n";
    print STDERR "  -G  : Also test script based profiles, no RTE of course\n";
47 48 49
    print STDERR "  -X  : ONLY script based profiles\n";
    print STDERR "  -p  : Permissive mode, ignore some unsupported stuff\n";
    print STDERR "  -v  : Verbose errors\n";
50 51
    exit(-1);
}
52
my $optlist    = "dargscx:tGXpv";
53 54 55 56
my $debug      = 0;
my $all        = 0;
my $regress    = 0;
my $compare    = 0;
Leigh Stoller's avatar
Leigh Stoller committed
57
my $doscript   = 0;
58
my $norspec    = 0;
59 60 61
my $printgl    = 0;
my $printrspec = 0;
my $rtecheck   = 0;
62
my $permissive = 0;
63
my $verbose    = 0;
64 65 66 67 68 69 70 71 72 73 74 75 76 77 78
my $clause     = "";
my $profile;

#
# Configure variables
#
my $TB         = "@prefix@";
my $TBOPS      = "@TBOPSEMAIL@";
my $CONVERTER  = "$TB/bin/rspec2genilib";
my $RUNGENILIB = "$TB/bin/rungenilib";
my $RTECHECK   = "$TB/bin/rtecheck";
my $XMLLINT    = "/usr/local/bin/xmllint";

# Protos
sub fatal($);
Leigh Stoller's avatar
Leigh Stoller committed
79 80
sub CheckProfile($);
sub CheckScriptProfile($);
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 117 118 119 120 121 122 123 124 125 126 127

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

STDOUT->autoflush(1);
STDERR->autoflush(1);

#
# Untaint the path
# 
$ENV{'PATH'} = "$TB/bin:$TB/sbin:/bin:/usr/bin:/sbin:/usr/sbin";
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

#
# Testbed Support libraries
#
use lib "@prefix@/lib";
use emutil;
use emdb;
use APT_Profile;
use APT_Rspec;

#
# Parse command arguments. Once we return from getopts, all that should
# left are the required arguments.
#
my %options = ();
if (! getopts($optlist, \%options)) {
    usage();
}
if (defined($options{"d"})) {
    $debug = 1;
}
if (defined($options{"a"})) {
    $all = 1;
}
if (defined($options{"r"})) {
    $regress = 1;
}
if (defined($options{"c"})) {
    $compare = 1;
}
if (defined($options{"g"})) {
    $printgl = 1;
}
Leigh Stoller's avatar
Leigh Stoller committed
128 129 130
if (defined($options{"G"})) {
    $doscript = 1;
}
131 132 133
if (defined($options{"p"})) {
    $permissive = 1;
}
134 135 136 137 138 139
if (defined($options{"s"})) {
    $printrspec = 1;
}
if (defined($options{"t"})) {
    $rtecheck = 1;
}
140 141 142
if (defined($options{"v"})) {
    $verbose = 1;
}
143
if (defined($options{"x"})) {
Leigh Stoller's avatar
Leigh Stoller committed
144
    $clause = "where rspec like '%" . $options{"x"} . "%'";
145
}
146 147 148
if (defined($options{"X"})) {
    $norspec = 1;
}
149 150 151 152 153 154 155 156 157 158
usage()
    if (!$all && @ARGV != 1);

if (!$all) {
    $profile = APT_Profile->Lookup($ARGV[0]);
    if (!defined($profile)) {
	fatal("No such profile");
    }
}
if (defined($profile)) {
Leigh Stoller's avatar
Leigh Stoller committed
159
    exit(CheckProfile($profile));
160 161 162 163 164 165 166 167 168
}
else {
    #
    # Find all profiles with no script
    #
    my $query_result =
	DBQueryFatal("select p.profileid from apt_profiles as p ".
		     "left join apt_profile_versions as v on ".
		     "     v.profileid=p.profileid and v.version=p.version ".
Leigh Stoller's avatar
Leigh Stoller committed
169
		     "$clause ".
170
		     "order by p.pid,p.name");
Leigh Stoller's avatar
Leigh Stoller committed
171 172
    my $count  = 0;
    my $errors = 0;
173 174 175 176
    while (my ($id) = $query_result->fetchrow_array()) {
	my $profile = APT_Profile->Lookup($id);
	next
	    if (!defined($profile));
Leigh Stoller's avatar
Leigh Stoller committed
177
	next
178
	    if (defined($profile->script()) && !($doscript || $norspec));
179 180
	next
	    if (!defined($profile->script()) && $norspec);
Leigh Stoller's avatar
Leigh Stoller committed
181

182
	print "Converting $profile\n";
Leigh Stoller's avatar
Leigh Stoller committed
183 184 185
	$count++;
	$errors++
	    if (CheckProfile($profile));
186
    }
Leigh Stoller's avatar
Leigh Stoller committed
187 188
    print "##########\n";
    print "$count profiles, $errors failed\n";
189 190 191 192 193
}

#
# Run the converter on a profile. 
#
Leigh Stoller's avatar
Leigh Stoller committed
194
sub CheckProfile($)
195 196 197
{
    my ($profile) = @_;

Leigh Stoller's avatar
Leigh Stoller committed
198 199 200 201 202 203 204
    #
    # We test script based profiles differently.
    #
    if (defined($profile->script())) {
	return CheckScriptProfile($profile);
    }

205 206 207 208 209 210 211 212 213
    my ($in, $filename) = tempfile("/tmp/convertXXXXX", UNLINK => 1);
    if (!defined($in)) {
	fatal("Could not open temporary file for rspec");
	    return -1;
    }
    print $in $profile->rspec();
    if ($printrspec) {
	system("$XMLLINT --format $filename");
    }
214 215
    my $opts   = "-t " . ($permissive ? "-p" : "");
    my $output = emutil::ExecQuiet("$CONVERTER $opts $filename");
216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
    if ($?) {
	#print STDERR $profile->rspec() . "\n";
	print STDERR $output;
	print STDERR "*** Could not convert $profile\n";
	goto bad;
    }
    if ($printgl) {
	print $output;
    }
    unlink0($in, $filename);

    if ($regress && $? == 0) {
	#
	# Now run it back to see if its valid geni-lib.
	#
	($in, $filename) = tempfile("/tmp/convertXXXXX", UNLINK => 1);
	if (!defined($in)) {
	    fatal("Could not open temporary file for script");
	    return -1;
	}
	print $in $output;
	$output = emutil::ExecQuiet("$RUNGENILIB $filename");
	if ($?) {
	    print STDERR $output;
240
	    print STDERR "*** $RUNGENILIB failed for $profile\n";
241 242 243 244 245 246
	    goto bad;
	}
	if ($printrspec) {
	    print $output;
	}
	if ($compare) {
247 248
	    my $rspec1 = eval { APT_Rspec->new($profile->rspec(),
					       $permissive, $verbose) };
249
	    if ($@) {
250
		print STDERR "*** " if ($@ !~ /^\*\*\* /);
251
		print STDERR $@;
252 253
		print STDERR "*** Could not parse $profile input ".
		    "rspec into object\n";
254 255
		goto bad;
	    }
256 257
	    my $rspec2 = eval { APT_Rspec->new($output,
					       $permissive, $verbose) };
258
	    if ($@) {
259
		print STDERR "*** " if ($@ !~ /^\*\*\* /);
260
		print STDERR $@;
261 262
		print STDERR "*** Could not parse $profile output ".
		    "rspec into object\n";
263 264 265
		goto bad;
	    }
	    if ($rspec1->Compare($rspec2)) {
266
		print STDERR "*** rspec comparison failed for $profile\n";
267 268 269 270 271 272
		goto bad;
	    }
	}
	if ($rtecheck) {
	    system("$RTECHECK $filename");
	    if ($?) {
273
		print STDERR "*** rtecheck failed for $profile\n";
274 275 276 277 278 279 280 281 282 283 284 285
		goto bad;
	    }
	}
	unlink0($in, $filename);
    }
    return 0;

  bad:
    unlink0($in, $filename);
    return -1;
}

Leigh Stoller's avatar
Leigh Stoller committed
286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310
#
# Check a script based profile.
#
sub CheckScriptProfile($)
{
    my ($profile) = @_;

    my ($in, $filename) = tempfile("/tmp/convertXXXXX", UNLINK => 1);
    if (!defined($in)) {
	fatal("Could not open temporary file for script");
	    return -1;
    }
    print $in $profile->script();
    
    my $output = emutil::ExecQuiet("$RUNGENILIB $filename");
    if ($?) {
	print STDERR $output;
	print STDERR "*** $RUNGENILIB failed\n";
	goto bad;
    }
    if ($printgl) {
	print $profile->script() . "\n";
    }
    if ($printrspec) {
	print $output . "\n";
311
	print $profile->rspec() . "\n";
Leigh Stoller's avatar
Leigh Stoller committed
312 313 314 315 316 317
    }
    if ($regress) {
	if ($compare) {
	    #
	    # Compare current rspec against newly generated rspec.
	    #
318 319
	    my $rspec1 = eval { APT_Rspec->new($profile->rspec(),
					       $permissive, $verbose)};
Leigh Stoller's avatar
Leigh Stoller committed
320
	    if ($@) {
321
		print STDERR "*** " if ($@ !~ /^\*\*\* /);
Leigh Stoller's avatar
Leigh Stoller committed
322
		print STDERR $@;
323 324
		print STDERR "*** Could not parse $profile input ".
		    "rspec into object\n";
Leigh Stoller's avatar
Leigh Stoller committed
325 326
		goto bad;
	    }
327 328
	    my $rspec2 = eval { APT_Rspec->new($output,
					       $permissive, $verbose) };
Leigh Stoller's avatar
Leigh Stoller committed
329
	    if ($@) {
330
		print STDERR "*** " if ($@ !~ /^\*\*\* /);
Leigh Stoller's avatar
Leigh Stoller committed
331
		print STDERR $@;
332 333
		print STDERR "*** Could not parse $profile output ".
		    "rspec into object\n";
Leigh Stoller's avatar
Leigh Stoller committed
334 335 336
		goto bad;
	    }
	    if ($rspec1->Compare($rspec2)) {
337
		print STDERR "*** rspec comparison failed for $profile\n";
Leigh Stoller's avatar
Leigh Stoller committed
338 339 340 341 342 343 344 345 346 347 348 349
		goto bad;
	    }
	}
    }
    unlink0($in, $filename);
    return 0;

  bad:
    unlink0($in, $filename);
    return -1;
}

350 351 352 353 354 355 356 357 358
exit(0);

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

    print STDERR "*** $0:\n".
	         "    $mesg\n";
    exit(-1);
}