ktest.pl 77.2 KB
Newer Older
S
Steven Rostedt 已提交
1
#!/usr/bin/perl -w
2
#
3
# Copyright 2010 - Steven Rostedt <srostedt@redhat.com>, Red Hat Inc.
4 5
# Licensed under the terms of the GNU GPL License version 2
#
S
Steven Rostedt 已提交
6 7 8 9

use strict;
use IPC::Open2;
use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
10 11
use File::Path qw(mkpath);
use File::Copy qw(cp);
S
Steven Rostedt 已提交
12 13
use FileHandle;

14 15
my $VERSION = "0.2";

S
Steven Rostedt 已提交
16 17 18
$| = 1;

my %opt;
19 20
my %repeat_tests;
my %repeats;
S
Steven Rostedt 已提交
21 22

#default opts
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 48
my %default = (
    "NUM_TESTS"			=> 1,
    "TEST_TYPE"			=> "build",
    "BUILD_TYPE"		=> "randconfig",
    "MAKE_CMD"			=> "make",
    "TIMEOUT"			=> 120,
    "TMP_DIR"			=> "/tmp/ktest/\${MACHINE}",
    "SLEEP_TIME"		=> 60,	# sleep time between tests
    "BUILD_NOCLEAN"		=> 0,
    "REBOOT_ON_ERROR"		=> 0,
    "POWEROFF_ON_ERROR"		=> 0,
    "REBOOT_ON_SUCCESS"		=> 1,
    "POWEROFF_ON_SUCCESS"	=> 0,
    "BUILD_OPTIONS"		=> "",
    "BISECT_SLEEP_TIME"		=> 60,   # sleep time between bisects
    "PATCHCHECK_SLEEP_TIME"	=> 60, # sleep time between patch checks
    "CLEAR_LOG"			=> 0,
    "BISECT_MANUAL"		=> 0,
    "BISECT_SKIP"		=> 1,
    "SUCCESS_LINE"		=> "login:",
    "DETECT_TRIPLE_FAULT"	=> 1,
    "NO_INSTALL"		=> 0,
    "BOOTED_TIMEOUT"		=> 1,
    "DIE_ON_FAILURE"		=> 1,
    "SSH_EXEC"			=> "ssh \$SSH_USER\@\$MACHINE \$SSH_COMMAND",
    "SCP_TO_TARGET"		=> "scp \$SRC_FILE \$SSH_USER\@\$MACHINE:\$DST_FILE",
49
    "SCP_TO_TARGET_INSTALL"	=> "\${SCP_TO_TARGET}",
50 51 52 53
    "REBOOT"			=> "ssh \$SSH_USER\@\$MACHINE reboot",
    "STOP_AFTER_SUCCESS"	=> 10,
    "STOP_AFTER_FAILURE"	=> 60,
    "STOP_TEST_AFTER"		=> 600,
54 55 56

# required, and we will ask users if they don't have them but we keep the default
# value something that is common.
57 58 59 60 61
    "REBOOT_TYPE"		=> "grub",
    "LOCALVERSION"		=> "-test",
    "SSH_USER"			=> "root",
    "BUILD_TARGET"	 	=> "arch/x86/boot/bzImage",
    "TARGET_IMAGE"		=> "/boot/vmlinuz-test",
62 63 64

    "LOG_FILE"			=> undef,
    "IGNORE_UNUSED"		=> 0,
65
);
S
Steven Rostedt 已提交
66

67
my $ktest_config;
S
Steven Rostedt 已提交
68
my $version;
69
my $machine;
70
my $ssh_user;
71 72 73
my $tmpdir;
my $builddir;
my $outputdir;
74
my $output_config;
75
my $test_type;
76
my $build_type;
77
my $build_options;
78 79 80 81
my $pre_build;
my $post_build;
my $pre_build_die;
my $post_build_die;
82 83 84
my $reboot_type;
my $reboot_script;
my $power_cycle;
85
my $reboot;
86
my $reboot_on_error;
87 88
my $switch_to_good;
my $switch_to_test;
89 90
my $poweroff_on_error;
my $die_on_failure;
91 92
my $powercycle_after_reboot;
my $poweroff_after_halt;
93 94
my $ssh_exec;
my $scp_to_target;
95
my $scp_to_target_install;
96 97
my $power_off;
my $grub_menu;
S
Steven Rostedt 已提交
98 99 100
my $grub_number;
my $target;
my $make;
101
my $post_install;
102
my $no_install;
103
my $noclean;
104
my $minconfig;
105
my $start_minconfig;
106
my $start_minconfig_defined;
107 108
my $output_minconfig;
my $ignore_config;
109
my $ignore_errors;
110
my $addconfig;
111
my $in_bisect = 0;
112
my $bisect_bad_commit = "";
113
my $reverse_bisect;
S
Steven Rostedt 已提交
114
my $bisect_manual;
S
Steven Rostedt 已提交
115
my $bisect_skip;
116
my $config_bisect_good;
117 118 119 120 121
my $bisect_ret_good;
my $bisect_ret_bad;
my $bisect_ret_skip;
my $bisect_ret_abort;
my $bisect_ret_default;
S
Steven Rostedt 已提交
122
my $in_patchcheck = 0;
123
my $run_test;
S
Steven Rostedt 已提交
124
my $redirect;
125
my $buildlog;
R
Rabin Vincent 已提交
126
my $testlog;
127 128 129 130
my $dmesg;
my $monitor_fp;
my $monitor_pid;
my $monitor_cnt = 0;
131 132
my $sleep_time;
my $bisect_sleep_time;
133
my $patchcheck_sleep_time;
134
my $ignore_warnings;
135
my $store_failures;
136
my $store_successes;
S
Steven Rostedt 已提交
137
my $test_name;
138 139
my $timeout;
my $booted_timeout;
140
my $detect_triplefault;
141
my $console;
142
my $reboot_success_line;
143
my $success_line;
144 145
my $stop_after_success;
my $stop_after_failure;
146
my $stop_test_after;
147 148
my $build_target;
my $target_image;
149
my $checkout;
150
my $localversion;
151
my $iteration = 0;
152
my $successes = 0;
S
Steven Rostedt 已提交
153

154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169
my $bisect_good;
my $bisect_bad;
my $bisect_type;
my $bisect_start;
my $bisect_replay;
my $bisect_files;
my $bisect_reverse;
my $bisect_check;

my $config_bisect;
my $config_bisect_type;

my $patchcheck_type;
my $patchcheck_start;
my $patchcheck_end;

170
# set when a test is something other that just building or install
171 172 173
# which would require more options.
my $buildonly = 1;

174 175 176
# set when creating a new config
my $newconfig = 0;

177 178
my %entered_configs;
my %config_help;
179
my %variable;
180
my %force_config;
181

182 183 184
# do not force reboots on config problems
my $no_reboot = 1;

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 215 216 217 218 219 220 221 222 223
my %option_map = (
    "MACHINE"			=> \$machine,
    "SSH_USER"			=> \$ssh_user,
    "TMP_DIR"			=> \$tmpdir,
    "OUTPUT_DIR"		=> \$outputdir,
    "BUILD_DIR"			=> \$builddir,
    "TEST_TYPE"			=> \$test_type,
    "BUILD_TYPE"		=> \$build_type,
    "BUILD_OPTIONS"		=> \$build_options,
    "PRE_BUILD"			=> \$pre_build,
    "POST_BUILD"		=> \$post_build,
    "PRE_BUILD_DIE"		=> \$pre_build_die,
    "POST_BUILD_DIE"		=> \$post_build_die,
    "POWER_CYCLE"		=> \$power_cycle,
    "REBOOT"			=> \$reboot,
    "BUILD_NOCLEAN"		=> \$noclean,
    "MIN_CONFIG"		=> \$minconfig,
    "OUTPUT_MIN_CONFIG"		=> \$output_minconfig,
    "START_MIN_CONFIG"		=> \$start_minconfig,
    "IGNORE_CONFIG"		=> \$ignore_config,
    "TEST"			=> \$run_test,
    "ADD_CONFIG"		=> \$addconfig,
    "REBOOT_TYPE"		=> \$reboot_type,
    "GRUB_MENU"			=> \$grub_menu,
    "POST_INSTALL"		=> \$post_install,
    "NO_INSTALL"		=> \$no_install,
    "REBOOT_SCRIPT"		=> \$reboot_script,
    "REBOOT_ON_ERROR"		=> \$reboot_on_error,
    "SWITCH_TO_GOOD"		=> \$switch_to_good,
    "SWITCH_TO_TEST"		=> \$switch_to_test,
    "POWEROFF_ON_ERROR"		=> \$poweroff_on_error,
    "DIE_ON_FAILURE"		=> \$die_on_failure,
    "POWER_OFF"			=> \$power_off,
    "POWERCYCLE_AFTER_REBOOT"	=> \$powercycle_after_reboot,
    "POWEROFF_AFTER_HALT"	=> \$poweroff_after_halt,
    "SLEEP_TIME"		=> \$sleep_time,
    "BISECT_SLEEP_TIME"		=> \$bisect_sleep_time,
    "PATCHCHECK_SLEEP_TIME"	=> \$patchcheck_sleep_time,
    "IGNORE_WARNINGS"		=> \$ignore_warnings,
224
    "IGNORE_ERRORS"		=> \$ignore_errors,
225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247
    "BISECT_MANUAL"		=> \$bisect_manual,
    "BISECT_SKIP"		=> \$bisect_skip,
    "CONFIG_BISECT_GOOD"	=> \$config_bisect_good,
    "BISECT_RET_GOOD"		=> \$bisect_ret_good,
    "BISECT_RET_BAD"		=> \$bisect_ret_bad,
    "BISECT_RET_SKIP"		=> \$bisect_ret_skip,
    "BISECT_RET_ABORT"		=> \$bisect_ret_abort,
    "BISECT_RET_DEFAULT"	=> \$bisect_ret_default,
    "STORE_FAILURES"		=> \$store_failures,
    "STORE_SUCCESSES"		=> \$store_successes,
    "TEST_NAME"			=> \$test_name,
    "TIMEOUT"			=> \$timeout,
    "BOOTED_TIMEOUT"		=> \$booted_timeout,
    "CONSOLE"			=> \$console,
    "DETECT_TRIPLE_FAULT"	=> \$detect_triplefault,
    "SUCCESS_LINE"		=> \$success_line,
    "REBOOT_SUCCESS_LINE"	=> \$reboot_success_line,
    "STOP_AFTER_SUCCESS"	=> \$stop_after_success,
    "STOP_AFTER_FAILURE"	=> \$stop_after_failure,
    "STOP_TEST_AFTER"		=> \$stop_test_after,
    "BUILD_TARGET"		=> \$build_target,
    "SSH_EXEC"			=> \$ssh_exec,
    "SCP_TO_TARGET"		=> \$scp_to_target,
248
    "SCP_TO_TARGET_INSTALL"	=> \$scp_to_target_install,
249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272
    "CHECKOUT"			=> \$checkout,
    "TARGET_IMAGE"		=> \$target_image,
    "LOCALVERSION"		=> \$localversion,

    "BISECT_GOOD"		=> \$bisect_good,
    "BISECT_BAD"		=> \$bisect_bad,
    "BISECT_TYPE"		=> \$bisect_type,
    "BISECT_START"		=> \$bisect_start,
    "BISECT_REPLAY"		=> \$bisect_replay,
    "BISECT_FILES"		=> \$bisect_files,
    "BISECT_REVERSE"		=> \$bisect_reverse,
    "BISECT_CHECK"		=> \$bisect_check,

    "CONFIG_BISECT"		=> \$config_bisect,
    "CONFIG_BISECT_TYPE"	=> \$config_bisect_type,

    "PATCHCHECK_TYPE"		=> \$patchcheck_type,
    "PATCHCHECK_START"		=> \$patchcheck_start,
    "PATCHCHECK_END"		=> \$patchcheck_end,
);

# Options may be used by other options, record them.
my %used_options;

S
Steven Rostedt 已提交
273 274 275
# default variables that can be used
chomp ($variable{"PWD"} = `pwd`);

276 277
$config_help{"MACHINE"} = << "EOF"
 The machine hostname that you will test.
278
 For build only tests, it is still needed to differentiate log files.
279 280 281 282 283 284 285 286 287
EOF
    ;
$config_help{"SSH_USER"} = << "EOF"
 The box is expected to have ssh on normal bootup, provide the user
  (most likely root, since you need privileged operations)
EOF
    ;
$config_help{"BUILD_DIR"} = << "EOF"
 The directory that contains the Linux source code (full path).
288 289
 You can use \${PWD} that will be the path where ktest.pl is run, or use
 \${THIS_DIR} which is assigned \${PWD} but may be changed later.
290 291 292 293 294
EOF
    ;
$config_help{"OUTPUT_DIR"} = << "EOF"
 The directory that the objects will be built (full path).
 (can not be same as BUILD_DIR)
295 296
 You can use \${PWD} that will be the path where ktest.pl is run, or use
 \${THIS_DIR} which is assigned \${PWD} but may be changed later.
297 298 299 300 301 302 303
EOF
    ;
$config_help{"BUILD_TARGET"} = << "EOF"
 The location of the compiled file to copy to the target.
 (relative to OUTPUT_DIR)
EOF
    ;
304 305 306 307 308
$config_help{"BUILD_OPTIONS"} = << "EOF"
 Options to add to \"make\" when building.
 i.e.  -j20
EOF
    ;
309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373
$config_help{"TARGET_IMAGE"} = << "EOF"
 The place to put your image on the test machine.
EOF
    ;
$config_help{"POWER_CYCLE"} = << "EOF"
 A script or command to reboot the box.

 Here is a digital loggers power switch example
 POWER_CYCLE = wget --no-proxy -O /dev/null -q  --auth-no-challenge 'http://admin:admin\@power/outlet?5=CCL'

 Here is an example to reboot a virtual box on the current host
 with the name "Guest".
 POWER_CYCLE = virsh destroy Guest; sleep 5; virsh start Guest
EOF
    ;
$config_help{"CONSOLE"} = << "EOF"
 The script or command that reads the console

  If you use ttywatch server, something like the following would work.
CONSOLE = nc -d localhost 3001

 For a virtual machine with guest name "Guest".
CONSOLE =  virsh console Guest
EOF
    ;
