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 B Stoller's avatar
Leigh B 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 B Stoller's avatar
Leigh B Stoller committed
57
my $doscript   = 0;
Leigh B Stoller's avatar
Leigh B Stoller committed
58
my $norspec    = 0;
59 60 61
my $printgl    = 0;
my $printrspec = 0;
my $rtecheck   = 0;
Leigh B Stoller's avatar
Leigh B Stoller committed
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 B Stoller's avatar
Leigh B 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 B Stoller's avatar
Leigh B Stoller committed
128 129 130
if (defined($options{"G"})) {
    $doscript = 1;
}
Leigh B Stoller's avatar
Leigh B Stoller committed
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 B Stoller's avatar
Leigh B Stoller committed
144
    $clause = "where rspec like '%" . $options{"x"} . "%'";
145
}
Leigh B Stoller's avatar
Leigh B Stoller committed
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 B Stoller's avatar
Leigh B 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 B Stoller's avatar
Leigh B Stoller committed
169
		     "$clause ".
170
		     "order by p.pid,p.name");
Leigh B Stoller's avatar
Leigh B 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 B Stoller's avatar
Leigh B Stoller committed
177
	next
178
	    if (defined($profile->script()) && !($doscript || $norspec));
Leigh B Stoller's avatar
Leigh B Stoller committed
179 180
	next
	    if (!defined($profile->script()) && $norspec);
Leigh B Stoller's avatar
Leigh B Stoller committed
181

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

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

Leigh B Stoller's avatar
Leigh B 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");
    }
Leigh B Stoller's avatar
Leigh B Stoller committed
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 B Stoller's avatar
Leigh B 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";
Leigh B Stoller's avatar
Leigh B Stoller committed
311
	print $profile->rspec() . "\n";
Leigh B Stoller's avatar
Leigh B 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 B Stoller's avatar
Leigh B Stoller committed
320
	    if ($@) {
321
		print STDERR "*** " if ($@ !~ /^\*\*\* /);
Leigh B Stoller's avatar
Leigh B Stoller committed
322
		print STDERR $@;
323 324
		print STDERR "*** Could not parse $profile input ".
		    "rspec into object\n";
Leigh B Stoller's avatar
Leigh B Stoller committed
325 326
		goto bad;
	    }
327 328
	    my $rspec2 = eval { APT_Rspec->new($output,
					       $permissive, $verbose) };
Leigh B Stoller's avatar
Leigh B Stoller committed
329
	    if ($@) {
330
		print STDERR "*** " if ($@ !~ /^\*\*\* /);
Leigh B Stoller's avatar
Leigh B Stoller committed
331
		print STDERR $@;
332 333
		print STDERR "*** Could not parse $profile output ".
		    "rspec into object\n";
Leigh B Stoller's avatar
Leigh B Stoller committed
334 335 336
		goto bad;
	    }
	    if ($rspec1->Compare($rspec2)) {
337
		print STDERR "*** rspec comparison failed for $profile\n";
Leigh B Stoller's avatar
Leigh B 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);
}