$config_help{"LOCALVERSION"} = << "EOF"
 Required version ending to differentiate the test
 from other linux builds on the system.
EOF
    ;
$config_help{"REBOOT_TYPE"} = << "EOF"
 Way to reboot the box to the test kernel.
 Only valid options so far are "grub" and "script".

 If you specify grub, it will assume grub version 1
 and will search in /boot/grub/menu.lst for the title \$GRUB_MENU
 and select that target to reboot to the kernel. If this is not
 your setup, then specify "script" and have a command or script
 specified in REBOOT_SCRIPT to boot to the target.

 The entry in /boot/grub/menu.lst must be entered in manually.
 The test will not modify that file.
EOF
    ;
$config_help{"GRUB_MENU"} = << "EOF"
 The grub title name for the test kernel to boot
 (Only mandatory if REBOOT_TYPE = grub)

 Note, ktest.pl will not update the grub menu.lst, you need to
 manually add an option for the test. ktest.pl will search
 the grub menu.lst for this option to find what kernel to
 reboot into.

 For example, if in the /boot/grub/menu.lst the test kernel title has:
 title Test Kernel
 kernel vmlinuz-test
 GRUB_MENU = Test Kernel
EOF
    ;
$config_help{"REBOOT_SCRIPT"} = << "EOF"
 A script to reboot the target into the test kernel
 (Only mandatory if REBOOT_TYPE = script)
EOF
    ;

374 375
sub read_prompt {
    my ($cancel, $prompt) = @_;
376 377 378 379

    my $ans;

    for (;;) {
380 381 382 383 384
	if ($cancel) {
	    print "$prompt [y/n/C] ";
	} else {
	    print "$prompt [Y/n] ";
	}
385 386 387
	$ans = <STDIN>;
	chomp $ans;
	if ($ans =~ /^\s*$/) {
388 389 390 391 392
	    if ($cancel) {
		$ans = "c";
	    } else {
		$ans = "y";
	    }
393 394
	}
	last if ($ans =~ /^y$/i || $ans =~ /^n$/i);
395 396 397 398 399 400 401 402 403
	if ($cancel) {
	    last if ($ans =~ /^c$/i);
	    print "Please answer either 'y', 'n' or 'c'.\n";
	} else {
	    print "Please answer either 'y' or 'n'.\n";
	}
    }
    if ($ans =~ /^c/i) {
	exit;
404 405 406 407 408 409
    }
    if ($ans !~ /^y$/i) {
	return 0;
    }
    return 1;
}
410

411 412 413 414 415 416 417 418 419 420 421 422
sub read_yn {
    my ($prompt) = @_;

    return read_prompt 0, $prompt;
}

sub read_ync {
    my ($prompt) = @_;

    return read_prompt 1, $prompt;
}

423 424
sub get_ktest_config {
    my ($config) = @_;
425
    my $ans;
426 427 428 429 430 431 432 433 434 435

    return if (defined($opt{$config}));

    if (defined($config_help{$config})) {
	print "\n";
	print $config_help{$config};
    }

    for (;;) {
	print "$config = ";
436
	if (defined($default{$config}) && length($default{$config})) {
437 438
	    print "\[$default{$config}\] ";
	}
439 440 441
	$ans = <STDIN>;
	$ans =~ s/^\s*(.*\S)\s*$/$1/;
	if ($ans =~ /^\s*$/) {
442
	    if ($default{$config}) {
443
		$ans = $default{$config};
444 445 446 447 448
	    } else {
		print "Your answer can not be blank\n";
		next;
	    }
	}
449
	$entered_configs{$config} = ${ans};
450 451 452 453 454 455 456 457
	last;
    }
}

sub get_ktest_configs {
    get_ktest_config("MACHINE");
    get_ktest_config("BUILD_DIR");
    get_ktest_config("OUTPUT_DIR");
458

459 460 461 462
    if ($newconfig) {
	get_ktest_config("BUILD_OPTIONS");
    }

463 464
    # options required for other than just building a kernel
    if (!$buildonly) {
465 466 467 468 469 470
	get_ktest_config("POWER_CYCLE");
	get_ktest_config("CONSOLE");
    }

    # options required for install and more
    if ($buildonly != 1) {
471 472 473 474 475
	get_ktest_config("SSH_USER");
	get_ktest_config("BUILD_TARGET");
	get_ktest_config("TARGET_IMAGE");
    }

476 477
    get_ktest_config("LOCALVERSION");

478 479
    return if ($buildonly);

480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495
    my $rtype = $opt{"REBOOT_TYPE"};

    if (!defined($rtype)) {
	if (!defined($opt{"GRUB_MENU"})) {
	    get_ktest_config("REBOOT_TYPE");
	    $rtype = $entered_configs{"REBOOT_TYPE"};
	} else {
	    $rtype = "grub";
	}
    }

    if ($rtype eq "grub") {
	get_ktest_config("GRUB_MENU");
    }
}

496
sub process_variables {
497
    my ($value, $remove_undef) = @_;
498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514
    my $retval = "";

    # We want to check for '\', and it is just easier
    # to check the previous characet of '$' and not need
    # to worry if '$' is the first character. By adding
    # a space to $value, we can just check [^\\]\$ and
    # it will still work.
    $value = " $value";

    while ($value =~ /(.*?[^\\])\$\{(.*?)\}(.*)/) {
	my $begin = $1;
	my $var = $2;
	my $end = $3;
	# append beginning of value to retval
	$retval = "$retval$begin";
	if (defined($variable{$var})) {
	    $retval = "$retval$variable{$var}";
515 516 517 518
	} elsif (defined($remove_undef) && $remove_undef) {
	    # for if statements, any variable that is not defined,
	    # we simple convert to 0
	    $retval = "${retval}0";
519 520 521
	} else {
	    # put back the origin piece.
	    $retval = "$retval\$\{$var\}";
522 523 524 525
	    # This could be an option that is used later, save
	    # it so we don't warn if this option is not one of
	    # ktests options.
	    $used_options{$var} = 1;
526 527 528 529 530 531 532 533 534 535 536
	}
	$value = $end;
    }
    $retval = "$retval$value";

    # remove the space added in the beginning
    $retval =~ s/ //;

    return "$retval"
}

537
sub set_value {
538
    my ($lvalue, $rvalue, $override, $overrides, $name) = @_;
539

540 541 542
    my $prvalue = process_variables($rvalue);

    if ($buildonly && $lvalue =~ /^TEST_TYPE(\[.*\])?$/ && $prvalue ne "build") {
543 544
	# Note if a test is something other than build, then we
	# will need other manditory options.
545
	if ($prvalue ne "install") {
546 547 548 549 550
	    $buildonly = 0;
	} else {
	    # install still limits some manditory options.
	    $buildonly = 2;
	}
551 552
    }

553
    if (defined($opt{$lvalue})) {
554 555 556 557 558 559 560
	if (!$override || defined(${$overrides}{$lvalue})) {
	    my $extra = "";
	    if ($override) {
		$extra = "In the same override section!\n";
	    }
	    die "$name: $.: Option $lvalue defined more than once!\n$extra";
	}
561
	${$overrides}{$lvalue} = $prvalue;
562
    }
563 564 565
    if ($rvalue =~ /^\s*$/) {
	delete $opt{$lvalue};
    } else {
566
	$opt{$lvalue} = $prvalue;
567
    }
568 569
}

570 571 572 573 574 575 576 577 578 579 580
sub set_variable {
    my ($lvalue, $rvalue) = @_;

    if ($rvalue =~ /^\s*$/) {
	delete $variable{$lvalue};
    } else {
	$rvalue = process_variables($rvalue);
	$variable{$lvalue} = $rvalue;
    }
}

581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608
sub process_compare {
    my ($lval, $cmp, $rval) = @_;

    # remove whitespace

    $lval =~ s/^\s*//;
    $lval =~ s/\s*$//;

    $rval =~ s/^\s*//;
    $rval =~ s/\s*$//;

    if ($cmp eq "==") {
	return $lval eq $rval;
    } elsif ($cmp eq "!=") {
	return $lval ne $rval;
    }

    my $statement = "$lval $cmp $rval";
    my $ret = eval $statement;

    # $@ stores error of eval
    if ($@) {
	return -1;
    }

    return $ret;
}

609 610 611 612 613 614 615
sub value_defined {
    my ($val) = @_;

    return defined($variable{$2}) ||
	defined($opt{$2});
}

616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634
my $d = 0;
sub process_expression {
    my ($name, $val) = @_;

    my $c = $d++;

    while ($val =~ s/\(([^\(]*?)\)/\&\&\&\&VAL\&\&\&\&/) {
	my $express = $1;

	if (process_expression($name, $express)) {
	    $val =~ s/\&\&\&\&VAL\&\&\&\&/ 1 /;
	} else {
	    $val =~ s/\&\&\&\&VAL\&\&\&\&/ 0 /;
	}
    }

    $d--;
    my $OR = "\\|\\|";
    my $AND = "\\&\\&";
635

636 637 638 639 640 641 642 643 644 645 646 647 648 649
    while ($val =~ s/^(.*?)($OR|$AND)//) {
	my $express = $1;
	my $op = $2;

	if (process_expression($name, $express)) {
	    if ($op eq "||") {
		return 1;
	    }
	} else {
	    if ($op eq "&&") {
		return 0;
	    }
	}
    }
650

651 652 653 654 655 656 657 658
    if ($val =~ /(.*)(==|\!=|>=|<=|>|<)(.*)/) {
	my $ret = process_compare($1, $2, $3);
	if ($ret < 0) {
	    die "$name: $.: Unable to process comparison\n";
	}
	return $ret;
    }

659 660 661 662 663 664 665 666
    if ($val =~ /^\s*(NOT\s*)?DEFINED\s+(\S+)\s*$/) {
	if (defined $1) {
	    return !value_defined($2);
	} else {
	    return value_defined($2);
	}
    }

667 668 669 670 671 672
    if ($val =~ /^\s*0\s*$/) {
	return 0;
    } elsif ($val =~ /^\s*\d+\s*$/) {
	return 1;
    }

673
    die ("$name: $.: Undefined content $val in if statement\n");
674 675 676 677 678 679 680 681 682 683
}

sub process_if {
    my ($name, $value) = @_;

    # Convert variables and replace undefined ones with 0
    my $val = process_variables($value, 1);
    my $ret = process_expression $name, $val;

    return $ret;
684 685
}

686 687
sub __read_config {
    my ($config, $current_test_num) = @_;
S
Steven Rostedt 已提交
688

689 690
    my $in;
    open($in, $config) || die "can't read file $config";
S
Steven Rostedt 已提交
691

692 693 694
    my $name = $config;
    $name =~ s,.*/(.*),$1,;

695
    my $test_num = $$current_test_num;
696 697 698 699 700
    my $default = 1;
    my $repeat = 1;
    my $num_tests_set = 0;
    my $skip = 0;
    my $rest;
701
    my $line;
702
    my $test_case = 0;
703 704
    my $if = 0;
    my $if_set = 0;
705 706 707
    my $override = 0;

    my %overrides;
708

709
    while (<$in>) {
S
Steven Rostedt 已提交
710 711 712 713

	# ignore blank lines and comments
	next if (/^\s*$/ || /\s*\#/);

714
	if (/^\s*(TEST_START|DEFAULTS)\b(.*)/) {
715

716 717
	    my $type = $1;
	    $rest = $2;
718
	    $line = $2;
719

720 721
	    my $old_test_num;
	    my $old_repeat;
722
	    $override = 0;
723 724 725 726 727 728

	    if ($type eq "TEST_START") {

		if ($num_tests_set) {
		    die "$name: $.: Can not specify both NUM_TESTS and TEST_START\n";
		}
729

730 731
		$old_test_num = $test_num;
		$old_repeat = $repeat;
732

733 734 735 736 737 738
		$test_num += $repeat;
		$default = 0;
		$repeat = 1;
	    } else {
		$default = 1;
	    }
739

740 741
	    # If SKIP is anywhere in the line, the command will be skipped
	    if ($rest =~ s/\s+SKIP\b//) {
742 743
		$skip = 1;
	    } else {
744
		$test_case = 1;
745 746 747
		$skip = 0;
	    }

748 749 750 751 752 753 754 755 756 757
	    if ($rest =~ s/\sELSE\b//) {
		if (!$if) {
		    die "$name: $.: ELSE found with out matching IF section\n$_";
		}
		$if = 0;

		if ($if_set) {
		    $skip = 1;
		} else {
		    $skip = 0;
758
		}
759 760
	    }

761
	    if ($rest =~ s/\sIF\s+(.*)//) {
762 763 764 765 766 767 768 769
		if (process_if($name, $1)) {
		    $if_set = 1;
		} else {
		    $skip = 1;
		}
		$if = 1;
	    } else {
		$if = 0;
770 771 772 773 774 775 776 777 778 779 780 781 782 783 784
		$if_set = 0;
	    }

	    if (!$skip) {
		if ($type eq "TEST_START") {
		    if ($rest =~ s/\s+ITERATE\s+(\d+)//) {
			$repeat = $1;
			$repeat_tests{"$test_num"} = $repeat;
		    }
		} elsif ($rest =~ s/\sOVERRIDE\b//) {
		    # DEFAULT only
		    $override = 1;
		    # Clear previous overrides
		    %overrides = ();
		}
785 786
	    }

787
	    if (!$skip && $rest !~ /^\s*$/) {
788
		die "$name: $.: Gargbage found after $type\n$_";
789 790
	    }

791
	    if ($skip && $type eq "TEST_START") {
792
		$test_num = $old_test_num;
793
		$repeat = $old_repeat;
794 795
	    }

796
	} elsif (/^\s*ELSE\b(.*)$/) {
797 798 799 800 801 802
	    if (!$if) {
		die "$name: $.: ELSE found with out matching IF section\n$_";
	    }
	    $rest = $1;
	    if ($if_set) {
		$skip = 1;
803
		$rest = "";
804 805 806
	    } else {
		$skip = 0;

807
		if ($rest =~ /\sIF\s+(.*)/) {
808 809 810 811
		    # May be a ELSE IF section.
		    if (!process_if($name, $1)) {
			$skip = 1;
		    }
812
		    $rest = "";
813 814 815 816 817
		} else {
		    $if = 0;
		}
	    }

818 819 820 821
	    if ($rest !~ /^\s*$/) {
		die "$name: $.: Gargbage found after DEFAULTS\n$_";
	    }

822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848
	} elsif (/^\s*INCLUDE\s+(\S+)/) {

	    next if ($skip);

	    if (!$default) {
		die "$name: $.: INCLUDE can only be done in default sections\n$_";
	    }

	    my $file = process_variables($1);

	    if ($file !~ m,^/,) {
		# check the path of the config file first
		if ($config =~ m,(.*)/,) {
		    if (-f "$1/$file") {
			$file = "$1/$file";
		    }
		}
	    }
		
	    if ( ! -r $file ) {
		die "$name: $.: Can't read file $file\n$_";
	    }

	    if (__read_config($file, \$test_num)) {
		$test_case = 1;
	    }

849 850 851 852
	} elsif (/^\s*([A-Z_\[\]\d]+)\s*=\s*(.*?)\s*$/) {

	    next if ($skip);

S
Steven Rostedt 已提交
853 854 855
	    my $lvalue = $1;
	    my $rvalue = $2;

856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873
	    if (!$default &&
		($lvalue eq "NUM_TESTS" ||
		 $lvalue eq "LOG_FILE" ||
		 $lvalue eq "CLEAR_LOG")) {
		die "$name: $.: $lvalue must be set in DEFAULTS section\n";
	    }

	    if ($lvalue eq "NUM_TESTS") {
		if ($test_num) {
		    die "$name: $.: Can not specify both NUM_TESTS and TEST_START\n";
		}
		if (!$default) {
		    die "$name: $.: NUM_TESTS must be set in default section\n";
		}
		$num_tests_set = 1;
	    }

	    if ($default || $lvalue =~ /\[\d+\]$/) {
874
		set_value($lvalue, $rvalue, $override, \%overrides, $name);
875 876
	    } else {
		my $val = "$lvalue\[$test_num\]";
877
		set_value($val, $rvalue, $override, \%overrides, $name);
878 879 880 881

		if ($repeat > 1) {
		    $repeats{$val} = $repeat;
		}
882
	    }
883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898
	} elsif (/^\s*([A-Z_\[\]\d]+)\s*:=\s*(.*?)\s*$/) {
	    next if ($skip);

	    my $lvalue = $1;
	    my $rvalue = $2;

	    # process config variables.
	    # Config variables are only active while reading the
	    # config and can be defined anywhere. They also ignore
	    # TEST_START and DEFAULTS, but are skipped if they are in
	    # on of these sections that have SKIP defined.
	    # The save variable can be
	    # defined multiple times and the new one simply overrides
	    # the prevous one.
	    set_variable($lvalue, $rvalue);

899 900
	} else {
	    die "$name: $.: Garbage found in config\n$_";
S
Steven Rostedt 已提交
901 902 903
	}
    }

904 905 906 907 908
    if ($test_num) {
	$test_num += $repeat - 1;
	$opt{"NUM_TESTS"} = $test_num;
    }

909 910 911 912 913 914 915
    close($in);

    $$current_test_num = $test_num;

    return $test_case;
}

916 917 918 919 920 921 922 923 924
sub get_test_case {
	print "What test case would you like to run?\n";
	print " (build, install or boot)\n";
	print " Other tests are available but require editing the config file\n";
	my $ans = <STDIN>;
	chomp $ans;
	$default{"TEST_TYPE"} = $ans;
}

925 926 927 928 929 930 931 932
sub read_config {
    my ($config) = @_;

    my $test_case;
    my $test_num = 0;

    $test_case = __read_config $config, \$test_num;

933 934 935
    # make sure we have all mandatory configs
    get_ktest_configs;

936 937 938
    # was a test specified?
    if (!$test_case) {
	print "No test case specified.\n";
939
	get_test_case;
940 941
    }

942 943 944 945 946 947 948
    # set any defaults

    foreach my $default (keys %default) {
	if (!defined($opt{$default})) {
	    $opt{$default} = $default{$default};
	}
    }
949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979

    if ($opt{"IGNORE_UNUSED"} == 1) {
	return;
    }

    my %not_used;

    # check if there are any stragglers (typos?)
    foreach my $option (keys %opt) {
	my $op = $option;
	# remove per test labels.
	$op =~ s/\[.*\]//;
	if (!exists($option_map{$op}) &&
	    !exists($default{$op}) &&
	    !exists($used_options{$op})) {
	    $not_used{$op} = 1;
	}
    }

    if (%not_used) {
	my $s = "s are";
	$s = " is" if (keys %not_used == 1);
	print "The following option$s not used; could be a typo:\n";
	foreach my $option (keys %not_used) {
	    print "$option\n";
	}
	print "Set IGRNORE_UNUSED = 1 to have ktest ignore unused variables\n";
	if (!read_yn "Do you want to continue?") {
	    exit -1;
	}
    }
S
Steven Rostedt 已提交
980 981
}

982 983 984 985 986 987
sub __eval_option {
    my ($option, $i) = @_;

    # Add space to evaluate the character before $
    $option = " $option";
    my $retval = "";
988 989 990 991 992 993 994 995 996 997 998 999
    my $repeated = 0;
    my $parent = 0;

    foreach my $test (keys %repeat_tests) {
	if ($i >= $test &&
	    $i < $test + $repeat_tests{$test}) {

	    $repeated = 1;
	    $parent = $test;
	    last;
	}
    }
1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012

    while ($option =~ /(.*?[^\\])\$\{(.*?)\}(.*)/) {
	my $start = $1;
	my $var = $2;
	my $end = $3;

	# Append beginning of line
	$retval = "$retval$start";

	# If the iteration option OPT[$i] exists, then use that.
	# otherwise see if the default OPT (without [$i]) exists.

	my $o = "$var\[$i\]";
1013
	my $parento = "$var\[$parent\]";
1014 1015 1016 1017

	if (defined($opt{$o})) {
	    $o = $opt{$o};
	    $retval = "$retval$o";
1018 1019 1020
	} elsif ($repeated && defined($opt{$parento})) {
	    $o = $opt{$parento};
	    $retval = "$retval$o";
1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060
	} elsif (defined($opt{$var})) {
	    $o = $opt{$var};
	    $retval = "$retval$o";
	} else {
	    $retval = "$retval\$\{$var\}";
	}

	$option = $end;
    }

    $retval = "$retval$option";

    $retval =~ s/^ //;

    return $retval;
}

sub eval_option {
    my ($option, $i) = @_;

    my $prev = "";

    # Since an option can evaluate to another option,
    # keep iterating until we do not evaluate any more
    # options.
    my $r = 0;
    while ($prev ne $option) {
	# Check for recursive evaluations.
	# 100 deep should be more than enough.
	if ($r++ > 100) {
	    die "Over 100 evaluations accurred with $option\n" .
		"Check for recursive variables\n";
	}
	$prev = $option;
	$option = __eval_option($option, $i);
    }

    return $option;
}

1061
sub _logit {
S
Steven Rostedt 已提交
1062 1063 1064 1065 1066 1067 1068
    if (defined($opt{"LOG_FILE"})) {
	open(OUT, ">> $opt{LOG_FILE}") or die "Can't write to $opt{LOG_FILE}";
	print OUT @_;
	close(OUT);
    }
}

1069 1070 1071 1072 1073 1074 1075 1076
sub logit {
    if (defined($opt{"LOG_FILE"})) {
	_logit @_;
    } else {
	print @_;
    }
}

1077 1078
sub doprint {
    print @_;
1079
    _logit @_;
1080 1081
}

1082
sub run_command;
1083 1084 1085
sub start_monitor;
sub end_monitor;
sub wait_for_monitor;
1086 1087

sub reboot {
1088 1089
    my ($time) = @_;

1090 1091 1092 1093 1094 1095 1096
    if (defined($time)) {
	start_monitor;
	# flush out current monitor
	# May contain the reboot success line
	wait_for_monitor 1;
    }

1097
    # try to reboot normally
1098
    if (run_command $reboot) {
1099 1100 1101 1102 1103
	if (defined($powercycle_after_reboot)) {
	    sleep $powercycle_after_reboot;
	    run_command "$power_cycle";
	}
    } else {
1104
	# nope? power cycle it.
1105
	run_command "$power_cycle";
1106
    }
1107 1108

    if (defined($time)) {
1109
	wait_for_monitor($time, $reboot_success_line);
1110 1111
	end_monitor;
    }
1112 1113
}

1114 1115 1116 1117 1118 1119 1120 1121 1122 1123
sub reboot_to_good {
    my ($time) = @_;

    if (defined($switch_to_good)) {
	run_command $switch_to_good;
    }

    reboot $time;
}

1124 1125 1126
sub do_not_reboot {
    my $i = $iteration;

1127
    return $test_type eq "build" || $no_reboot ||
1128 1129 1130 1131
	($test_type eq "patchcheck" && $opt{"PATCHCHECK_TYPE[$i]"} eq "build") ||
	($test_type eq "bisect" && $opt{"BISECT_TYPE[$i]"} eq "build");
}

1132
sub dodie {
1133
    doprint "CRITICAL FAILURE... ", @_, "\n";
1134

1135 1136 1137 1138
    my $i = $iteration;

    if ($reboot_on_error && !do_not_reboot) {

1139
	doprint "REBOOTING\n";
1140
	reboot_to_good;
1141

1142
    } elsif ($poweroff_on_error && defined($power_off)) {
1143
	doprint "POWERING OFF\n";
1144
	`$power_off`;
1145
    }
1146

1147 1148 1149 1150
    if (defined($opt{"LOG_FILE"})) {
	print " See $opt{LOG_FILE} for more info.\n";
    }

1151
    die @_, "\n";
1152 1153
}

1154 1155 1156 1157 1158
sub open_console {
    my ($fp) = @_;

    my $flags;

1159 1160
    my $pid = open($fp, "$console|") or
	dodie "Can't open console $console";
1161 1162

    $flags = fcntl($fp, F_GETFL, 0) or
1163
	dodie "Can't get flags for the socket: $!";
1164
    $flags = fcntl($fp, F_SETFL, $flags | O_NONBLOCK) or
1165
	dodie "Can't set flags for the socket: $!";
1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185

    return $pid;
}

sub close_console {
    my ($fp, $pid) = @_;

    doprint "kill child process $pid\n";
    kill 2, $pid;

    print "closing!\n";
    close($fp);
}

sub start_monitor {
    if ($monitor_cnt++) {
	return;
    }
    $monitor_fp = \*MONFD;
    $monitor_pid = open_console $monitor_fp;
1186 1187 1188 1189

    return;

    open(MONFD, "Stop perl from warning about single use of MONFD");
1190 1191 1192 1193 1194 1195 1196 1197 1198 1199
}

sub end_monitor {
    if (--$monitor_cnt) {
	return;
    }
    close_console($monitor_fp, $monitor_pid);
}

sub wait_for_monitor {
1200 1201
    my ($time, $stop) = @_;
    my $full_line = "";
1202
    my $line;
1203
    my $booted = 0;
1204

1205
    doprint "** Wait for monitor to settle down **\n";
1206 1207

    # read the monitor and wait for the system to calm down
1208
    while (!$booted) {
1209
	$line = wait_for_input($monitor_fp, $time);
1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222
	last if (!defined($line));
	print "$line";
	$full_line .= $line;

	if (defined($stop) && $full_line =~ /$stop/) {
	    doprint "wait for monitor detected $stop\n";
	    $booted = 1;
	}

	if ($line =~ /\n/) {
	    $full_line = "";
	}
    }
1223
    print "** Monitor flushed **\n";
1224 1225
}

1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262
sub save_logs {
	my ($result, $basedir) = @_;
	my @t = localtime;
	my $date = sprintf "%04d%02d%02d%02d%02d%02d",
		1900+$t[5],$t[4],$t[3],$t[2],$t[1],$t[0];

	my $type = $build_type;
	if ($type =~ /useconfig/) {
	    $type = "useconfig";
	}

	my $dir = "$machine-$test_type-$type-$result-$date";

	$dir = "$basedir/$dir";

	if (!-d $dir) {
	    mkpath($dir) or
		die "can't create $dir";
	}

	my %files = (
		"config" => $output_config,
		"buildlog" => $buildlog,
		"dmesg" => $dmesg,
		"testlog" => $testlog,
	);

	while (my ($name, $source) = each(%files)) {
		if (-f "$source") {
			cp "$source", "$dir/$name" or
				die "failed to copy $source";
		}
	}

	doprint "*** Saved info to $dir ***\n";
}

1263 1264
sub fail {

1265
	if ($die_on_failure) {
1266 1267 1268
		dodie @_;
	}

1269
	doprint "FAILED\n";
1270

1271 1272
	my $i = $iteration;

1273
	# no need to reboot for just building.
1274
	if (!do_not_reboot) {
1275
	    doprint "REBOOTING\n";
1276
	    reboot_to_good $sleep_time;
1277
	}
1278

S
Steven Rostedt 已提交
1279 1280 1281 1282 1283 1284
	my $name = "";

	if (defined($test_name)) {
	    $name = " ($test_name)";
	}

1285 1286
	doprint "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n";
	doprint "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n";
S
Steven Rostedt 已提交
1287
	doprint "KTEST RESULT: TEST $i$name Failed: ", @_, "\n";
1288 1289
	doprint "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n";
	doprint "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n";
1290

1291 1292 1293
	if (defined($store_failures)) {
	    save_logs "fail", $store_failures;
        }
1294

1295 1296 1297
	return 1;
}

S
Steven Rostedt 已提交
1298 1299
sub run_command {
    my ($command) = @_;
1300 1301 1302 1303
    my $dolog = 0;
    my $dord = 0;
    my $pid;

1304 1305 1306
    $command =~ s/\$SSH_USER/$ssh_user/g;
    $command =~ s/\$MACHINE/$machine/g;

1307 1308 1309
    doprint("$command ... ");

    $pid = open(CMD, "$command 2>&1 |") or
1310
	(fail "unable to exec $command" and return 0);
S
Steven Rostedt 已提交
1311 1312

    if (defined($opt{"LOG_FILE"})) {
1313 1314 1315
	open(LOG, ">>$opt{LOG_FILE}") or
	    dodie "failed to write to log";
	$dolog = 1;
S
Steven Rostedt 已提交
1316 1317 1318
    }

    if (defined($redirect)) {
1319 1320 1321
	open (RD, ">$redirect") or
	    dodie "failed to write to redirect $redirect";
	$dord = 1;
S
Steven Rostedt 已提交
1322 1323
    }

1324 1325 1326 1327
    while (<CMD>) {
	print LOG if ($dolog);
	print RD  if ($dord);
    }
S
Steven Rostedt 已提交
1328

1329
    waitpid($pid, 0);
S
Steven Rostedt 已提交
1330 1331
    my $failed = $?;

1332 1333 1334 1335
    close(CMD);
    close(LOG) if ($dolog);
    close(RD)  if ($dord);

S
Steven Rostedt 已提交
1336 1337 1338 1339 1340 1341
    if ($failed) {
	doprint "FAILED!\n";
    } else {
	doprint "SUCCESS\n";
    }

1342 1343 1344
    return !$failed;
}

1345 1346 1347 1348 1349 1350 1351 1352 1353
sub run_ssh {
    my ($cmd) = @_;
    my $cp_exec = $ssh_exec;

    $cp_exec =~ s/\$SSH_COMMAND/$cmd/g;
    return run_command "$cp_exec";
}

sub run_scp {
1354
    my ($src, $dst, $cp_scp) = @_;
1355 1356 1357 1358 1359 1360 1361

    $cp_scp =~ s/\$SRC_FILE/$src/g;
    $cp_scp =~ s/\$DST_FILE/$dst/g;

    return run_command "$cp_scp";
}

1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377
sub run_scp_install {
    my ($src, $dst) = @_;

    my $cp_scp = $scp_to_target_install;

    return run_scp($src, $dst, $cp_scp);
}

sub run_scp_mod {
    my ($src, $dst) = @_;

    my $cp_scp = $scp_to_target;

    return run_scp($src, $dst, $cp_scp);
}

1378 1379
sub get_grub_index {

1380 1381 1382
    if ($reboot_type ne "grub") {
	return;
    }
1383
    return if (defined($grub_number));
1384 1385 1386

    doprint "Find grub menu ... ";
    $grub_number = -1;
1387 1388 1389 1390 1391

    my $ssh_grub = $ssh_exec;
    $ssh_grub =~ s,\$SSH_COMMAND,cat /boot/grub/menu.lst,g;

    open(IN, "$ssh_grub |")
1392
	or die "unable to get menu.lst";
1393

1394 1395
    my $found = 0;

1396
    while (<IN>) {
1397
	if (/^\s*title\s+$grub_menu\s*$/) {
1398
	    $grub_number++;
1399
	    $found = 1;
1400 1401 1402 1403 1404 1405 1406
	    last;
	} elsif (/^\s*title\s/) {
	    $grub_number++;
	}
    }
    close(IN);

1407
    die "Could not find '$grub_menu' in /boot/grub/menu on $machine"
1408
	if (!$found);
1409
    doprint "$grub_number\n";
S
Steven Rostedt 已提交
1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442
}

sub wait_for_input
{
    my ($fp, $time) = @_;
    my $rin;
    my $ready;
    my $line;
    my $ch;

    if (!defined($time)) {
	$time = $timeout;
    }

    $rin = '';
    vec($rin, fileno($fp), 1) = 1;
    $ready = select($rin, undef, undef, $time);

    $line = "";

    # try to read one char at a time
    while (sysread $fp, $ch, 1) {
	$line .= $ch;
	last if ($ch eq "\n");
    }

    if (!length($line)) {
	return undef;
    }

    return $line;
}

1443
sub reboot_to {
1444 1445 1446 1447
    if (defined($switch_to_test)) {
	run_command $switch_to_test;
    }

1448
    if ($reboot_type eq "grub") {
1449
	run_ssh "'(echo \"savedefault --default=$grub_number --once\" | grub --batch)'";
1450 1451
    } elsif (defined $reboot_script) {
	run_command "$reboot_script";
1452
    }
1453
    reboot;
S
Steven Rostedt 已提交
1454 1455
}

1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476
sub get_sha1 {
    my ($commit) = @_;

    doprint "git rev-list --max-count=1 $commit ... ";
    my $sha1 = `git rev-list --max-count=1 $commit`;
    my $ret = $?;

    logit $sha1;

    if ($ret) {
	doprint "FAILED\n";
	dodie "Failed to get git $commit";
    }

    print "SUCCESS\n";

    chomp $sha1;

    return $sha1;
}

1477
sub monitor {
S
Steven Rostedt 已提交
1478 1479
    my $booted = 0;
    my $bug = 0;
1480
    my $bug_ignored = 0;
1481
    my $skip_call_trace = 0;
1482
    my $loops;
S
Steven Rostedt 已提交
1483

1484
    wait_for_monitor 5;
S
Steven Rostedt 已提交
1485 1486 1487 1488

    my $line;
    my $full_line = "";

1489 1490
    open(DMESG, "> $dmesg") or
	die "unable to write to $dmesg";
S
Steven Rostedt 已提交
1491

1492
    reboot_to;
S
Steven Rostedt 已提交
1493

1494 1495
    my $success_start;
    my $failure_start;
1496 1497
    my $monitor_start = time;
    my $done = 0;
1498
    my $version_found = 0;
1499

1500
    while (!$done) {
S
Steven Rostedt 已提交
1501

1502 1503 1504 1505 1506 1507 1508 1509 1510 1511
	if ($bug && defined($stop_after_failure) &&
	    $stop_after_failure >= 0) {
	    my $time = $stop_after_failure - (time - $failure_start);
	    $line = wait_for_input($monitor_fp, $time);
	    if (!defined($line)) {
		doprint "bug timed out after $booted_timeout seconds\n";
		doprint "Test forced to stop after $stop_after_failure seconds after failure\n";
		last;
	    }
	} elsif ($booted) {
1512
	    $line = wait_for_input($monitor_fp, $booted_timeout);
1513 1514 1515 1516 1517
	    if (!defined($line)) {
		my $s = $booted_timeout == 1 ? "" : "s";
		doprint "Successful boot found: break after $booted_timeout second$s\n";
		last;
	    }
1518
	} else {
1519
	    $line = wait_for_input($monitor_fp);
1520 1521 1522 1523 1524
	    if (!defined($line)) {
		my $s = $timeout == 1 ? "" : "s";
		doprint "Timed out after $timeout second$s\n";
		last;
	    }
1525
	}
S
Steven Rostedt 已提交
1526 1527

	doprint $line;
1528
	print DMESG $line;
S
Steven Rostedt 已提交
1529 1530 1531 1532

	# we are not guaranteed to get a full line
	$full_line .= $line;

1533
	if ($full_line =~ /$success_line/) {
S
Steven Rostedt 已提交
1534
	    $booted = 1;
1535 1536 1537 1538 1539 1540 1541 1542 1543 1544
	    $success_start = time;
	}

	if ($booted && defined($stop_after_success) &&
	    $stop_after_success >= 0) {
	    my $now = time;
	    if ($now - $success_start >= $stop_after_success) {
		doprint "Test forced to stop after $stop_after_success seconds after success\n";
		last;
	    }
S
Steven Rostedt 已提交
1545 1546
	}

1547 1548 1549 1550
	if ($full_line =~ /\[ backtrace testing \]/) {
	    $skip_call_trace = 1;
	}

S
Steven Rostedt 已提交
1551
	if ($full_line =~ /call trace:/i) {
1552 1553 1554 1555 1556 1557 1558
	    if (!$bug && !$skip_call_trace) {
		if ($ignore_errors) {
		    $bug_ignored = 1;
		} else {
		    $bug = 1;
		    $failure_start = time;
		}
1559 1560 1561 1562 1563 1564 1565 1566 1567 1568
	    }
	}

	if ($bug && defined($stop_after_failure) &&
	    $stop_after_failure >= 0) {
	    my $now = time;
	    if ($now - $failure_start >= $stop_after_failure) {
		doprint "Test forced to stop after $stop_after_failure seconds after failure\n";
		last;
	    }
1569 1570 1571 1572 1573 1574 1575
	}

	if ($full_line =~ /\[ end of backtrace testing \]/) {
	    $skip_call_trace = 0;
	}

	if ($full_line =~ /Kernel panic -/) {
1576
	    $failure_start = time;
S
Steven Rostedt 已提交
1577 1578 1579
	    $bug = 1;
	}

1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595
	# Detect triple faults by testing the banner
	if ($full_line =~ /\bLinux version (\S+).*\n/) {
	    if ($1 eq $version) {
		$version_found = 1;
	    } elsif ($version_found && $detect_triplefault) {
		# We already booted into the kernel we are testing,
		# but now we booted into another kernel?
		# Consider this a triple fault.
		doprint "Aleady booted in Linux kernel $version, but now\n";
		doprint "we booted into Linux kernel $1.\n";
		doprint "Assuming that this is a triple fault.\n";
		doprint "To disable this: set DETECT_TRIPLE_FAULT to 0\n";
		last;
	    }
	}

S
Steven Rostedt 已提交
1596 1597 1598
	if ($line =~ /\n/) {
	    $full_line = "";
	}
1599 1600 1601

	if ($stop_test_after > 0 && !$booted && !$bug) {
	    if (time - $monitor_start > $stop_test_after) {
1602
		doprint "STOP_TEST_AFTER ($stop_test_after seconds) timed out\n";
1603 1604 1605
		$done = 1;
	    }
	}
S
Steven Rostedt 已提交
1606 1607
    }

1608
    close(DMESG);
S
Steven Rostedt 已提交
1609

1610
    if ($bug) {
1611
	return 0 if ($in_bisect);
1612
	fail "failed - got a bug report" and return 0;
S
Steven Rostedt 已提交
1613 1614
    }

1615
    if (!$booted) {
1616
	return 0 if ($in_bisect);
1617
	fail "failed - never got a boot prompt." and return 0;
S
Steven Rostedt 已提交
1618
    }
1619

1620 1621 1622 1623
    if ($bug_ignored) {
	doprint "WARNING: Call Trace detected but ignored due to IGNORE_ERRORS=1\n";
    }

1624
    return 1;
S
Steven Rostedt 已提交
1625 1626
}

1627 1628 1629 1630 1631 1632 1633 1634
sub eval_kernel_version {
    my ($option) = @_;

    $option =~ s/\$KERNEL_VERSION/$version/g;

    return $option;
}

1635 1636 1637 1638
sub do_post_install {

    return if (!defined($post_install));

1639
    my $cp_post_install = eval_kernel_version $post_install;
1640 1641 1642 1643
    run_command "$cp_post_install" or
	dodie "Failed to run post install";
}

S
Steven Rostedt 已提交
1644 1645
sub install {

1646 1647
    return if ($no_install);

1648 1649
    my $cp_target = eval_kernel_version $target_image;

1650
    run_scp_install "$outputdir/$build_target", "$cp_target" or
1651
	dodie "failed to copy image";
S
Steven Rostedt 已提交
1652

1653
    my $install_mods = 0;
S
Steven Rostedt 已提交
1654

1655 1656
    # should we process modules?
    $install_mods = 0;
1657
    open(IN, "$output_config") or dodie("Can't read config file");
1658 1659 1660 1661
    while (<IN>) {
	if (/CONFIG_MODULES(=y)?/) {
	    $install_mods = 1 if (defined($1));
	    last;
1662
	}
1663 1664
    }
    close(IN);
1665

1666
    if (!$install_mods) {
1667
	do_post_install;
1668 1669 1670
	doprint "No modules needed\n";
	return;
    }
S
Steven Rostedt 已提交
1671

1672
    run_command "$make INSTALL_MOD_STRIP=1 INSTALL_MOD_PATH=$tmpdir modules_install" or
1673
	dodie "Failed to install modules";
1674

1675
    my $modlib = "/lib/modules/$version";
1676
    my $modtar = "ktest-mods.tar.bz2";
1677

1678
    run_ssh "rm -rf $modlib" or
1679
	dodie "failed to remove old mods: $modlib";
1680

1681
    # would be nice if scp -r did not follow symbolic links
1682
    run_command "cd $tmpdir && tar -cjf $modtar lib/modules/$version" or
1683 1684
	dodie "making tarball";

1685
    run_scp_mod "$tmpdir/$modtar", "/tmp" or
1686 1687
	dodie "failed to copy modules";

1688
    unlink "$tmpdir/$modtar";
1689

1690
    run_ssh "'(cd / && tar xjf /tmp/$modtar)'" or
1691
	dodie "failed to tar modules";
S
Steven Rostedt 已提交
1692

1693
    run_ssh "rm -f /tmp/$modtar";
1694

1695
    do_post_install;
S
Steven Rostedt 已提交
1696 1697
}

1698 1699 1700 1701 1702 1703 1704 1705 1706
sub get_version {
    # get the release name
    doprint "$make kernelrelease ... ";
    $version = `$make kernelrelease | tail -1`;
    chomp($version);
    doprint "$version\n";
}

sub start_monitor_and_boot {
1707 1708 1709 1710 1711
    # Make sure the stable kernel has finished booting
    start_monitor;
    wait_for_monitor 5;
    end_monitor;

1712 1713 1714 1715 1716 1717 1718 1719
    get_grub_index;
    get_version;
    install;

    start_monitor;
    return monitor;
}

S
Steven Rostedt 已提交
1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739
sub check_buildlog {
    my ($patch) = @_;

    my @files = `git show $patch | diffstat -l`;

    open(IN, "git show $patch |") or
	dodie "failed to show $patch";
    while (<IN>) {
	if (m,^--- a/(.*),) {
	    chomp $1;
	    $files[$#files] = $1;
	}
    }
    close(IN);

    open(IN, $buildlog) or dodie "Can't open $buildlog";
    while (<IN>) {
	if (/^\s*(.*?):.*(warning|error)/) {
	    my $err = $1;
	    foreach my $file (@files) {
1740
		my $fullpath = "$builddir/$file";
S
Steven Rostedt 已提交
1741
		if ($file eq $err || $fullpath eq $err) {
1742
		    fail "$file built with warnings" and return 0;
S
Steven Rostedt 已提交
1743 1744 1745 1746 1747
		}
	    }
	}
    }
    close(IN);
1748 1749

    return 1;
S
Steven Rostedt 已提交
1750 1751
}

1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782
sub apply_min_config {
    my $outconfig = "$output_config.new";

    # Read the config file and remove anything that
    # is in the force_config hash (from minconfig and others)
    # then add the force config back.

    doprint "Applying minimum configurations into $output_config.new\n";

    open (OUT, ">$outconfig") or
	dodie "Can't create $outconfig";

    if (-f $output_config) {
	open (IN, $output_config) or
	    dodie "Failed to open $output_config";
	while (<IN>) {
	    if (/^(# )?(CONFIG_[^\s=]*)/) {
		next if (defined($force_config{$2}));
	    }
	    print OUT;
	}
	close IN;
    }
    foreach my $config (keys %force_config) {
	print OUT "$force_config{$config}\n";
    }
    close OUT;

    run_command "mv $outconfig $output_config";
}

1783 1784
sub make_oldconfig {

1785 1786 1787 1788 1789
    my @force_list = keys %force_config;

    if ($#force_list >= 0) {
	apply_min_config;
    }
1790 1791

    if (!run_command "$make oldnoconfig") {
1792 1793 1794
	# Perhaps oldnoconfig doesn't exist in this version of the kernel
	# try a yes '' | oldconfig
	doprint "oldnoconfig failed, trying yes '' | make oldconfig\n";
1795
	run_command "yes '' | $make oldconfig" or
1796 1797 1798 1799
	    dodie "failed make config oldconfig";
    }
}

1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816
# read a config file and use this to force new configs.
sub load_force_config {
    my ($config) = @_;

    open(IN, $config) or
	dodie "failed to read $config";
    while (<IN>) {
	chomp;
	if (/^(CONFIG[^\s=]*)(\s*=.*)/) {
	    $force_config{$1} = $_;
	} elsif (/^# (CONFIG_\S*) is not set/) {
	    $force_config{$1} = $_;
	}
    }
    close IN;
}

S
Steven Rostedt 已提交
1817 1818
sub build {
    my ($type) = @_;
1819

1820 1821
    unlink $buildlog;

1822 1823 1824 1825
    # Failed builds should not reboot the target
    my $save_no_reboot = $no_reboot;
    $no_reboot = 1;

1826 1827 1828 1829 1830 1831 1832 1833
    if (defined($pre_build)) {
	my $ret = run_command $pre_build;
	if (!$ret && defined($pre_build_die) &&
	    $pre_build_die) {
	    dodie "failed to pre_build\n";
	}
    }

1834
    if ($type =~ /^useconfig:(.*)/) {
1835
	run_command "cp $1 $output_config" or
1836
	    dodie "could not copy $1 to .config";
1837

1838 1839 1840
	$type = "oldconfig";
    }

1841 1842
    # old config can ask questions
    if ($type eq "oldconfig") {
1843
	$type = "oldnoconfig";
1844 1845

	# allow for empty configs
1846
	run_command "touch $output_config";
1847

1848 1849 1850
	if (!$noclean) {
	    run_command "mv $output_config $outputdir/config_temp" or
		dodie "moving .config";
S
Steven Rostedt 已提交
1851

1852
	    run_command "$make mrproper" or dodie "make mrproper";
S
Steven Rostedt 已提交
1853

1854 1855 1856
	    run_command "mv $outputdir/config_temp $output_config" or
		dodie "moving config_temp";
	}
1857 1858

    } elsif (!$noclean) {
1859
	unlink "$output_config";
1860
	run_command "$make mrproper" or
1861 1862
	    dodie "make mrproper";
    }
S
Steven Rostedt 已提交
1863 1864

    # add something to distinguish this build
1865 1866
    open(OUT, "> $outputdir/localversion") or dodie("Can't make localversion file");
    print OUT "$localversion\n";
S
Steven Rostedt 已提交
1867 1868
    close(OUT);

1869
    if (defined($minconfig)) {
1870
	load_force_config($minconfig);
S
Steven Rostedt 已提交
1871 1872
    }

1873 1874
    if ($type ne "oldnoconfig") {
	run_command "$make $type" or
1875 1876
	    dodie "failed make config";
    }
1877 1878
    # Run old config regardless, to enforce min configurations
    make_oldconfig;
S
Steven Rostedt 已提交
1879

1880
    $redirect = "$buildlog";
1881 1882 1883 1884 1885 1886 1887 1888 1889 1890 1891 1892
    my $build_ret = run_command "$make $build_options";
    undef $redirect;

    if (defined($post_build)) {
	my $ret = run_command $post_build;
	if (!$ret && defined($post_build_die) &&
	    $post_build_die) {
	    dodie "failed to post_build\n";
	}
    }

    if (!$build_ret) {
1893
	# bisect may need this to pass
1894 1895 1896 1897
	if ($in_bisect) {
	    $no_reboot = $save_no_reboot;
	    return 0;
	}
1898
	fail "failed build" and return 0;
S
Steven Rostedt 已提交
1899
    }
1900

1901 1902
    $no_reboot = $save_no_reboot;

1903
    return 1;
S
Steven Rostedt 已提交
1904 1905
}

1906
sub halt {
1907
    if (!run_ssh "halt" or defined($power_off)) {
1908 1909 1910 1911 1912
	if (defined($poweroff_after_halt)) {
	    sleep $poweroff_after_halt;
	    run_command "$power_off";
	}
    } else {
1913
	# nope? the zap it!
1914
	run_command "$power_off";
1915 1916 1917
    }
}

1918 1919 1920
sub success {
    my ($i) = @_;

1921 1922
    $successes++;

S
Steven Rostedt 已提交
1923 1924 1925 1926 1927 1928
    my $name = "";

    if (defined($test_name)) {
	$name = " ($test_name)";
    }

1929 1930
    doprint "\n\n*******************************************\n";
    doprint     "*******************************************\n";
S
Steven Rostedt 已提交
1931
    doprint     "KTEST RESULT: TEST $i$name SUCCESS!!!!         **\n";
1932 1933 1934
    doprint     "*******************************************\n";
    doprint     "*******************************************\n";

1935 1936 1937 1938
    if (defined($store_successes)) {
        save_logs "success", $store_successes;
    }

1939
    if ($i != $opt{"NUM_TESTS"} && !do_not_reboot) {
1940
	doprint "Reboot and wait $sleep_time seconds\n";
1941
	reboot_to_good $sleep_time;
1942 1943 1944
    }
}

S
Steven Rostedt 已提交
1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959
sub answer_bisect {
    for (;;) {
	doprint "Pass or fail? [p/f]";
	my $ans = <STDIN>;
	chomp $ans;
	if ($ans eq "p" || $ans eq "P") {
	    return 1;
	} elsif ($ans eq "f" || $ans eq "F") {
	    return 0;
	} else {
	    print "Please answer 'P' or 'F'\n";
	}
    }
}

1960
sub child_run_test {
1961
    my $failed = 0;
1962

1963
    # child should have no power
1964 1965 1966
    $reboot_on_error = 0;
    $poweroff_on_error = 0;
    $die_on_failure = 1;
1967

R
Rabin Vincent 已提交
1968
    $redirect = "$testlog";
1969
    run_command $run_test or $failed = 1;
R
Rabin Vincent 已提交
1970 1971
    undef $redirect;

1972 1973 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987
    exit $failed;
}

my $child_done;

sub child_finished {
    $child_done = 1;
}

sub do_run_test {
    my $child_pid;
    my $child_exit;
    my $line;
    my $full_line;
    my $bug = 0;

1988
    wait_for_monitor 1;
1989

1990
    doprint "run test $run_test\n";
1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002

    $child_done = 0;

    $SIG{CHLD} = qw(child_finished);

    $child_pid = fork;

    child_run_test if (!$child_pid);

    $full_line = "";

    do {
2003
	$line = wait_for_input($monitor_fp, 1);
2004 2005 2006 2007
	if (defined($line)) {

	    # we are not guaranteed to get a full line
	    $full_line .= $line;
2008
	    doprint $line;
2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024

	    if ($full_line =~ /call trace:/i) {
		$bug = 1;
	    }

	    if ($full_line =~ /Kernel panic -/) {
		$bug = 1;
	    }

	    if ($line =~ /\n/) {
		$full_line = "";
	    }
	}
    } while (!$child_done && !$bug);

    if ($bug) {
2025 2026 2027 2028 2029 2030 2031 2032 2033 2034 2035 2036 2037
	my $failure_start = time;
	my $now;
	do {
	    $line = wait_for_input($monitor_fp, 1);
	    if (defined($line)) {
		doprint $line;
	    }
	    $now = time;
	    if ($now - $failure_start >= $stop_after_failure) {
		last;
	    }
	} while (defined($line));

2038 2039 2040 2041 2042 2043 2044 2045
	doprint "Detected kernel crash!\n";
	# kill the child with extreme prejudice
	kill 9, $child_pid;
    }

    waitpid $child_pid, 0;
    $child_exit = $?;

2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082
    if (!$bug && $in_bisect) {
	if (defined($bisect_ret_good)) {
	    if ($child_exit == $bisect_ret_good) {
		return 1;
	    }
	}
	if (defined($bisect_ret_skip)) {
	    if ($child_exit == $bisect_ret_skip) {
		return -1;
	    }
	}
	if (defined($bisect_ret_abort)) {
	    if ($child_exit == $bisect_ret_abort) {
		fail "test abort" and return -2;
	    }
	}
	if (defined($bisect_ret_bad)) {
	    if ($child_exit == $bisect_ret_skip) {
		return 0;
	    }
	}
	if (defined($bisect_ret_default)) {
	    if ($bisect_ret_default eq "good") {
		return 1;
	    } elsif ($bisect_ret_default eq "bad") {
		return 0;
	    } elsif ($bisect_ret_default eq "skip") {
		return -1;
	    } elsif ($bisect_ret_default eq "abort") {
		return -2;
	    } else {
		fail "unknown default action: $bisect_ret_default"
		    and return -2;
	    }
	}
    }

2083
    if ($bug || $child_exit) {
2084 2085
	return 0 if $in_bisect;
	fail "test failed" and return 0;
2086
    }
2087
    return 1;
2088 2089
}

2090 2091 2092 2093 2094 2095 2096 2097 2098 2099 2100 2101 2102 2103 2104 2105 2106 2107 2108
sub run_git_bisect {
    my ($command) = @_;

    doprint "$command ... ";

    my $output = `$command 2>&1`;
    my $ret = $?;

    logit $output;

    if ($ret) {
	doprint "FAILED\n";
	dodie "Failed to git bisect";
    }

    doprint "SUCCESS\n";
    if ($output =~ m/^(Bisecting: .*\(roughly \d+ steps?\))\s+\[([[:xdigit:]]+)\]/) {
	doprint "$1 [$2]\n";
    } elsif ($output =~ m/^([[:xdigit:]]+) is the first bad commit/) {
2109
	$bisect_bad_commit = $1;
2110 2111 2112 2113 2114 2115 2116 2117 2118 2119
	doprint "Found bad commit... $1\n";
	return 0;
    } else {
	# we already logged it, just print it now.
	print $output;
    }

    return 1;
}

S
Steven Rostedt 已提交
2120 2121
sub bisect_reboot {
    doprint "Reboot and sleep $bisect_sleep_time seconds\n";
2122
    reboot_to_good $bisect_sleep_time;
S
Steven Rostedt 已提交
2123 2124 2125
}

# returns 1 on success, 0 on failure, -1 on skip
2126 2127
sub run_bisect_test {
    my ($type, $buildtype) = @_;
2128

2129
    my $failed = 0;
2130 2131 2132 2133
    my $result;
    my $output;
    my $ret;

2134 2135 2136
    $in_bisect = 1;

    build $buildtype or $failed = 1;
2137 2138

    if ($type ne "build") {
S
Steven Rostedt 已提交
2139 2140 2141 2142
	if ($failed && $bisect_skip) {
	    $in_bisect = 0;
	    return -1;
	}
2143
	dodie "Failed on build" if $failed;
2144 2145

	# Now boot the box
2146
	start_monitor_and_boot or $failed = 1;
2147 2148

	if ($type ne "boot") {
S
Steven Rostedt 已提交
2149 2150 2151 2152 2153 2154
	    if ($failed && $bisect_skip) {
		end_monitor;
		bisect_reboot;
		$in_bisect = 0;
		return -1;
	    }
2155
	    dodie "Failed on boot" if $failed;
2156

2157
	    do_run_test or $failed = 1;
2158
	}
2159
	end_monitor;
2160 2161 2162
    }

    if ($failed) {
2163
	$result = 0;
2164
    } else {
2165 2166
	$result = 1;
    }
2167 2168 2169 2170 2171

    # reboot the box to a kernel we can ssh to
    if ($type ne "build") {
	bisect_reboot;
    }
2172 2173 2174 2175 2176 2177 2178 2179 2180 2181 2182 2183
    $in_bisect = 0;

    return $result;
}

sub run_bisect {
    my ($type) = @_;
    my $buildtype = "oldconfig";

    # We should have a minconfig to use?
    if (defined($minconfig)) {
	$buildtype = "useconfig:$minconfig";
2184 2185
    }

2186 2187
    my $ret = run_bisect_test $type, $buildtype;

S
Steven Rostedt 已提交
2188 2189 2190
    if ($bisect_manual) {
	$ret = answer_bisect;
    }
2191

2192 2193
    # Are we looking for where it worked, not failed?
    if ($reverse_bisect) {
2194
	$ret = !$ret;
2195 2196
    }

S
Steven Rostedt 已提交
2197
    if ($ret > 0) {
2198
	return "good";
S
Steven Rostedt 已提交
2199
    } elsif ($ret == 0) {
2200
	return  "bad";
S
Steven Rostedt 已提交
2201 2202 2203
    } elsif ($bisect_skip) {
	doprint "HIT A BAD COMMIT ... SKIPPING\n";
	return "skip";
2204
    }
2205 2206
}

2207 2208 2209 2210 2211 2212 2213
sub update_bisect_replay {
    my $tmp_log = "$tmpdir/ktest_bisect_log";
    run_command "git bisect log > $tmp_log" or
	die "can't create bisect log";
    return $tmp_log;
}

2214 2215 2216 2217 2218
sub bisect {
    my ($i) = @_;

    my $result;

2219 2220 2221
    die "BISECT_GOOD[$i] not defined\n"	if (!defined($bisect_good));
    die "BISECT_BAD[$i] not defined\n"	if (!defined($bisect_bad));
    die "BISECT_TYPE[$i] not defined\n"	if (!defined($bisect_type));
2222

2223 2224 2225 2226 2227 2228
    my $good = $bisect_good;
    my $bad = $bisect_bad;
    my $type = $bisect_type;
    my $start = $bisect_start;
    my $replay = $bisect_replay;
    my $start_files = $bisect_files;
2229 2230 2231 2232 2233 2234

    if (defined($start_files)) {
	$start_files = " -- " . $start_files;
    } else {
	$start_files = "";
    }
2235

2236 2237 2238 2239
    # convert to true sha1's
    $good = get_sha1($good);
    $bad = get_sha1($bad);

2240
    if (defined($bisect_reverse) && $bisect_reverse == 1) {
2241 2242 2243 2244 2245 2246
	doprint "Performing a reverse bisect (bad is good, good is bad!)\n";
	$reverse_bisect = 1;
    } else {
	$reverse_bisect = 0;
    }

2247 2248 2249 2250 2251
    # Can't have a test without having a test to run
    if ($type eq "test" && !defined($run_test)) {
	$type = "boot";
    }

2252 2253 2254
    # Check if a bisect was running
    my $bisect_start_file = "$builddir/.git/BISECT_START";

2255
    my $check = $bisect_check;
2256 2257 2258 2259 2260 2261 2262 2263 2264 2265 2266 2267 2268 2269 2270 2271 2272 2273 2274 2275 2276
    my $do_check = defined($check) && $check ne "0";

    if ( -f $bisect_start_file ) {
	print "Bisect in progress found\n";
	if ($do_check) {
	    print " If you say yes, then no checks of good or bad will be done\n";
	}
	if (defined($replay)) {
	    print "** BISECT_REPLAY is defined in config file **";
	    print " Ignore config option and perform new git bisect log?\n";
	    if (read_ync " (yes, no, or cancel) ") {
		$replay = update_bisect_replay;
		$do_check = 0;
	    }
	} elsif (read_yn "read git log and continue?") {
	    $replay = update_bisect_replay;
	    $do_check = 0;
	}
    }

    if ($do_check) {
2277 2278

	# get current HEAD
2279
	my $head = get_sha1("HEAD");
2280 2281 2282 2283 2284 2285 2286 2287 2288 2289 2290 2291 2292 2293 2294 2295 2296 2297 2298 2299 2300 2301 2302 2303 2304 2305 2306 2307 2308 2309

	if ($check ne "good") {
	    doprint "TESTING BISECT BAD [$bad]\n";
	    run_command "git checkout $bad" or
		die "Failed to checkout $bad";

	    $result = run_bisect $type;

	    if ($result ne "bad") {
		fail "Tested BISECT_BAD [$bad] and it succeeded" and return 0;
	    }
	}

	if ($check ne "bad") {
	    doprint "TESTING BISECT GOOD [$good]\n";
	    run_command "git checkout $good" or
		die "Failed to checkout $good";

	    $result = run_bisect $type;

	    if ($result ne "good") {
		fail "Tested BISECT_GOOD [$good] and it failed" and return 0;
	    }
	}

	# checkout where we started
	run_command "git checkout $head" or
	    die "Failed to checkout $head";
    }

2310
    run_command "git bisect start$start_files" or
2311
	dodie "could not start bisect";
2312 2313

    run_command "git bisect good $good" or
2314
	dodie "could not set bisect good to $good";
2315

2316 2317
    run_git_bisect "git bisect bad $bad" or
	dodie "could not set bisect bad to $bad";
2318

2319 2320 2321
    if (defined($replay)) {
	run_command "git bisect replay $replay" or
	    dodie "failed to run replay";
2322 2323
    }

2324 2325 2326 2327 2328 2329
    if (defined($start)) {
	run_command "git checkout $start" or
	    dodie "failed to checkout $start";
    }

    my $test;
2330 2331
    do {
	$result = run_bisect $type;
2332 2333
	$test = run_git_bisect "git bisect $result";
    } while ($test);
2334 2335 2336 2337 2338 2339 2340

    run_command "git bisect log" or
	dodie "could not capture git bisect log";

    run_command "git bisect reset" or
	dodie "could not reset git bisect";

2341
    doprint "Bad commit was [$bisect_bad_commit]\n";
2342

2343 2344 2345 2346 2347 2348 2349 2350 2351 2352 2353
    success $i;
}

my %config_ignore;
my %config_set;

my %config_list;
my %null_config;

my %dependency;

2354 2355
sub assign_configs {
    my ($hash, $config) = @_;
2356 2357 2358 2359 2360

    open (IN, $config)
	or dodie "Failed to read $config";

    while (<IN>) {
2361
	if (/^((CONFIG\S*)=.*)/) {
2362
	    ${$hash}{$2} = $1;
2363 2364 2365 2366 2367 2368
	}
    }

    close(IN);
}

2369 2370 2371 2372 2373 2374
sub process_config_ignore {
    my ($config) = @_;

    assign_configs \%config_ignore, $config;
}

2375 2376 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 2392 2393 2394 2395 2396 2397 2398 2399 2400 2401 2402 2403 2404 2405 2406 2407 2408 2409 2410 2411 2412 2413 2414 2415 2416 2417 2418 2419 2420 2421 2422 2423 2424 2425 2426 2427 2428 2429 2430 2431 2432
sub read_current_config {
    my ($config_ref) = @_;

    %{$config_ref} = ();
    undef %{$config_ref};

    my @key = keys %{$config_ref};
    if ($#key >= 0) {
	print "did not delete!\n";
	exit;
    }
    open (IN, "$output_config");

    while (<IN>) {
	if (/^(CONFIG\S+)=(.*)/) {
	    ${$config_ref}{$1} = $2;
	}
    }
    close(IN);
}

sub get_dependencies {
    my ($config) = @_;

    my $arr = $dependency{$config};
    if (!defined($arr)) {
	return ();
    }

    my @deps = @{$arr};

    foreach my $dep (@{$arr}) {
	print "ADD DEP $dep\n";
	@deps = (@deps, get_dependencies $dep);
    }

    return @deps;
}

sub create_config {
    my @configs = @_;

    open(OUT, ">$output_config") or dodie "Can not write to $output_config";

    foreach my $config (@configs) {
	print OUT "$config_set{$config}\n";
	my @deps = get_dependencies $config;
	foreach my $dep (@deps) {
	    print OUT "$config_set{$dep}\n";
	}
    }

    foreach my $config (keys %config_ignore) {
	print OUT "$config_ignore{$config}\n";
    }
    close(OUT);

#    exit;
2433
    make_oldconfig;
2434 2435 2436 2437 2438 2439 2440 2441 2442 2443 2444 2445 2446 2447 2448 2449 2450 2451 2452 2453 2454 2455 2456 2457 2458 2459 2460 2461 2462 2463 2464 2465 2466 2467 2468 2469 2470 2471 2472 2473 2474
}

sub compare_configs {
    my (%a, %b) = @_;

    foreach my $item (keys %a) {
	if (!defined($b{$item})) {
	    print "diff $item\n";
	    return 1;
	}
	delete $b{$item};
    }

    my @keys = keys %b;
    if ($#keys) {
	print "diff2 $keys[0]\n";
    }
    return -1 if ($#keys >= 0);

    return 0;
}

sub run_config_bisect_test {
    my ($type) = @_;

    return run_bisect_test $type, "oldconfig";
}

sub process_passed {
    my (%configs) = @_;

    doprint "These configs had no failure: (Enabling them for further compiles)\n";
    # Passed! All these configs are part of a good compile.
    # Add them to the min options.
    foreach my $config (keys %configs) {
	if (defined($config_list{$config})) {
	    doprint " removing $config\n";
	    $config_ignore{$config} = $config_list{$config};
	    delete $config_list{$config};
	}
    }
2475 2476
    doprint "config copied to $outputdir/config_good\n";
    run_command "cp -f $output_config $outputdir/config_good";
2477 2478 2479 2480 2481 2482 2483 2484 2485 2486 2487 2488 2489 2490 2491 2492 2493 2494 2495 2496
}

sub process_failed {
    my ($config) = @_;

    doprint "\n\n***************************************\n";
    doprint "Found bad config: $config\n";
    doprint "***************************************\n\n";
}

sub run_config_bisect {

    my @start_list = keys %config_list;

    if ($#start_list < 0) {
	doprint "No more configs to test!!!\n";
	return -1;
    }

    doprint "***** RUN TEST ***\n";
2497
    my $type = $config_bisect_type;
2498 2499 2500 2501 2502 2503 2504 2505 2506 2507 2508 2509 2510 2511 2512 2513 2514 2515 2516 2517 2518 2519 2520 2521 2522 2523 2524
    my $ret;
    my %current_config;

    my $count = $#start_list + 1;
    doprint "  $count configs to test\n";

    my $half = int($#start_list / 2);

    do {
	my @tophalf = @start_list[0 .. $half];

	create_config @tophalf;
	read_current_config \%current_config;

	$count = $#tophalf + 1;
	doprint "Testing $count configs\n";
	my $found = 0;
	# make sure we test something
	foreach my $config (@tophalf) {
	    if (defined($current_config{$config})) {
		logit " $config\n";
		$found = 1;
	    }
	}
	if (!$found) {
	    # try the other half
	    doprint "Top half produced no set configs, trying bottom half\n";
2525
	    @tophalf = @start_list[$half + 1 .. $#start_list];
2526 2527 2528 2529 2530 2531 2532 2533 2534 2535 2536 2537 2538 2539 2540 2541 2542 2543 2544 2545
	    create_config @tophalf;
	    read_current_config \%current_config;
	    foreach my $config (@tophalf) {
		if (defined($current_config{$config})) {
		    logit " $config\n";
		    $found = 1;
		}
	    }
	    if (!$found) {
		doprint "Failed: Can't make new config with current configs\n";
		foreach my $config (@start_list) {
		    doprint "  CONFIG: $config\n";
		}
		return -1;
	    }
	    $count = $#tophalf + 1;
	    doprint "Testing $count configs\n";
	}

	$ret = run_config_bisect_test $type;
S
Steven Rostedt 已提交
2546 2547 2548
	if ($bisect_manual) {
	    $ret = answer_bisect;
	}
2549 2550 2551 2552 2553 2554 2555
	if ($ret) {
	    process_passed %current_config;
	    return 0;
	}

	doprint "This config had a failure.\n";
	doprint "Removing these configs that were not set in this config:\n";
2556 2557
	doprint "config copied to $outputdir/config_bad\n";
	run_command "cp -f $output_config $outputdir/config_bad";
2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576

	# A config exists in this group that was bad.
	foreach my $config (keys %config_list) {
	    if (!defined($current_config{$config})) {
		doprint " removing $config\n";
		delete $config_list{$config};
	    }
	}

	@start_list = @tophalf;

	if ($#start_list == 0) {
	    process_failed $start_list[0];
	    return 1;
	}

	# remove half the configs we are looking at and see if
	# they are good.
	$half = int($#start_list / 2);
2577
    } while ($#start_list > 0);
2578

S
Steven Rostedt 已提交
2579 2580 2581 2582 2583 2584 2585
    # we found a single config, try it again unless we are running manually

    if ($bisect_manual) {
	process_failed $start_list[0];
	return 1;
    }

2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600
    my @tophalf = @start_list[0 .. 0];

    $ret = run_config_bisect_test $type;
    if ($ret) {
	process_passed %current_config;
	return 0;
    }

    process_failed $start_list[0];
    return 1;
}

sub config_bisect {
    my ($i) = @_;

2601
    my $start_config = $config_bisect;
2602 2603 2604

    my $tmpconfig = "$tmpdir/use_config";

2605 2606 2607 2608
    if (defined($config_bisect_good)) {
	process_config_ignore $config_bisect_good;
    }

2609 2610 2611 2612 2613 2614 2615 2616 2617 2618
    # Make the file with the bad config and the min config
    if (defined($minconfig)) {
	# read the min config for things to ignore
	run_command "cp $minconfig $tmpconfig" or
	    dodie "failed to copy $minconfig to $tmpconfig";
    } else {
	unlink $tmpconfig;
    }

    if (-f $tmpconfig) {
2619
	load_force_config($tmpconfig);
2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638
	process_config_ignore $tmpconfig;
    }

    # now process the start config
    run_command "cp $start_config $output_config" or
	dodie "failed to copy $start_config to $output_config";

    # read directly what we want to check
    my %config_check;
    open (IN, $output_config)
	or dodie "faied to open $output_config";

    while (<IN>) {
	if (/^((CONFIG\S*)=.*)/) {
	    $config_check{$2} = $1;
	}
    }
    close(IN);

2639
    # Now run oldconfig with the minconfig
2640
    make_oldconfig;
2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707

    # check to see what we lost (or gained)
    open (IN, $output_config)
	or dodie "Failed to read $start_config";

    my %removed_configs;
    my %added_configs;

    while (<IN>) {
	if (/^((CONFIG\S*)=.*)/) {
	    # save off all options
	    $config_set{$2} = $1;
	    if (defined($config_check{$2})) {
		if (defined($config_ignore{$2})) {
		    $removed_configs{$2} = $1;
		} else {
		    $config_list{$2} = $1;
		}
	    } elsif (!defined($config_ignore{$2})) {
		$added_configs{$2} = $1;
		$config_list{$2} = $1;
	    }
	}
    }
    close(IN);

    my @confs = keys %removed_configs;
    if ($#confs >= 0) {
	doprint "Configs overridden by default configs and removed from check:\n";
	foreach my $config (@confs) {
	    doprint " $config\n";
	}
    }
    @confs = keys %added_configs;
    if ($#confs >= 0) {
	doprint "Configs appearing in make oldconfig and added:\n";
	foreach my $config (@confs) {
	    doprint " $config\n";
	}
    }

    my %config_test;
    my $once = 0;

    # Sometimes kconfig does weird things. We must make sure
    # that the config we autocreate has everything we need
    # to test, otherwise we may miss testing configs, or
    # may not be able to create a new config.
    # Here we create a config with everything set.
    create_config (keys %config_list);
    read_current_config \%config_test;
    foreach my $config (keys %config_list) {
	if (!defined($config_test{$config})) {
	    if (!$once) {
		$once = 1;
		doprint "Configs not produced by kconfig (will not be checked):\n";
	    }
	    doprint "  $config\n";
	    delete $config_list{$config};
	}
    }
    my $ret;
    do {
	$ret = run_config_bisect;
    } while (!$ret);

    return $ret if ($ret < 0);
2708 2709 2710 2711

    success $i;
}

2712 2713
sub patchcheck_reboot {
    doprint "Reboot and sleep $patchcheck_sleep_time seconds\n";
2714
    reboot_to_good $patchcheck_sleep_time;
2715 2716
}

S
Steven Rostedt 已提交
2717 2718 2719 2720
sub patchcheck {
    my ($i) = @_;

    die "PATCHCHECK_START[$i] not defined\n"
2721
	if (!defined($patchcheck_start));
S
Steven Rostedt 已提交
2722
    die "PATCHCHECK_TYPE[$i] not defined\n"
2723
	if (!defined($patchcheck_type));
S
Steven Rostedt 已提交
2724

2725
    my $start = $patchcheck_start;
S
Steven Rostedt 已提交
2726 2727

    my $end = "HEAD";
2728 2729
    if (defined($patchcheck_end)) {
	$end = $patchcheck_end;
S
Steven Rostedt 已提交
2730 2731
    }

2732 2733 2734 2735
    # Get the true sha1's since we can use things like HEAD~3
    $start = get_sha1($start);
    $end = get_sha1($end);

2736
    my $type = $patchcheck_type;
S
Steven Rostedt 已提交
2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755

    # Can't have a test without having a test to run
    if ($type eq "test" && !defined($run_test)) {
	$type = "boot";
    }

    open (IN, "git log --pretty=oneline $end|") or
	dodie "could not get git list";

    my @list;

    while (<IN>) {
	chomp;
	$list[$#list+1] = $_;
	last if (/^$start/);
    }
    close(IN);

    if ($list[$#list] !~ /^$start/) {
2756
	fail "SHA1 $start not found";
S
Steven Rostedt 已提交
2757 2758 2759 2760 2761 2762
    }

    # go backwards in the list
    @list = reverse @list;

    my $save_clean = $noclean;
2763 2764 2765 2766 2767 2768 2769
    my %ignored_warnings;

    if (defined($ignore_warnings)) {
	foreach my $sha1 (split /\s+/, $ignore_warnings) {
	    $ignored_warnings{$sha1} = 1;
	}
    }
S
Steven Rostedt 已提交
2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789

    $in_patchcheck = 1;
    foreach my $item (@list) {
	my $sha1 = $item;
	$sha1 =~ s/^([[:xdigit:]]+).*/$1/;

	doprint "\nProcessing commit $item\n\n";

	run_command "git checkout $sha1" or
	    die "Failed to checkout $sha1";

	# only clean on the first and last patch
	if ($item eq $list[0] ||
	    $item eq $list[$#list]) {
	    $noclean = $save_clean;
	} else {
	    $noclean = 1;
	}

	if (defined($minconfig)) {
2790
	    build "useconfig:$minconfig" or return 0;
S
Steven Rostedt 已提交
2791 2792
	} else {
	    # ?? no config to use?
2793
	    build "oldconfig" or return 0;
S
Steven Rostedt 已提交
2794 2795
	}

2796 2797 2798 2799

	if (!defined($ignored_warnings{$sha1})) {
	    check_buildlog $sha1 or return 0;
	}
S
Steven Rostedt 已提交
2800 2801 2802

	next if ($type eq "build");

2803 2804
	my $failed = 0;

2805
	start_monitor_and_boot or $failed = 1;
2806 2807 2808 2809 2810 2811 2812

	if (!$failed && $type ne "boot"){
	    do_run_test or $failed = 1;
	}
	end_monitor;
	return 0 if ($failed);

2813 2814
	patchcheck_reboot;

S
Steven Rostedt 已提交
2815 2816 2817
    }
    $in_patchcheck = 0;
    success $i;
2818 2819

    return 1;
S
Steven Rostedt 已提交
2820 2821
}

2822
my %depends;
2823
my %depcount;
2824 2825 2826 2827 2828 2829
my $iflevel = 0;
my @ifdeps;

# prevent recursion
my %read_kconfigs;

2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847
sub add_dep {
    # $config depends on $dep
    my ($config, $dep) = @_;

    if (defined($depends{$config})) {
	$depends{$config} .= " " . $dep;
    } else {
	$depends{$config} = $dep;
    }

    # record the number of configs depending on $dep
    if (defined $depcount{$dep}) {
	$depcount{$dep}++;
    } else {
	$depcount{$dep} = 1;
    } 
}

2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 2860 2861 2862 2863 2864 2865 2866 2867 2868 2869 2870 2871 2872 2873 2874 2875 2876 2877 2878 2879 2880 2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893
# taken from streamline_config.pl
sub read_kconfig {
    my ($kconfig) = @_;

    my $state = "NONE";
    my $config;
    my @kconfigs;

    my $cont = 0;
    my $line;


    if (! -f $kconfig) {
	doprint "file $kconfig does not exist, skipping\n";
	return;
    }

    open(KIN, "$kconfig")
	or die "Can't open $kconfig";
    while (<KIN>) {
	chomp;

	# Make sure that lines ending with \ continue
	if ($cont) {
	    $_ = $line . " " . $_;
	}

	if (s/\\$//) {
	    $cont = 1;
	    $line = $_;
	    next;
	}

	$cont = 0;

	# collect any Kconfig sources
	if (/^source\s*"(.*)"/) {
	    $kconfigs[$#kconfigs+1] = $1;
	}

	# configs found
	if (/^\s*(menu)?config\s+(\S+)\s*$/) {
	    $state = "NEW";
	    $config = $2;

	    for (my $i = 0; $i < $iflevel; $i++) {
2894
		add_dep $config, $ifdeps[$i];
2895 2896 2897 2898 2899
	    }

	# collect the depends for the config
	} elsif ($state eq "NEW" && /^\s*depends\s+on\s+(.*)$/) {

2900
	    add_dep $config, $1;
2901 2902

	# Get the configs that select this config
2903 2904 2905 2906
	} elsif ($state eq "NEW" && /^\s*select\s+(\S+)/) {

	    # selected by depends on config
	    add_dep $1, $config;
2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 2921 2922 2923 2924 2925 2926 2927 2928 2929 2930 2931 2932 2933 2934 2935 2936 2937 2938 2939 2940 2941 2942 2943 2944 2945 2946 2947 2948 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982

	# Check for if statements
	} elsif (/^if\s+(.*\S)\s*$/) {
	    my $deps = $1;
	    # remove beginning and ending non text
	    $deps =~ s/^[^a-zA-Z0-9_]*//;
	    $deps =~ s/[^a-zA-Z0-9_]*$//;

	    my @deps = split /[^a-zA-Z0-9_]+/, $deps;

	    $ifdeps[$iflevel++] = join ':', @deps;

	} elsif (/^endif/) {

	    $iflevel-- if ($iflevel);

	# stop on "help"
	} elsif (/^\s*help\s*$/) {
	    $state = "NONE";
	}
    }
    close(KIN);

    # read in any configs that were found.
    foreach $kconfig (@kconfigs) {
	if (!defined($read_kconfigs{$kconfig})) {
	    $read_kconfigs{$kconfig} = 1;
	    read_kconfig("$builddir/$kconfig");
	}
    }
}

sub read_depends {
    # find out which arch this is by the kconfig file
    open (IN, $output_config)
	or dodie "Failed to read $output_config";
    my $arch;
    while (<IN>) {
	if (m,Linux/(\S+)\s+\S+\s+Kernel Configuration,) {
	    $arch = $1;
	    last;
	}
    }
    close IN;

    if (!defined($arch)) {
	doprint "Could not find arch from config file\n";
	doprint "no dependencies used\n";
	return;
    }

    # arch is really the subarch, we need to know
    # what directory to look at.
    if ($arch eq "i386" || $arch eq "x86_64") {
	$arch = "x86";
    } elsif ($arch =~ /^tile/) {
	$arch = "tile";
    }

    my $kconfig = "$builddir/arch/$arch/Kconfig";

    if (! -f $kconfig && $arch =~ /\d$/) {
	my $orig = $arch;
 	# some subarchs have numbers, truncate them
	$arch =~ s/\d*$//;
	$kconfig = "$builddir/arch/$arch/Kconfig";
	if (! -f $kconfig) {
	    doprint "No idea what arch dir $orig is for\n";
	    doprint "no dependencies used\n";
	    return;
	}
    }

    read_kconfig($kconfig);
}

2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 3011 3012 3013 3014 3015 3016 3017
sub read_config_list {
    my ($config) = @_;

    open (IN, $config)
	or dodie "Failed to read $config";

    while (<IN>) {
	if (/^((CONFIG\S*)=.*)/) {
	    if (!defined($config_ignore{$2})) {
		$config_list{$2} = $1;
	    }
	}
    }

    close(IN);
}

sub read_output_config {
    my ($config) = @_;

    assign_configs \%config_ignore, $config;
}

sub make_new_config {
    my @configs = @_;

    open (OUT, ">$output_config")
	or dodie "Failed to write $output_config";

    foreach my $config (@configs) {
	print OUT "$config\n";
    }
    close OUT;
}

3018 3019 3020 3021 3022 3023 3024 3025
sub chomp_config {
    my ($config) = @_;

    $config =~ s/CONFIG_//;

    return $config;
}

3026 3027 3028
sub get_depends {
    my ($dep) = @_;

3029
    my $kconfig = chomp_config $dep;
3030 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 3050 3051 3052 3053 3054 3055 3056 3057 3058

    $dep = $depends{"$kconfig"};

    # the dep string we have saves the dependencies as they
    # were found, including expressions like ! && ||. We
    # want to split this out into just an array of configs.

    my $valid = "A-Za-z_0-9";

    my @configs;

    while ($dep =~ /[$valid]/) {

	if ($dep =~ /^[^$valid]*([$valid]+)/) {
	    my $conf = "CONFIG_" . $1;

	    $configs[$#configs + 1] = $conf;

	    $dep =~ s/^[^$valid]*[$valid]+//;
	} else {
	    die "this should never happen";
	}
    }

    return @configs;
}

my %min_configs;
my %keep_configs;
3059
my %save_configs;
3060 3061 3062 3063 3064 3065 3066 3067 3068 3069 3070 3071 3072 3073 3074 3075 3076 3077 3078
my %processed_configs;
my %nochange_config;

sub test_this_config {
    my ($config) = @_;

    my $found;

    # if we already processed this config, skip it
    if (defined($processed_configs{$config})) {
	return undef;
    }
    $processed_configs{$config} = 1;

    # if this config failed during this round, skip it
    if (defined($nochange_config{$config})) {
	return undef;
    }

3079
    my $kconfig = chomp_config $config;
3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113

    # Test dependencies first
    if (defined($depends{"$kconfig"})) {
	my @parents = get_depends $config;
	foreach my $parent (@parents) {
	    # if the parent is in the min config, check it first
	    next if (!defined($min_configs{$parent}));
	    $found = test_this_config($parent);
	    if (defined($found)) {
		return $found;
	    }
	}
    }

    # Remove this config from the list of configs
    # do a make oldnoconfig and then read the resulting
    # .config to make sure it is missing the config that
    # we had before
    my %configs = %min_configs;
    delete $configs{$config};
    make_new_config ((values %configs), (values %keep_configs));
    make_oldconfig;
    undef %configs;
    assign_configs \%configs, $output_config;

    return $config if (!defined($configs{$config}));

    doprint "disabling config $config did not change .config\n";

    $nochange_config{$config} = 1;

    return undef;
}

3114 3115 3116 3117 3118 3119
sub make_min_config {
    my ($i) = @_;

    if (!defined($output_minconfig)) {
	fail "OUTPUT_MIN_CONFIG not defined" and return;
    }
3120 3121 3122 3123 3124 3125 3126 3127 3128 3129 3130

    # If output_minconfig exists, and the start_minconfig
    # came from min_config, than ask if we should use
    # that instead.
    if (-f $output_minconfig && !$start_minconfig_defined) {
	print "$output_minconfig exists\n";
	if (read_yn " Use it as minconfig?") {
	    $start_minconfig = $output_minconfig;
	}
    }

3131 3132 3133 3134
    if (!defined($start_minconfig)) {
	fail "START_MIN_CONFIG or MIN_CONFIG not defined" and return;
    }

3135 3136
    my $temp_config = "$tmpdir/temp_config";

3137 3138 3139 3140 3141 3142 3143 3144 3145
    # First things first. We build an allnoconfig to find
    # out what the defaults are that we can't touch.
    # Some are selections, but we really can't handle selections.

    my $save_minconfig = $minconfig;
    undef $minconfig;

    run_command "$make allnoconfig" or return 0;

3146 3147
    read_depends;

3148
    process_config_ignore $output_config;
3149

3150
    undef %save_configs;
3151
    undef %min_configs;
3152 3153 3154 3155

    if (defined($ignore_config)) {
	# make sure the file exists
	`touch $ignore_config`;
3156
	assign_configs \%save_configs, $ignore_config;
3157 3158
    }

3159 3160
    %keep_configs = %save_configs;

3161 3162 3163 3164 3165 3166 3167 3168
    doprint "Load initial configs from $start_minconfig\n";

    # Look at the current min configs, and save off all the
    # ones that were set via the allnoconfig
    assign_configs \%min_configs, $start_minconfig;

    my @config_keys = keys %min_configs;

3169 3170 3171 3172 3173 3174 3175 3176
    # All configs need a depcount
    foreach my $config (@config_keys) {
	my $kconfig = chomp_config $config;
	if (!defined $depcount{$kconfig}) {
		$depcount{$kconfig} = 0;
	}
    }

3177 3178 3179 3180 3181 3182 3183 3184 3185 3186 3187 3188 3189 3190 3191 3192 3193 3194 3195 3196 3197 3198 3199 3200 3201 3202 3203 3204
    # Remove anything that was set by the make allnoconfig
    # we shouldn't need them as they get set for us anyway.
    foreach my $config (@config_keys) {
	# Remove anything in the ignore_config
	if (defined($keep_configs{$config})) {
	    my $file = $ignore_config;
	    $file =~ s,.*/(.*?)$,$1,;
	    doprint "$config set by $file ... ignored\n";
	    delete $min_configs{$config};
	    next;
	}
	# But make sure the settings are the same. If a min config
	# sets a selection, we do not want to get rid of it if
	# it is not the same as what we have. Just move it into
	# the keep configs.
	if (defined($config_ignore{$config})) {
	    if ($config_ignore{$config} ne $min_configs{$config}) {
		doprint "$config is in allnoconfig as '$config_ignore{$config}'";
		doprint " but it is '$min_configs{$config}' in minconfig .. keeping\n";
		$keep_configs{$config} = $min_configs{$config};
	    } else {
		doprint "$config set by allnoconfig ... ignored\n";
	    }
	    delete $min_configs{$config};
	}
    }

    my $done = 0;
3205
    my $take_two = 0;
3206 3207 3208 3209 3210 3211 3212 3213 3214 3215

    while (!$done) {

	my $config;
	my $found;

	# Now disable each config one by one and do a make oldconfig
	# till we find a config that changes our list.

	my @test_configs = keys %min_configs;
3216 3217 3218 3219 3220 3221

	# Sort keys by who is most dependent on
	@test_configs = sort  { $depcount{chomp_config($b)} <=> $depcount{chomp_config($a)} }
			  @test_configs ;

	# Put configs that did not modify the config at the end.
3222 3223 3224 3225 3226 3227 3228 3229 3230 3231 3232 3233 3234 3235 3236 3237 3238 3239
	my $reset = 1;
	for (my $i = 0; $i < $#test_configs; $i++) {
	    if (!defined($nochange_config{$test_configs[0]})) {
		$reset = 0;
		last;
	    }
	    # This config didn't change the .config last time.
	    # Place it at the end
	    my $config = shift @test_configs;
	    push @test_configs, $config;
	}

	# if every test config has failed to modify the .config file
	# in the past, then reset and start over.
	if ($reset) {
	    undef %nochange_config;
	}

3240 3241
	undef %processed_configs;

3242 3243
	foreach my $config (@test_configs) {

3244
	    $found = test_this_config $config;
3245

3246
	    last if (defined($found));
3247 3248 3249 3250 3251

	    # oh well, try another config
	}

	if (!defined($found)) {
3252 3253 3254 3255 3256 3257 3258
	    # we could have failed due to the nochange_config hash
	    # reset and try again
	    if (!$take_two) {
		undef %nochange_config;
		$take_two = 1;
		next;
	    }
3259 3260 3261 3262
	    doprint "No more configs found that we can disable\n";
	    $done = 1;
	    last;
	}
3263
	$take_two = 0;
3264 3265 3266 3267 3268 3269 3270 3271 3272

	$config = $found;

	doprint "Test with $config disabled\n";

	# set in_bisect to keep build and monitor from dieing
	$in_bisect = 1;

	my $failed = 0;
3273 3274 3275 3276 3277
	build "oldconfig" or $failed = 1;
	if (!$failed) {
		start_monitor_and_boot or $failed = 1;
		end_monitor;
	}
3278 3279 3280 3281

	$in_bisect = 0;

	if ($failed) {
3282
	    doprint "$min_configs{$config} is needed to boot the box... keeping\n";
3283 3284
	    # this config is needed, add it to the ignore list.
	    $keep_configs{$config} = $min_configs{$config};
3285
	    $save_configs{$config} = $min_configs{$config};
3286
	    delete $min_configs{$config};
3287 3288 3289 3290 3291

	    # update new ignore configs
	    if (defined($ignore_config)) {
		open (OUT, ">$temp_config")
		    or die "Can't write to $temp_config";
3292 3293
		foreach my $config (keys %save_configs) {
		    print OUT "$save_configs{$config}\n";
3294 3295 3296 3297 3298 3299
		}
		close OUT;
		run_command "mv $temp_config $ignore_config" or
		    dodie "failed to copy update to $ignore_config";
	    }

3300 3301 3302 3303 3304 3305 3306 3307 3308 3309 3310 3311 3312 3313 3314 3315 3316 3317
	} else {
	    # We booted without this config, remove it from the minconfigs.
	    doprint "$config is not needed, disabling\n";

	    delete $min_configs{$config};

	    # Also disable anything that is not enabled in this config
	    my %configs;
	    assign_configs \%configs, $output_config;
	    my @config_keys = keys %min_configs;
	    foreach my $config (@config_keys) {
		if (!defined($configs{$config})) {
		    doprint "$config is not set, disabling\n";
		    delete $min_configs{$config};
		}
	    }

	    # Save off all the current mandidory configs
3318 3319
	    open (OUT, ">$temp_config")
		or die "Can't write to $temp_config";
3320 3321 3322 3323 3324 3325 3326
	    foreach my $config (keys %keep_configs) {
		print OUT "$keep_configs{$config}\n";
	    }
	    foreach my $config (keys %min_configs) {
		print OUT "$min_configs{$config}\n";
	    }
	    close OUT;
3327 3328 3329

	    run_command "mv $temp_config $output_minconfig" or
		dodie "failed to copy update to $output_minconfig";
3330 3331 3332
	}

	doprint "Reboot and wait $sleep_time seconds\n";
3333
	reboot_to_good $sleep_time;
3334 3335 3336 3337 3338 3339
    }

    success $i;
    return 1;
}

3340 3341 3342 3343 3344 3345
$#ARGV < 1 or die "ktest.pl version: $VERSION\n   usage: ktest.pl config-file\n";

if ($#ARGV == 0) {
    $ktest_config = $ARGV[0];
    if (! -f $ktest_config) {
	print "$ktest_config does not exist.\n";
3346
	if (!read_yn "Create it?") {
3347 3348 3349 3350 3351 3352 3353 3354
	    exit 0;
	}
    }
} else {
    $ktest_config = "ktest.conf";
}

if (! -f $ktest_config) {
3355
    $newconfig = 1;
3356
    get_test_case;
3357 3358 3359 3360
    open(OUT, ">$ktest_config") or die "Can not create $ktest_config";
    print OUT << "EOF"
# Generated by ktest.pl
#
3361 3362 3363 3364 3365 3366 3367 3368 3369 3370 3371

# PWD is a ktest.pl variable that will result in the process working
# directory that ktest.pl is executed in.

# THIS_DIR is automatically assigned the PWD of the path that generated
# the config file. It is best to use this variable when assigning other
# directory paths within this directory. This allows you to easily
# move the test cases to other locations or to other machines.
#
THIS_DIR := $variable{"PWD"}

3372 3373 3374
# Define each test with TEST_START
# The config options below it will override the defaults
TEST_START
3375
TEST_TYPE = $default{"TEST_TYPE"}
3376 3377 3378 3379 3380 3381 3382 3383

DEFAULTS
EOF
;
    close(OUT);
}
read_config $ktest_config;

3384 3385 3386 3387
if (defined($opt{"LOG_FILE"})) {
    $opt{"LOG_FILE"} = eval_option($opt{"LOG_FILE"}, -1);
}

3388 3389 3390 3391 3392 3393 3394
# Append any configs entered in manually to the config file.
my @new_configs = keys %entered_configs;
if ($#new_configs >= 0) {
    print "\nAppending entered in configs to $ktest_config\n";
    open(OUT, ">>$ktest_config") or die "Can not append to $ktest_config";
    foreach my $config (@new_configs) {
	print OUT "$config = $entered_configs{$config}\n";
3395
	$opt{$config} = process_variables($entered_configs{$config});
3396 3397
    }
}
S
Steven Rostedt 已提交
3398

3399 3400 3401
if ($opt{"CLEAR_LOG"} && defined($opt{"LOG_FILE"})) {
    unlink $opt{"LOG_FILE"};
}
S
Steven Rostedt 已提交
3402

3403 3404
doprint "\n\nSTARTING AUTOMATED TESTS\n\n";

3405 3406 3407 3408 3409 3410 3411 3412 3413 3414 3415 3416 3417 3418 3419 3420 3421 3422 3423 3424 3425 3426 3427
for (my $i = 0, my $repeat = 1; $i <= $opt{"NUM_TESTS"}; $i += $repeat) {

    if (!$i) {
	doprint "DEFAULT OPTIONS:\n";
    } else {
	doprint "\nTEST $i OPTIONS";
	if (defined($repeat_tests{$i})) {
	    $repeat = $repeat_tests{$i};
	    doprint " ITERATE $repeat";
	}
	doprint "\n";
    }

    foreach my $option (sort keys %opt) {

	if ($option =~ /\[(\d+)\]$/) {
	    next if ($i != $1);
	} else {
	    next if ($i);
	}

	doprint "$option = $opt{$option}\n";
    }
3428
}
S
Steven Rostedt 已提交
3429

3430
sub __set_test_option {
3431
    my ($name, $i) = @_;
S
Steven Rostedt 已提交
3432

3433
    my $option = "$name\[$i\]";
3434

3435 3436
    if (defined($opt{$option})) {
	return $opt{$option};
3437 3438
    }

3439 3440 3441 3442 3443 3444 3445 3446 3447 3448
    foreach my $test (keys %repeat_tests) {
	if ($i >= $test &&
	    $i < $test + $repeat_tests{$test}) {
	    $option = "$name\[$test\]";
	    if (defined($opt{$option})) {
		return $opt{$option};
	    }
	}
    }

3449 3450
    if (defined($opt{$name})) {
	return $opt{$name};
S
Steven Rostedt 已提交
3451 3452
    }

3453 3454 3455
    return undef;
}

3456 3457 3458 3459 3460 3461
sub set_test_option {
    my ($name, $i) = @_;

    my $option = __set_test_option($name, $i);
    return $option if (!defined($option));

3462
    return eval_option($option, $i);
3463 3464
}

3465
# First we need to do is the builds
3466 3467
for (my $i = 1; $i <= $opt{"NUM_TESTS"}; $i++) {

3468 3469 3470
    # Do not reboot on failing test options
    $no_reboot = 1;

3471 3472
    $iteration = $i;

3473 3474
    my $makecmd = set_test_option("MAKE_CMD", $i);

3475 3476 3477 3478
    # Load all the options into their mapped variable names
    foreach my $opt (keys %option_map) {
	${$option_map{$opt}} = set_test_option($opt, $i);
    }
3479

3480 3481
    $start_minconfig_defined = 1;

3482
    if (!defined($start_minconfig)) {
3483
	$start_minconfig_defined = 0;
3484 3485 3486
	$start_minconfig = $minconfig;
    }

3487 3488
    chdir $builddir || die "can't change directory to $builddir";

3489 3490 3491 3492 3493
    foreach my $dir ($tmpdir, $outputdir) {
	if (!-d $dir) {
	    mkpath($dir) or
		die "can't create $dir";
	}
3494
    }
S
Steven Rostedt 已提交
3495

3496 3497 3498
    $ENV{"SSH_USER"} = $ssh_user;
    $ENV{"MACHINE"} = $machine;

3499
    $buildlog = "$tmpdir/buildlog-$machine";
R
Rabin Vincent 已提交
3500
    $testlog = "$tmpdir/testlog-$machine";
3501 3502
    $dmesg = "$tmpdir/dmesg-$machine";
    $make = "$makecmd O=$outputdir";
3503
    $output_config = "$outputdir/.config";
3504

3505 3506 3507 3508 3509
    if (!$buildonly) {
	$target = "$ssh_user\@$machine";
	if ($reboot_type eq "grub") {
	    dodie "GRUB_MENU not defined" if (!defined($grub_menu));
	}
3510 3511 3512 3513
    }

    my $run_type = $build_type;
    if ($test_type eq "patchcheck") {
3514
	$run_type = $patchcheck_type;
3515
    } elsif ($test_type eq "bisect") {
3516
	$run_type = $bisect_type;
3517
    } elsif ($test_type eq "config_bisect") {
3518
	$run_type = $config_bisect_type;
3519 3520
    }

3521 3522 3523 3524
    if ($test_type eq "make_min_config") {
	$run_type = "";
    }

3525 3526 3527 3528
    # mistake in config file?
    if (!defined($run_type)) {
	$run_type = "ERROR";
    }
3529

3530 3531 3532
    my $installme = "";
    $installme = " no_install" if ($no_install);

S
Steven Rostedt 已提交
3533
    doprint "\n\n";
3534
    doprint "RUNNING TEST $i of $opt{NUM_TESTS} with option $test_type $run_type$installme\n\n";
3535 3536 3537

    unlink $dmesg;
    unlink $buildlog;
R
Rabin Vincent 已提交
3538
    unlink $testlog;
S
Steven Rostedt 已提交
3539

3540 3541 3542 3543 3544 3545
    if (defined($addconfig)) {
	my $min = $minconfig;
	if (!defined($minconfig)) {
	    $min = "";
	}
	run_command "cat $addconfig $min > $tmpdir/add_config" or
3546
	    dodie "Failed to create temp config";
3547
	$minconfig = "$tmpdir/add_config";
3548 3549
    }

S
Steven Rostedt 已提交
3550 3551 3552 3553 3554
    if (defined($checkout)) {
	run_command "git checkout $checkout" or
	    die "failed to checkout $checkout";
    }

3555 3556 3557
    $no_reboot = 0;


3558
    if ($test_type eq "bisect") {
3559 3560
	bisect $i;
	next;
3561 3562 3563
    } elsif ($test_type eq "config_bisect") {
	config_bisect $i;
	next;
3564
    } elsif ($test_type eq "patchcheck") {
S
Steven Rostedt 已提交
3565 3566
	patchcheck $i;
	next;
3567 3568 3569
    } elsif ($test_type eq "make_min_config") {
	make_min_config $i;
	next;
S
Steven Rostedt 已提交
3570 3571
    }

3572 3573
    if ($build_type ne "nobuild") {
	build $build_type or next;
S
Steven Rostedt 已提交
3574 3575
    }

3576 3577 3578 3579 3580 3581 3582
    if ($test_type eq "install") {
	get_version;
	install;
	success $i;
	next;
    }

3583 3584
    if ($test_type ne "build") {
	my $failed = 0;
3585
	start_monitor_and_boot or $failed = 1;
3586 3587 3588 3589 3590 3591

	if (!$failed && $test_type ne "boot" && defined($run_test)) {
	    do_run_test or $failed = 1;
	}
	end_monitor;
	next if ($failed);
3592 3593
    }

3594
    success $i;
S
Steven Rostedt 已提交
3595 3596
}

3597
if ($opt{"POWEROFF_ON_SUCCESS"}) {
3598
    halt;
3599
} elsif ($opt{"REBOOT_ON_SUCCESS"} && !do_not_reboot) {
3600
    reboot_to_good;
3601
}
3602

3603 3604
doprint "\n    $successes of $opt{NUM_TESTS} tests were successful\n\n";

S
Steven Rostedt 已提交
3605
exit 0;