tools/testing/ktest/ktest.pl

   1 #!/usr/bin/perl -w
   2 #
   3 # Copyright 2010 - Steven Rostedt <srostedt@redhat.com>, Red Hat Inc.
   4 # Licensed under the terms of the GNU GPL License version 2
   5 #
   6
   7 use strict;
   8 use IPC::Open2;
   9 use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
  10 use File::Path qw(mkpath);
  11 use File::Copy qw(cp);
  12 use FileHandle;
  13
  14 my $VERSION = "0.2";
  15
  16 $| = 1;
  17
  18 my %opt;
  19 my %repeat_tests;
  20 my %repeats;
  21 my %default;
  22
  23 #default opts
  24 $default{"NUM_TESTS"}           = 1;
  25 $default{"REBOOT_TYPE"}         = "grub";
  26 $default{"TEST_TYPE"}           = "test";
  27 $default{"BUILD_TYPE"}          = "randconfig";
  28 $default{"MAKE_CMD"}            = "make";
  29 $default{"TIMEOUT"}             = 120;
  30 $default{"TMP_DIR"}             = "/tmp/ktest";
  31 $default{"SLEEP_TIME"}          = 60;   # sleep time between tests
  32 $default{"BUILD_NOCLEAN"}       = 0;
  33 $default{"REBOOT_ON_ERROR"}     = 0;
  34 $default{"POWEROFF_ON_ERROR"}   = 0;
  35 $default{"REBOOT_ON_SUCCESS"}   = 1;
  36 $default{"POWEROFF_ON_SUCCESS"} = 0;
  37 $default{"BUILD_OPTIONS"}       = "";
  38 $default{"BISECT_SLEEP_TIME"}   = 60;   # sleep time between bisects
  39 $default{"PATCHCHECK_SLEEP_TIME"} = 60; # sleep time between patch checks
  40 $default{"CLEAR_LOG"}           = 0;
  41 $default{"BISECT_MANUAL"}       = 0;
  42 $default{"BISECT_SKIP"}         = 1;
  43 $default{"SUCCESS_LINE"}        = "login:";
  44 $default{"DETECT_TRIPLE_FAULT"} = 1;
  45 $default{"BOOTED_TIMEOUT"}      = 1;
  46 $default{"DIE_ON_FAILURE"}      = 1;
  47 $default{"SSH_EXEC"}            = "ssh \$SSH_USER\@\$MACHINE \$SSH_COMMAND";
  48 $default{"SCP_TO_TARGET"}       = "scp \$SRC_FILE \$SSH_USER\@\$MACHINE:\$DST_FILE";
  49 $default{"REBOOT"}              = "ssh \$SSH_USER\@\$MACHINE reboot";
  50 $default{"STOP_AFTER_SUCCESS"}  = 10;
  51 $default{"STOP_AFTER_FAILURE"}  = 60;
  52 $default{"STOP_TEST_AFTER"}     = 600;
  53 $default{"LOCALVERSION"}        = "-test";
  54
  55 my $ktest_config;
  56 my $version;
  57 my $machine;
  58 my $ssh_user;
  59 my $tmpdir;
  60 my $builddir;
  61 my $outputdir;
  62 my $output_config;
  63 my $test_type;
  64 my $build_type;
  65 my $build_options;
  66 my $reboot_type;
  67 my $reboot_script;
  68 my $power_cycle;
  69 my $reboot;
  70 my $reboot_on_error;
  71 my $poweroff_on_error;
  72 my $die_on_failure;
  73 my $powercycle_after_reboot;
  74 my $poweroff_after_halt;
  75 my $ssh_exec;
  76 my $scp_to_target;
  77 my $power_off;
  78 my $grub_menu;
  79 my $grub_number;
  80 my $target;
  81 my $make;
  82 my $post_install;
  83 my $noclean;
  84 my $minconfig;
  85 my $addconfig;
  86 my $in_bisect = 0;
  87 my $bisect_bad = "";
  88 my $reverse_bisect;
  89 my $bisect_manual;
  90 my $bisect_skip;
  91 my $config_bisect_good;
  92 my $in_patchcheck = 0;
  93 my $run_test;
  94 my $redirect;
  95 my $buildlog;
  96 my $dmesg;
  97 my $monitor_fp;
  98 my $monitor_pid;
  99 my $monitor_cnt = 0;
 100 my $sleep_time;
 101 my $bisect_sleep_time;
 102 my $patchcheck_sleep_time;
 103 my $store_failures;
 104 my $timeout;
 105 my $booted_timeout;
 106 my $detect_triplefault;
 107 my $console;
 108 my $success_line;
 109 my $stop_after_success;
 110 my $stop_after_failure;
 111 my $stop_test_after;
 112 my $build_target;
 113 my $target_image;
 114 my $localversion;
 115 my $iteration = 0;
 116 my $successes = 0;
 117
 118 my %entered_configs;
 119 my %config_help;
 120 my %variable;
 121
 122 $config_help{"MACHINE"} = << "EOF"
 123  The machine hostname that you will test.
 124 EOF
 125     ;
 126 $config_help{"SSH_USER"} = << "EOF"
 127  The box is expected to have ssh on normal bootup, provide the user
 128   (most likely root, since you need privileged operations)
 129 EOF
 130     ;
 131 $config_help{"BUILD_DIR"} = << "EOF"
 132  The directory that contains the Linux source code (full path).
 133 EOF
 134     ;
 135 $config_help{"OUTPUT_DIR"} = << "EOF"
 136  The directory that the objects will be built (full path).
 137  (can not be same as BUILD_DIR)
 138 EOF
 139     ;
 140 $config_help{"BUILD_TARGET"} = << "EOF"
 141  The location of the compiled file to copy to the target.
 142  (relative to OUTPUT_DIR)
 143 EOF
 144     ;
 145 $config_help{"TARGET_IMAGE"} = << "EOF"
 146  The place to put your image on the test machine.
 147 EOF
 148     ;
 149 $config_help{"POWER_CYCLE"} = << "EOF"
 150  A script or command to reboot the box.
 151
 152  Here is a digital loggers power switch example
 153  POWER_CYCLE = wget --no-proxy -O /dev/null -q  --auth-no-challenge 'http://admin:admin\@power/outlet?5=CCL'
 154
 155  Here is an example to reboot a virtual box on the current host
 156  with the name "Guest".
 157  POWER_CYCLE = virsh destroy Guest; sleep 5; virsh start Guest
 158 EOF
 159     ;
 160 $config_help{"CONSOLE"} = << "EOF"
 161  The script or command that reads the console
 162
 163   If you use ttywatch server, something like the following would work.
 164 CONSOLE = nc -d localhost 3001
 165
 166  For a virtual machine with guest name "Guest".
 167 CONSOLE =  virsh console Guest
 168 EOF
 169     ;
 170 $config_help{"LOCALVERSION"} = << "EOF"
 171  Required version ending to differentiate the test
 172  from other linux builds on the system.
 173 EOF
 174     ;
 175 $config_help{"REBOOT_TYPE"} = << "EOF"
 176  Way to reboot the box to the test kernel.
 177  Only valid options so far are "grub" and "script".
 178
 179  If you specify grub, it will assume grub version 1
 180  and will search in /boot/grub/menu.lst for the title \$GRUB_MENU
 181  and select that target to reboot to the kernel. If this is not
 182  your setup, then specify "script" and have a command or script
 183  specified in REBOOT_SCRIPT to boot to the target.
 184
 185  The entry in /boot/grub/menu.lst must be entered in manually.
 186  The test will not modify that file.
 187 EOF
 188     ;
 189 $config_help{"GRUB_MENU"} = << "EOF"
 190  The grub title name for the test kernel to boot
 191  (Only mandatory if REBOOT_TYPE = grub)
 192
 193  Note, ktest.pl will not update the grub menu.lst, you need to
 194  manually add an option for the test. ktest.pl will search
 195  the grub menu.lst for this option to find what kernel to
 196  reboot into.
 197
 198  For example, if in the /boot/grub/menu.lst the test kernel title has:
 199  title Test Kernel
 200  kernel vmlinuz-test
 201  GRUB_MENU = Test Kernel
 202 EOF
 203     ;
 204 $config_help{"REBOOT_SCRIPT"} = << "EOF"
 205  A script to reboot the target into the test kernel
 206  (Only mandatory if REBOOT_TYPE = script)
 207 EOF
 208     ;
 209
 210
 211 sub get_ktest_config {
 212     my ($config) = @_;
 213
 214     return if (defined($opt{$config}));
 215
 216     if (defined($config_help{$config})) {
 217         print "\n";
 218         print $config_help{$config};
 219     }
 220
 221     for (;;) {
 222         print "$config = ";
 223         if (defined($default{$config})) {
 224             print "\[$default{$config}\] ";
 225         }
 226         $entered_configs{$config} = <STDIN>;
 227         $entered_configs{$config} =~ s/^\s*(.*\S)\s*$/$1/;
 228         if ($entered_configs{$config} =~ /^\s*$/) {
 229             if ($default{$config}) {
 230                 $entered_configs{$config} = $default{$config};
 231             } else {
 232                 print "Your answer can not be blank\n";
 233                 next;
 234             }
 235         }
 236         last;
 237     }
 238 }
 239
 240 sub get_ktest_configs {
 241     get_ktest_config("MACHINE");
 242     get_ktest_config("SSH_USER");
 243     get_ktest_config("BUILD_DIR");
 244     get_ktest_config("OUTPUT_DIR");
 245     get_ktest_config("BUILD_TARGET");
 246     get_ktest_config("TARGET_IMAGE");
 247     get_ktest_config("POWER_CYCLE");
 248     get_ktest_config("CONSOLE");
 249     get_ktest_config("LOCALVERSION");
 250
 251     my $rtype = $opt{"REBOOT_TYPE"};
 252
 253     if (!defined($rtype)) {
 254         if (!defined($opt{"GRUB_MENU"})) {
 255             get_ktest_config("REBOOT_TYPE");
 256             $rtype = $entered_configs{"REBOOT_TYPE"};
 257         } else {
 258             $rtype = "grub";
 259         }
 260     }
 261
 262     if ($rtype eq "grub") {
 263         get_ktest_config("GRUB_MENU");
 264     } else {
 265         get_ktest_config("REBOOT_SCRIPT");
 266     }
 267 }
 268
 269 sub process_variables {
 270     my ($value) = @_;
 271     my $retval = "";
 272
 273     # We want to check for '\', and it is just easier
 274     # to check the previous characet of '$' and not need
 275     # to worry if '$' is the first character. By adding
 276     # a space to $value, we can just check [^\\]\$ and
 277     # it will still work.
 278     $value = " $value";
 279
 280     while ($value =~ /(.*?[^\\])\$\{(.*?)\}(.*)/) {
 281         my $begin = $1;
 282         my $var = $2;
 283         my $end = $3;
 284         # append beginning of value to retval
 285         $retval = "$retval$begin";
 286         if (defined($variable{$var})) {
 287             $retval = "$retval$variable{$var}";
 288         } else {
 289             # put back the origin piece.
 290             $retval = "$retval\$\{$var\}";
 291         }
 292         $value = $end;
 293     }
 294     $retval = "$retval$value";
 295
 296     # remove the space added in the beginning
 297     $retval =~ s/ //;
 298
 299     return "$retval"
 300 }
 301
 302 sub set_value {
 303     my ($lvalue, $rvalue) = @_;
 304
 305     if (defined($opt{$lvalue})) {
 306         die "Error: Option $lvalue defined more than once!\n";
 307     }
 308     if ($rvalue =~ /^\s*$/) {
 309         delete $opt{$lvalue};
 310     } else {
 311         $rvalue = process_variables($rvalue);
 312         $opt{$lvalue} = $rvalue;
 313     }
 314 }
 315
 316 sub set_variable {
 317     my ($lvalue, $rvalue) = @_;
 318
 319     if ($rvalue =~ /^\s*$/) {
 320         delete $variable{$lvalue};
 321     } else {
 322         $rvalue = process_variables($rvalue);
 323         $variable{$lvalue} = $rvalue;
 324     }
 325 }
 326
 327 sub read_config {
 328     my ($config) = @_;
 329
 330     open(IN, $config) || die "can't read file $config";
 331
 332     my $name = $config;
 333     $name =~ s,.*/(.*),$1,;
 334
 335     my $test_num = 0;
 336     my $default = 1;
 337     my $repeat = 1;
 338     my $num_tests_set = 0;
 339     my $skip = 0;
 340     my $rest;
 341
 342     while (<IN>) {
 343
 344         # ignore blank lines and comments
 345         next if (/^\s*$/ || /\s*\#/);
 346
 347         if (/^\s*TEST_START(.*)/) {
 348
 349             $rest = $1;
 350
 351             if ($num_tests_set) {
 352                 die "$name: $.: Can not specify both NUM_TESTS and TEST_START\n";
 353             }
 354
 355             my $old_test_num = $test_num;
 356             my $old_repeat = $repeat;
 357
 358             $test_num += $repeat;
 359             $default = 0;
 360             $repeat = 1;
 361
 362             if ($rest =~ /\s+SKIP(.*)/) {
 363                 $rest = $1;
 364                 $skip = 1;
 365             } else {
 366                 $skip = 0;
 367             }
 368
 369             if ($rest =~ /\s+ITERATE\s+(\d+)(.*)$/) {
 370                 $repeat = $1;
 371                 $rest = $2;
 372                 $repeat_tests{"$test_num"} = $repeat;
 373             }
 374
 375             if ($rest =~ /\s+SKIP(.*)/) {
 376                 $rest = $1;
 377                 $skip = 1;
 378             }
 379
 380             if ($rest !~ /^\s*$/) {
 381                 die "$name: $.: Gargbage found after TEST_START\n$_";
 382             }
 383
 384             if ($skip) {
 385                 $test_num = $old_test_num;
 386                 $repeat = $old_repeat;
 387             }
 388
 389         } elsif (/^\s*DEFAULTS(.*)$/) {
 390             $default = 1;
 391
 392             $rest = $1;
 393
 394             if ($rest =~ /\s+SKIP(.*)/) {
 395                 $rest = $1;
 396                 $skip = 1;
 397             } else {
 398                 $skip = 0;
 399             }
 400
 401             if ($rest !~ /^\s*$/) {
 402                 die "$name: $.: Gargbage found after DEFAULTS\n$_";
 403             }
 404
 405         } elsif (/^\s*([A-Z_\[\]\d]+)\s*=\s*(.*?)\s*$/) {
 406
 407             next if ($skip);
 408
 409             my $lvalue = $1;
 410             my $rvalue = $2;
 411
 412             if (!$default &&
 413                 ($lvalue eq "NUM_TESTS" ||
 414                  $lvalue eq "LOG_FILE" ||
 415                  $lvalue eq "CLEAR_LOG")) {
 416                 die "$name: $.: $lvalue must be set in DEFAULTS section\n";
 417             }
 418
 419             if ($lvalue eq "NUM_TESTS") {
 420                 if ($test_num) {
 421                     die "$name: $.: Can not specify both NUM_TESTS and TEST_START\n";
 422                 }
 423                 if (!$default) {
 424                     die "$name: $.: NUM_TESTS must be set in default section\n";
 425                 }
 426                 $num_tests_set = 1;
 427             }
 428
 429             if ($default || $lvalue =~ /\[\d+\]$/) {
 430                 set_value($lvalue, $rvalue);
 431             } else {
 432                 my $val = "$lvalue\[$test_num\]";
 433                 set_value($val, $rvalue);
 434
 435                 if ($repeat > 1) {
 436                     $repeats{$val} = $repeat;
 437                 }
 438             }
 439         } elsif (/^\s*([A-Z_\[\]\d]+)\s*:=\s*(.*?)\s*$/) {
 440             next if ($skip);
 441
 442             my $lvalue = $1;
 443             my $rvalue = $2;
 444
 445             # process config variables.
 446             # Config variables are only active while reading the
 447             # config and can be defined anywhere. They also ignore
 448             # TEST_START and DEFAULTS, but are skipped if they are in
 449             # on of these sections that have SKIP defined.
 450             # The save variable can be
 451             # defined multiple times and the new one simply overrides
 452             # the prevous one.
 453             set_variable($lvalue, $rvalue);
 454
 455         } else {
 456             die "$name: $.: Garbage found in config\n$_";
 457         }
 458     }
 459
 460     close(IN);
 461
 462     if ($test_num) {
 463         $test_num += $repeat - 1;
 464         $opt{"NUM_TESTS"} = $test_num;
 465     }
 466
 467     # make sure we have all mandatory configs
 468     get_ktest_configs;
 469
 470     # set any defaults
 471
 472     foreach my $default (keys %default) {
 473         if (!defined($opt{$default})) {
 474             $opt{$default} = $default{$default};
 475         }
 476     }
 477 }
 478
 479 sub _logit {
 480     if (defined($opt{"LOG_FILE"})) {
 481         open(OUT, ">> $opt{LOG_FILE}") or die "Can't write to $opt{LOG_FILE}";
 482         print OUT @_;
 483         close(OUT);
 484     }
 485 }
 486
 487 sub logit {
 488     if (defined($opt{"LOG_FILE"})) {
 489         _logit @_;
 490     } else {
 491         print @_;
 492     }
 493 }
 494
 495 sub doprint {
 496     print @_;
 497     _logit @_;
 498 }
 499
 500 sub run_command;
 501
 502 sub reboot {
 503     # try to reboot normally
 504     if (run_command $reboot) {
 505         if (defined($powercycle_after_reboot)) {
 506             sleep $powercycle_after_reboot;
 507             run_command "$power_cycle";
 508         }
 509     } else {
 510         # nope? power cycle it.
 511         run_command "$power_cycle";
 512     }
 513 }
 514
 515 sub do_not_reboot {
 516     my $i = $iteration;
 517
 518     return $test_type eq "build" ||
 519         ($test_type eq "patchcheck" && $opt{"PATCHCHECK_TYPE[$i]"} eq "build") ||
 520         ($test_type eq "bisect" && $opt{"BISECT_TYPE[$i]"} eq "build");
 521 }
 522
 523 sub dodie {
 524     doprint "CRITICAL FAILURE... ", @_, "\n";
 525
 526     my $i = $iteration;
 527
 528     if ($reboot_on_error && !do_not_reboot) {
 529
 530         doprint "REBOOTING\n";
 531         reboot;
 532
 533     } elsif ($poweroff_on_error && defined($power_off)) {
 534         doprint "POWERING OFF\n";
 535         `$power_off`;
 536     }
 537
 538     if (defined($opt{"LOG_FILE"})) {
 539         print " See $opt{LOG_FILE} for more info.\n";
 540     }
 541
 542     die @_, "\n";
 543 }
 544
 545 sub open_console {
 546     my ($fp) = @_;
 547
 548     my $flags;
 549
 550     my $pid = open($fp, "$console|") or
 551         dodie "Can't open console $console";
 552
 553     $flags = fcntl($fp, F_GETFL, 0) or
 554         dodie "Can't get flags for the socket: $!";
 555     $flags = fcntl($fp, F_SETFL, $flags | O_NONBLOCK) or
 556         dodie "Can't set flags for the socket: $!";
 557
 558     return $pid;
 559 }
 560
 561 sub close_console {
 562     my ($fp, $pid) = @_;
 563
 564     doprint "kill child process $pid\n";
 565     kill 2, $pid;
 566
 567     print "closing!\n";
 568     close($fp);
 569 }
 570
 571 sub start_monitor {
 572     if ($monitor_cnt++) {
 573         return;
 574     }
 575     $monitor_fp = \*MONFD;
 576     $monitor_pid = open_console $monitor_fp;
 577
 578     return;
 579
 580     open(MONFD, "Stop perl from warning about single use of MONFD");
 581 }
 582
 583 sub end_monitor {
 584     if (--$monitor_cnt) {
 585         return;
 586     }
 587     close_console($monitor_fp, $monitor_pid);
 588 }
 589
 590 sub wait_for_monitor {
 591     my ($time) = @_;
 592     my $line;
 593
 594     doprint "** Wait for monitor to settle down **\n";
 595
 596     # read the monitor and wait for the system to calm down
 597     do {
 598         $line = wait_for_input($monitor_fp, $time);
 599         print "$line" if (defined($line));
 600     } while (defined($line));
 601     print "** Monitor flushed **\n";
 602 }
 603
 604 sub fail {
 605
 606         if ($die_on_failure) {
 607                 dodie @_;
 608         }
 609
 610         doprint "FAILED\n";
 611
 612         my $i = $iteration;
 613
 614         # no need to reboot for just building.
 615         if (!do_not_reboot) {
 616             doprint "REBOOTING\n";
 617             reboot;
 618             start_monitor;
 619             wait_for_monitor $sleep_time;
 620             end_monitor;
 621         }
 622
 623         doprint "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n";
 624         doprint "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n";
 625         doprint "KTEST RESULT: TEST $i Failed: ", @_, "\n";
 626         doprint "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n";
 627         doprint "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n";
 628
 629         return 1 if (!defined($store_failures));
 630
 631         my @t = localtime;
 632         my $date = sprintf "%04d%02d%02d%02d%02d%02d",
 633                 1900+$t[5],$t[4],$t[3],$t[2],$t[1],$t[0];
 634
 635         my $type = $build_type;
 636         if ($type =~ /useconfig/) {
 637             $type = "useconfig";
 638         }
 639
 640         my $dir = "$machine-$test_type-$type-fail-$date";
 641         my $faildir = "$store_failures/$dir";
 642
 643         if (!-d $faildir) {
 644             mkpath($faildir) or
 645                 die "can't create $faildir";
 646         }
 647         if (-f "$output_config") {
 648             cp "$output_config", "$faildir/config" or
 649                 die "failed to copy .config";
 650         }
 651         if (-f $buildlog) {
 652             cp $buildlog, "$faildir/buildlog" or
 653                 die "failed to move $buildlog";
 654         }
 655         if (-f $dmesg) {
 656             cp $dmesg, "$faildir/dmesg" or
 657                 die "failed to move $dmesg";
 658         }
 659
 660         doprint "*** Saved info to $faildir ***\n";
 661
 662         return 1;
 663 }
 664
 665 sub run_command {
 666     my ($command) = @_;
 667     my $dolog = 0;
 668     my $dord = 0;
 669     my $pid;
 670
 671     $command =~ s/\$SSH_USER/$ssh_user/g;
 672     $command =~ s/\$MACHINE/$machine/g;
 673
 674     doprint("$command ... ");
 675
 676     $pid = open(CMD, "$command 2>&1 |") or
 677         (fail "unable to exec $command" and return 0);
 678
 679     if (defined($opt{"LOG_FILE"})) {
 680         open(LOG, ">>$opt{LOG_FILE}") or
 681             dodie "failed to write to log";
 682         $dolog = 1;
 683     }
 684
 685     if (defined($redirect)) {
 686         open (RD, ">$redirect") or
 687             dodie "failed to write to redirect $redirect";
 688         $dord = 1;
 689     }
 690
 691     while (<CMD>) {
 692         print LOG if ($dolog);
 693         print RD  if ($dord);
 694     }
 695
 696     waitpid($pid, 0);
 697     my $failed = $?;
 698
 699     close(CMD);
 700     close(LOG) if ($dolog);
 701     close(RD)  if ($dord);
 702
 703     if ($failed) {
 704         doprint "FAILED!\n";
 705     } else {
 706         doprint "SUCCESS\n";
 707     }
 708
 709     return !$failed;
 710 }
 711
 712 sub run_ssh {
 713     my ($cmd) = @_;
 714     my $cp_exec = $ssh_exec;
 715
 716     $cp_exec =~ s/\$SSH_COMMAND/$cmd/g;
 717     return run_command "$cp_exec";
 718 }
 719
 720 sub run_scp {
 721     my ($src, $dst) = @_;
 722     my $cp_scp = $scp_to_target;
 723
 724     $cp_scp =~ s/\$SRC_FILE/$src/g;
 725     $cp_scp =~ s/\$DST_FILE/$dst/g;
 726
 727     return run_command "$cp_scp";
 728 }
 729
 730 sub get_grub_index {
 731
 732     if ($reboot_type ne "grub") {
 733         return;
 734     }
 735     return if (defined($grub_number));
 736
 737     doprint "Find grub menu ... ";
 738     $grub_number = -1;
 739
 740     my $ssh_grub = $ssh_exec;
 741     $ssh_grub =~ s,\$SSH_COMMAND,cat /boot/grub/menu.lst,g;
 742
 743     open(IN, "$ssh_grub |")
 744         or die "unable to get menu.lst";
 745
 746     while (<IN>) {
 747         if (/^\s*title\s+$grub_menu\s*$/) {
 748             $grub_number++;
 749             last;
 750         } elsif (/^\s*title\s/) {
 751             $grub_number++;
 752         }
 753     }
 754     close(IN);
 755
 756     die "Could not find '$grub_menu' in /boot/grub/menu on $machine"
 757         if ($grub_number < 0);
 758     doprint "$grub_number\n";
 759 }
 760
 761 sub wait_for_input
 762 {
 763     my ($fp, $time) = @_;
 764     my $rin;
 765     my $ready;
 766     my $line;
 767     my $ch;
 768
 769     if (!defined($time)) {
 770         $time = $timeout;
 771     }
 772
 773     $rin = '';
 774     vec($rin, fileno($fp), 1) = 1;
 775     $ready = select($rin, undef, undef, $time);
 776
 777     $line = "";
 778
 779     # try to read one char at a time
 780     while (sysread $fp, $ch, 1) {
 781         $line .= $ch;
 782         last if ($ch eq "\n");
 783     }
 784
 785     if (!length($line)) {
 786         return undef;
 787     }
 788
 789     return $line;
 790 }
 791
 792 sub reboot_to {
 793     if ($reboot_type eq "grub") {
 794         run_ssh "'(echo \"savedefault --default=$grub_number --once\" | grub --batch && reboot)'";
 795         return;
 796     }
 797
 798     run_command "$reboot_script";
 799 }
 800
 801 sub get_sha1 {
 802     my ($commit) = @_;
 803
 804     doprint "git rev-list --max-count=1 $commit ... ";
 805     my $sha1 = `git rev-list --max-count=1 $commit`;
 806     my $ret = $?;
 807
 808     logit $sha1;
 809
 810     if ($ret) {
 811         doprint "FAILED\n";
 812         dodie "Failed to get git $commit";
 813     }
 814
 815     print "SUCCESS\n";
 816
 817     chomp $sha1;
 818
 819     return $sha1;
 820 }
 821
 822 sub monitor {
 823     my $booted = 0;
 824     my $bug = 0;
 825     my $skip_call_trace = 0;
 826     my $loops;
 827
 828     wait_for_monitor 5;
 829
 830     my $line;
 831     my $full_line = "";
 832
 833     open(DMESG, "> $dmesg") or
 834         die "unable to write to $dmesg";
 835
 836     reboot_to;
 837
 838     my $success_start;
 839     my $failure_start;
 840     my $monitor_start = time;
 841     my $done = 0;
 842     my $version_found = 0;
 843
 844     while (!$done) {
 845
 846         if ($booted) {
 847             $line = wait_for_input($monitor_fp, $booted_timeout);
 848             if (!defined($line)) {
 849                 my $s = $booted_timeout == 1 ? "" : "s";
 850                 doprint "Successful boot found: break after $booted_timeout second$s\n";
 851                 last;
 852             }
 853         } else {
 854             $line = wait_for_input($monitor_fp);
 855             if (!defined($line)) {
 856                 my $s = $timeout == 1 ? "" : "s";
 857                 doprint "Timed out after $timeout second$s\n";
 858                 last;
 859             }
 860         }
 861
 862         doprint $line;
 863         print DMESG $line;
 864
 865         # we are not guaranteed to get a full line
 866         $full_line .= $line;
 867
 868         if ($full_line =~ /$success_line/) {
 869             $booted = 1;
 870             $success_start = time;
 871         }
 872
 873         if ($booted && defined($stop_after_success) &&
 874             $stop_after_success >= 0) {
 875             my $now = time;
 876             if ($now - $success_start >= $stop_after_success) {
 877                 doprint "Test forced to stop after $stop_after_success seconds after success\n";
 878                 last;
 879             }
 880         }
 881
 882         if ($full_line =~ /\[ backtrace testing \]/) {
 883             $skip_call_trace = 1;
 884         }
 885
 886         if ($full_line =~ /call trace:/i) {
 887             if (!$bug && !$skip_call_trace) {
 888                 $bug = 1;
 889                 $failure_start = time;
 890             }
 891         }
 892
 893         if ($bug && defined($stop_after_failure) &&
 894             $stop_after_failure >= 0) {
 895             my $now = time;
 896             if ($now - $failure_start >= $stop_after_failure) {
 897                 doprint "Test forced to stop after $stop_after_failure seconds after failure\n";
 898                 last;
 899             }
 900         }
 901
 902         if ($full_line =~ /\[ end of backtrace testing \]/) {
 903             $skip_call_trace = 0;
 904         }
 905
 906         if ($full_line =~ /Kernel panic -/) {
 907             $failure_start = time;
 908             $bug = 1;
 909         }
 910
 911         # Detect triple faults by testing the banner
 912         if ($full_line =~ /\bLinux version (\S+).*\n/) {
 913             if ($1 eq $version) {
 914                 $version_found = 1;
 915             } elsif ($version_found && $detect_triplefault) {
 916                 # We already booted into the kernel we are testing,
 917                 # but now we booted into another kernel?
 918                 # Consider this a triple fault.
 919                 doprint "Aleady booted in Linux kernel $version, but now\n";
 920                 doprint "we booted into Linux kernel $1.\n";
 921                 doprint "Assuming that this is a triple fault.\n";
 922                 doprint "To disable this: set DETECT_TRIPLE_FAULT to 0\n";
 923                 last;
 924             }
 925         }
 926
 927         if ($line =~ /\n/) {
 928             $full_line = "";
 929         }
 930
 931         if ($stop_test_after > 0 && !$booted && !$bug) {
 932             if (time - $monitor_start > $stop_test_after) {
 933                 doprint "STOP_TEST_AFTER ($stop_test_after seconds) timed out\n";
 934                 $done = 1;
 935             }
 936         }
 937     }
 938
 939     close(DMESG);
 940
 941     if ($bug) {
 942         return 0 if ($in_bisect);
 943         fail "failed - got a bug report" and return 0;
 944     }
 945
 946     if (!$booted) {
 947         return 0 if ($in_bisect);
 948         fail "failed - never got a boot prompt." and return 0;
 949     }
 950
 951     return 1;
 952 }
 953
 954 sub install {
 955
 956     run_scp "$outputdir/$build_target", "$target_image" or
 957         dodie "failed to copy image";
 958
 959     my $install_mods = 0;
 960
 961     # should we process modules?
 962     $install_mods = 0;
 963     open(IN, "$output_config") or dodie("Can't read config file");
 964     while (<IN>) {
 965         if (/CONFIG_MODULES(=y)?/) {
 966             $install_mods = 1 if (defined($1));
 967             last;
 968         }
 969     }
 970     close(IN);
 971
 972     if (!$install_mods) {
 973         doprint "No modules needed\n";
 974         return;
 975     }
 976
 977     run_command "$make INSTALL_MOD_PATH=$tmpdir modules_install" or
 978         dodie "Failed to install modules";
 979
 980     my $modlib = "/lib/modules/$version";
 981     my $modtar = "ktest-mods.tar.bz2";
 982
 983     run_ssh "rm -rf $modlib" or
 984         dodie "failed to remove old mods: $modlib";
 985
 986     # would be nice if scp -r did not follow symbolic links
 987     run_command "cd $tmpdir && tar -cjf $modtar lib/modules/$version" or
 988         dodie "making tarball";
 989
 990     run_scp "$tmpdir/$modtar", "/tmp" or
 991         dodie "failed to copy modules";
 992
 993     unlink "$tmpdir/$modtar";
 994
 995     run_ssh "'(cd / && tar xf /tmp/$modtar)'" or
 996         dodie "failed to tar modules";
 997
 998     run_ssh "rm -f /tmp/$modtar";
 999
1000     return if (!defined($post_install));
1001
1002     my $cp_post_install = $post_install;
1003     $cp_post_install =~ s/\$KERNEL_VERSION/$version/g;
1004     run_command "$cp_post_install" or
1005         dodie "Failed to run post install";
1006 }
1007
1008 sub check_buildlog {
1009     my ($patch) = @_;
1010
1011     my @files = `git show $patch | diffstat -l`;
1012
1013     open(IN, "git show $patch |") or
1014         dodie "failed to show $patch";
1015     while (<IN>) {
1016         if (m,^--- a/(.*),) {
1017             chomp $1;
1018             $files[$#files] = $1;
1019         }
1020     }
1021     close(IN);
1022
1023     open(IN, $buildlog) or dodie "Can't open $buildlog";
1024     while (<IN>) {
1025         if (/^\s*(.*?):.*(warning|error)/) {
1026             my $err = $1;
1027             foreach my $file (@files) {
1028                 my $fullpath = "$builddir/$file";
1029                 if ($file eq $err || $fullpath eq $err) {
1030                     fail "$file built with warnings" and return 0;
1031                 }
1032             }
1033         }
1034     }
1035     close(IN);
1036
1037     return 1;
1038 }
1039
1040 sub make_oldconfig {
1041     my ($defconfig) = @_;
1042
1043     if (!run_command "$defconfig $make oldnoconfig") {
1044         # Perhaps oldnoconfig doesn't exist in this version of the kernel
1045         # try a yes '' | oldconfig
1046         doprint "oldnoconfig failed, trying yes '' | make oldconfig\n";
1047         run_command "yes '' | $defconfig $make oldconfig" or
1048             dodie "failed make config oldconfig";
1049     }
1050 }
1051
1052 sub build {
1053     my ($type) = @_;
1054     my $defconfig = "";
1055
1056     unlink $buildlog;
1057
1058     if ($type =~ /^useconfig:(.*)/) {
1059         run_command "cp $1 $output_config" or
1060             dodie "could not copy $1 to .config";
1061
1062         $type = "oldconfig";
1063     }
1064
1065     # old config can ask questions
1066     if ($type eq "oldconfig") {
1067         $type = "oldnoconfig";
1068
1069         # allow for empty configs
1070         run_command "touch $output_config";
1071
1072         run_command "mv $output_config $outputdir/config_temp" or
1073             dodie "moving .config";
1074
1075         if (!$noclean && !run_command "$make mrproper") {
1076             dodie "make mrproper";
1077         }
1078
1079         run_command "mv $outputdir/config_temp $output_config" or
1080             dodie "moving config_temp";
1081
1082     } elsif (!$noclean) {
1083         unlink "$output_config";
1084         run_command "$make mrproper" or
1085             dodie "make mrproper";
1086     }
1087
1088     # add something to distinguish this build
1089     open(OUT, "> $outputdir/localversion") or dodie("Can't make localversion file");
1090     print OUT "$localversion\n";
1091     close(OUT);
1092
1093     if (defined($minconfig)) {
1094         $defconfig = "KCONFIG_ALLCONFIG=$minconfig";
1095     }
1096
1097     if ($type eq "oldnoconfig") {
1098         make_oldconfig $defconfig;
1099     } else {
1100         run_command "$defconfig $make $type" or
1101             dodie "failed make config";
1102     }
1103
1104     $redirect = "$buildlog";
1105     if (!run_command "$make $build_options") {
1106         undef $redirect;
1107         # bisect may need this to pass
1108         return 0 if ($in_bisect);
1109         fail "failed build" and return 0;
1110     }
1111     undef $redirect;
1112
1113     return 1;
1114 }
1115
1116 sub halt {
1117     if (!run_ssh "halt" or defined($power_off)) {
1118         if (defined($poweroff_after_halt)) {
1119             sleep $poweroff_after_halt;
1120             run_command "$power_off";
1121         }
1122     } else {
1123         # nope? the zap it!
1124         run_command "$power_off";
1125     }
1126 }
1127
1128 sub success {
1129     my ($i) = @_;
1130
1131     $successes++;
1132
1133     doprint "\n\n*******************************************\n";
1134     doprint     "*******************************************\n";
1135     doprint     "KTEST RESULT: TEST $i SUCCESS!!!!         **\n";
1136     doprint     "*******************************************\n";
1137     doprint     "*******************************************\n";
1138
1139     if ($i != $opt{"NUM_TESTS"} && !do_not_reboot) {
1140         doprint "Reboot and wait $sleep_time seconds\n";
1141         reboot;
1142         start_monitor;
1143         wait_for_monitor $sleep_time;
1144         end_monitor;
1145     }
1146 }
1147
1148 sub get_version {
1149     # get the release name
1150     doprint "$make kernelrelease ... ";
1151     $version = `$make kernelrelease | tail -1`;
1152     chomp($version);
1153     doprint "$version\n";
1154 }
1155
1156 sub answer_bisect {
1157     for (;;) {
1158         doprint "Pass or fail? [p/f]";
1159         my $ans = <STDIN>;
1160         chomp $ans;
1161         if ($ans eq "p" || $ans eq "P") {
1162             return 1;
1163         } elsif ($ans eq "f" || $ans eq "F") {
1164             return 0;
1165         } else {
1166             print "Please answer 'P' or 'F'\n";
1167         }
1168     }
1169 }
1170
1171 sub child_run_test {
1172     my $failed = 0;
1173
1174     # child should have no power
1175     $reboot_on_error = 0;
1176     $poweroff_on_error = 0;
1177     $die_on_failure = 1;
1178
1179     run_command $run_test or $failed = 1;
1180     exit $failed;
1181 }
1182
1183 my $child_done;
1184
1185 sub child_finished {
1186     $child_done = 1;
1187 }
1188
1189 sub do_run_test {
1190     my $child_pid;
1191     my $child_exit;
1192     my $line;
1193     my $full_line;
1194     my $bug = 0;
1195
1196     wait_for_monitor 1;
1197
1198     doprint "run test $run_test\n";
1199
1200     $child_done = 0;
1201
1202     $SIG{CHLD} = qw(child_finished);
1203
1204     $child_pid = fork;
1205
1206     child_run_test if (!$child_pid);
1207
1208     $full_line = "";
1209
1210     do {
1211         $line = wait_for_input($monitor_fp, 1);
1212         if (defined($line)) {
1213
1214             # we are not guaranteed to get a full line
1215             $full_line .= $line;
1216             doprint $line;
1217
1218             if ($full_line =~ /call trace:/i) {
1219                 $bug = 1;
1220             }
1221
1222             if ($full_line =~ /Kernel panic -/) {
1223                 $bug = 1;
1224             }
1225
1226             if ($line =~ /\n/) {
1227                 $full_line = "";
1228             }
1229         }
1230     } while (!$child_done && !$bug);
1231
1232     if ($bug) {
1233         my $failure_start = time;
1234         my $now;
1235         do {
1236             $line = wait_for_input($monitor_fp, 1);
1237             if (defined($line)) {
1238                 doprint $line;
1239             }
1240             $now = time;
1241             if ($now - $failure_start >= $stop_after_failure) {
1242                 last;
1243             }
1244         } while (defined($line));
1245
1246         doprint "Detected kernel crash!\n";
1247         # kill the child with extreme prejudice
1248         kill 9, $child_pid;
1249     }
1250
1251     waitpid $child_pid, 0;
1252     $child_exit = $?;
1253
1254     if ($bug || $child_exit) {
1255         return 0 if $in_bisect;
1256         fail "test failed" and return 0;
1257     }
1258     return 1;
1259 }
1260
1261 sub run_git_bisect {
1262     my ($command) = @_;
1263
1264     doprint "$command ... ";
1265
1266     my $output = `$command 2>&1`;
1267     my $ret = $?;
1268
1269     logit $output;
1270
1271     if ($ret) {
1272         doprint "FAILED\n";
1273         dodie "Failed to git bisect";
1274     }
1275
1276     doprint "SUCCESS\n";
1277     if ($output =~ m/^(Bisecting: .*\(roughly \d+ steps?\))\s+\[([[:xdigit:]]+)\]/) {
1278         doprint "$1 [$2]\n";
1279     } elsif ($output =~ m/^([[:xdigit:]]+) is the first bad commit/) {
1280         $bisect_bad = $1;
1281         doprint "Found bad commit... $1\n";
1282         return 0;
1283     } else {
1284         # we already logged it, just print it now.
1285         print $output;
1286     }
1287
1288     return 1;
1289 }
1290
1291 sub bisect_reboot {
1292     doprint "Reboot and sleep $bisect_sleep_time seconds\n";
1293     reboot;
1294     start_monitor;
1295     wait_for_monitor $bisect_sleep_time;
1296     end_monitor;
1297 }
1298
1299 # returns 1 on success, 0 on failure, -1 on skip
1300 sub run_bisect_test {
1301     my ($type, $buildtype) = @_;
1302
1303     my $failed = 0;
1304     my $result;
1305     my $output;
1306     my $ret;
1307
1308     $in_bisect = 1;
1309
1310     build $buildtype or $failed = 1;
1311
1312     if ($type ne "build") {
1313         if ($failed && $bisect_skip) {
1314             $in_bisect = 0;
1315             return -1;
1316         }
1317         dodie "Failed on build" if $failed;
1318
1319         # Now boot the box
1320         get_grub_index;
1321         get_version;
1322         install;
1323
1324         start_monitor;
1325         monitor or $failed = 1;
1326
1327         if ($type ne "boot") {
1328             if ($failed && $bisect_skip) {
1329                 end_monitor;
1330                 bisect_reboot;
1331                 $in_bisect = 0;
1332                 return -1;
1333             }
1334             dodie "Failed on boot" if $failed;
1335
1336             do_run_test or $failed = 1;
1337         }
1338         end_monitor;
1339     }
1340
1341     if ($failed) {
1342         $result = 0;
1343     } else {
1344         $result = 1;
1345     }
1346
1347     # reboot the box to a kernel we can ssh to
1348     if ($type ne "build") {
1349         bisect_reboot;
1350     }
1351     $in_bisect = 0;
1352
1353     return $result;
1354 }
1355
1356 sub run_bisect {
1357     my ($type) = @_;
1358     my $buildtype = "oldconfig";
1359
1360     # We should have a minconfig to use?
1361     if (defined($minconfig)) {
1362         $buildtype = "useconfig:$minconfig";
1363     }
1364
1365     my $ret = run_bisect_test $type, $buildtype;
1366
1367     if ($bisect_manual) {
1368         $ret = answer_bisect;
1369     }
1370
1371     # Are we looking for where it worked, not failed?
1372     if ($reverse_bisect) {
1373         $ret = !$ret;
1374     }
1375
1376     if ($ret > 0) {
1377         return "good";
1378     } elsif ($ret == 0) {
1379         return  "bad";
1380     } elsif ($bisect_skip) {
1381         doprint "HIT A BAD COMMIT ... SKIPPING\n";
1382         return "skip";
1383     }
1384 }
1385
1386 sub bisect {
1387     my ($i) = @_;
1388
1389     my $result;
1390
1391     die "BISECT_GOOD[$i] not defined\n" if (!defined($opt{"BISECT_GOOD[$i]"}));
1392     die "BISECT_BAD[$i] not defined\n"  if (!defined($opt{"BISECT_BAD[$i]"}));
1393     die "BISECT_TYPE[$i] not defined\n" if (!defined($opt{"BISECT_TYPE[$i]"}));
1394
1395     my $good = $opt{"BISECT_GOOD[$i]"};
1396     my $bad = $opt{"BISECT_BAD[$i]"};
1397     my $type = $opt{"BISECT_TYPE[$i]"};
1398     my $start = $opt{"BISECT_START[$i]"};
1399     my $replay = $opt{"BISECT_REPLAY[$i]"};
1400     my $start_files = $opt{"BISECT_FILES[$i]"};
1401
1402     if (defined($start_files)) {
1403         $start_files = " -- " . $start_files;
1404     } else {
1405         $start_files = "";
1406     }
1407
1408     # convert to true sha1's
1409     $good = get_sha1($good);
1410     $bad = get_sha1($bad);
1411
1412     if (defined($opt{"BISECT_REVERSE[$i]"}) &&
1413         $opt{"BISECT_REVERSE[$i]"} == 1) {
1414         doprint "Performing a reverse bisect (bad is good, good is bad!)\n";
1415         $reverse_bisect = 1;
1416     } else {
1417         $reverse_bisect = 0;
1418     }
1419
1420     # Can't have a test without having a test to run
1421     if ($type eq "test" && !defined($run_test)) {
1422         $type = "boot";
1423     }
1424
1425     my $check = $opt{"BISECT_CHECK[$i]"};
1426     if (defined($check) && $check ne "0") {
1427
1428         # get current HEAD
1429         my $head = get_sha1("HEAD");
1430
1431         if ($check ne "good") {
1432             doprint "TESTING BISECT BAD [$bad]\n";
1433             run_command "git checkout $bad" or
1434                 die "Failed to checkout $bad";
1435
1436             $result = run_bisect $type;
1437
1438             if ($result ne "bad") {
1439                 fail "Tested BISECT_BAD [$bad] and it succeeded" and return 0;
1440             }
1441         }
1442
1443         if ($check ne "bad") {
1444             doprint "TESTING BISECT GOOD [$good]\n";
1445             run_command "git checkout $good" or
1446                 die "Failed to checkout $good";
1447
1448             $result = run_bisect $type;
1449
1450             if ($result ne "good") {
1451                 fail "Tested BISECT_GOOD [$good] and it failed" and return 0;
1452             }
1453         }
1454
1455         # checkout where we started
1456         run_command "git checkout $head" or
1457             die "Failed to checkout $head";
1458     }
1459
1460     run_command "git bisect start$start_files" or
1461         dodie "could not start bisect";
1462
1463     run_command "git bisect good $good" or
1464         dodie "could not set bisect good to $good";
1465
1466     run_git_bisect "git bisect bad $bad" or
1467         dodie "could not set bisect bad to $bad";
1468
1469     if (defined($replay)) {
1470         run_command "git bisect replay $replay" or
1471             dodie "failed to run replay";
1472     }
1473
1474     if (defined($start)) {
1475         run_command "git checkout $start" or
1476             dodie "failed to checkout $start";
1477     }
1478
1479     my $test;
1480     do {
1481         $result = run_bisect $type;
1482         $test = run_git_bisect "git bisect $result";
1483     } while ($test);
1484
1485     run_command "git bisect log" or
1486         dodie "could not capture git bisect log";
1487
1488     run_command "git bisect reset" or
1489         dodie "could not reset git bisect";
1490
1491     doprint "Bad commit was [$bisect_bad]\n";
1492
1493     success $i;
1494 }
1495
1496 my %config_ignore;
1497 my %config_set;
1498
1499 my %config_list;
1500 my %null_config;
1501
1502 my %dependency;
1503
1504 sub process_config_ignore {
1505     my ($config) = @_;
1506
1507     open (IN, $config)
1508         or dodie "Failed to read $config";
1509
1510     while (<IN>) {
1511         if (/^((CONFIG\S*)=.*)/) {
1512             $config_ignore{$2} = $1;
1513         }
1514     }
1515
1516     close(IN);
1517 }
1518
1519 sub read_current_config {
1520     my ($config_ref) = @_;
1521
1522     %{$config_ref} = ();
1523     undef %{$config_ref};
1524
1525     my @key = keys %{$config_ref};
1526     if ($#key >= 0) {
1527         print "did not delete!\n";
1528         exit;
1529     }
1530     open (IN, "$output_config");
1531
1532     while (<IN>) {
1533         if (/^(CONFIG\S+)=(.*)/) {
1534             ${$config_ref}{$1} = $2;
1535         }
1536     }
1537     close(IN);
1538 }
1539
1540 sub get_dependencies {
1541     my ($config) = @_;
1542
1543     my $arr = $dependency{$config};
1544     if (!defined($arr)) {
1545         return ();
1546     }
1547
1548     my @deps = @{$arr};
1549
1550     foreach my $dep (@{$arr}) {
1551         print "ADD DEP $dep\n";
1552         @deps = (@deps, get_dependencies $dep);
1553     }
1554
1555     return @deps;
1556 }
1557
1558 sub create_config {
1559     my @configs = @_;
1560
1561     open(OUT, ">$output_config") or dodie "Can not write to $output_config";
1562
1563     foreach my $config (@configs) {
1564         print OUT "$config_set{$config}\n";
1565         my @deps = get_dependencies $config;
1566         foreach my $dep (@deps) {
1567             print OUT "$config_set{$dep}\n";
1568         }
1569     }
1570
1571     foreach my $config (keys %config_ignore) {
1572         print OUT "$config_ignore{$config}\n";
1573     }
1574     close(OUT);
1575
1576 #    exit;
1577     make_oldconfig "";
1578 }
1579
1580 sub compare_configs {
1581     my (%a, %b) = @_;
1582
1583     foreach my $item (keys %a) {
1584         if (!defined($b{$item})) {
1585             print "diff $item\n";
1586             return 1;
1587         }
1588         delete $b{$item};
1589     }
1590
1591     my @keys = keys %b;
1592     if ($#keys) {
1593         print "diff2 $keys[0]\n";
1594     }
1595     return -1 if ($#keys >= 0);
1596
1597     return 0;
1598 }
1599
1600 sub run_config_bisect_test {
1601     my ($type) = @_;
1602
1603     return run_bisect_test $type, "oldconfig";
1604 }
1605
1606 sub process_passed {
1607     my (%configs) = @_;
1608
1609     doprint "These configs had no failure: (Enabling them for further compiles)\n";
1610     # Passed! All these configs are part of a good compile.
1611     # Add them to the min options.
1612     foreach my $config (keys %configs) {
1613         if (defined($config_list{$config})) {
1614             doprint " removing $config\n";
1615             $config_ignore{$config} = $config_list{$config};
1616             delete $config_list{$config};
1617         }
1618     }
1619     doprint "config copied to $outputdir/config_good\n";
1620     run_command "cp -f $output_config $outputdir/config_good";
1621 }
1622
1623 sub process_failed {
1624     my ($config) = @_;
1625
1626     doprint "\n\n***************************************\n";
1627     doprint "Found bad config: $config\n";
1628     doprint "***************************************\n\n";
1629 }
1630
1631 sub run_config_bisect {
1632
1633     my @start_list = keys %config_list;
1634
1635     if ($#start_list < 0) {
1636         doprint "No more configs to test!!!\n";
1637         return -1;
1638     }
1639
1640     doprint "***** RUN TEST ***\n";
1641     my $type = $opt{"CONFIG_BISECT_TYPE[$iteration]"};
1642     my $ret;
1643     my %current_config;
1644
1645     my $count = $#start_list + 1;
1646     doprint "  $count configs to test\n";
1647
1648     my $half = int($#start_list / 2);
1649
1650     do {
1651         my @tophalf = @start_list[0 .. $half];
1652
1653         create_config @tophalf;
1654         read_current_config \%current_config;
1655
1656         $count = $#tophalf + 1;
1657         doprint "Testing $count configs\n";
1658         my $found = 0;
1659         # make sure we test something
1660         foreach my $config (@tophalf) {
1661             if (defined($current_config{$config})) {
1662                 logit " $config\n";
1663                 $found = 1;
1664             }
1665         }
1666         if (!$found) {
1667             # try the other half
1668             doprint "Top half produced no set configs, trying bottom half\n";
1669             @tophalf = @start_list[$half + 1 .. $#start_list];
1670             create_config @tophalf;
1671             read_current_config \%current_config;
1672             foreach my $config (@tophalf) {
1673                 if (defined($current_config{$config})) {
1674                     logit " $config\n";
1675                     $found = 1;
1676                 }
1677             }
1678             if (!$found) {
1679                 doprint "Failed: Can't make new config with current configs\n";
1680                 foreach my $config (@start_list) {
1681                     doprint "  CONFIG: $config\n";
1682                 }
1683                 return -1;
1684             }
1685             $count = $#tophalf + 1;
1686             doprint "Testing $count configs\n";
1687         }
1688
1689         $ret = run_config_bisect_test $type;
1690         if ($bisect_manual) {
1691             $ret = answer_bisect;
1692         }
1693         if ($ret) {
1694             process_passed %current_config;
1695             return 0;
1696         }
1697
1698         doprint "This config had a failure.\n";
1699         doprint "Removing these configs that were not set in this config:\n";
1700         doprint "config copied to $outputdir/config_bad\n";
1701         run_command "cp -f $output_config $outputdir/config_bad";
1702
1703         # A config exists in this group that was bad.
1704         foreach my $config (keys %config_list) {
1705             if (!defined($current_config{$config})) {
1706                 doprint " removing $config\n";
1707                 delete $config_list{$config};
1708             }
1709         }
1710
1711         @start_list = @tophalf;
1712
1713         if ($#start_list == 0) {
1714             process_failed $start_list[0];
1715             return 1;
1716         }
1717
1718         # remove half the configs we are looking at and see if
1719         # they are good.
1720         $half = int($#start_list / 2);
1721     } while ($#start_list > 0);
1722
1723     # we found a single config, try it again unless we are running manually
1724
1725     if ($bisect_manual) {
1726         process_failed $start_list[0];
1727         return 1;
1728     }
1729
1730     my @tophalf = @start_list[0 .. 0];
1731
1732     $ret = run_config_bisect_test $type;
1733     if ($ret) {
1734         process_passed %current_config;
1735         return 0;
1736     }
1737
1738     process_failed $start_list[0];
1739     return 1;
1740 }
1741
1742 sub config_bisect {
1743     my ($i) = @_;
1744
1745     my $start_config = $opt{"CONFIG_BISECT[$i]"};
1746
1747     my $tmpconfig = "$tmpdir/use_config";
1748
1749     if (defined($config_bisect_good)) {
1750         process_config_ignore $config_bisect_good;
1751     }
1752
1753     # Make the file with the bad config and the min config
1754     if (defined($minconfig)) {
1755         # read the min config for things to ignore
1756         run_command "cp $minconfig $tmpconfig" or
1757             dodie "failed to copy $minconfig to $tmpconfig";
1758     } else {
1759         unlink $tmpconfig;
1760     }
1761
1762     # Add other configs
1763     if (defined($addconfig)) {
1764         run_command "cat $addconfig >> $tmpconfig" or
1765             dodie "failed to append $addconfig";
1766     }
1767
1768     my $defconfig = "";
1769     if (-f $tmpconfig) {
1770         $defconfig = "KCONFIG_ALLCONFIG=$tmpconfig";
1771         process_config_ignore $tmpconfig;
1772     }
1773
1774     # now process the start config
1775     run_command "cp $start_config $output_config" or
1776         dodie "failed to copy $start_config to $output_config";
1777
1778     # read directly what we want to check
1779     my %config_check;
1780     open (IN, $output_config)
1781         or dodie "faied to open $output_config";
1782
1783     while (<IN>) {
1784         if (/^((CONFIG\S*)=.*)/) {
1785             $config_check{$2} = $1;
1786         }
1787     }
1788     close(IN);
1789
1790     # Now run oldconfig with the minconfig (and addconfigs)
1791     make_oldconfig $defconfig;
1792
1793     # check to see what we lost (or gained)
1794     open (IN, $output_config)
1795         or dodie "Failed to read $start_config";
1796
1797     my %removed_configs;
1798     my %added_configs;
1799
1800     while (<IN>) {
1801         if (/^((CONFIG\S*)=.*)/) {
1802             # save off all options
1803             $config_set{$2} = $1;
1804             if (defined($config_check{$2})) {
1805                 if (defined($config_ignore{$2})) {
1806                     $removed_configs{$2} = $1;
1807                 } else {
1808                     $config_list{$2} = $1;
1809                 }
1810             } elsif (!defined($config_ignore{$2})) {
1811                 $added_configs{$2} = $1;
1812                 $config_list{$2} = $1;
1813             }
1814         }
1815     }
1816     close(IN);
1817
1818     my @confs = keys %removed_configs;
1819     if ($#confs >= 0) {
1820         doprint "Configs overridden by default configs and removed from check:\n";
1821         foreach my $config (@confs) {
1822             doprint " $config\n";
1823         }
1824     }
1825     @confs = keys %added_configs;
1826     if ($#confs >= 0) {
1827         doprint "Configs appearing in make oldconfig and added:\n";
1828         foreach my $config (@confs) {
1829             doprint " $config\n";
1830         }
1831     }
1832
1833     my %config_test;
1834     my $once = 0;
1835
1836     # Sometimes kconfig does weird things. We must make sure
1837     # that the config we autocreate has everything we need
1838     # to test, otherwise we may miss testing configs, or
1839     # may not be able to create a new config.
1840     # Here we create a config with everything set.
1841     create_config (keys %config_list);
1842     read_current_config \%config_test;
1843     foreach my $config (keys %config_list) {
1844         if (!defined($config_test{$config})) {
1845             if (!$once) {
1846                 $once = 1;
1847                 doprint "Configs not produced by kconfig (will not be checked):\n";
1848             }
1849             doprint "  $config\n";
1850             delete $config_list{$config};
1851         }
1852     }
1853     my $ret;
1854     do {
1855         $ret = run_config_bisect;
1856     } while (!$ret);
1857
1858     return $ret if ($ret < 0);
1859
1860     success $i;
1861 }
1862
1863 sub patchcheck_reboot {
1864     doprint "Reboot and sleep $patchcheck_sleep_time seconds\n";
1865     reboot;
1866     start_monitor;
1867     wait_for_monitor $patchcheck_sleep_time;
1868     end_monitor;
1869 }
1870
1871 sub patchcheck {
1872     my ($i) = @_;
1873
1874     die "PATCHCHECK_START[$i] not defined\n"
1875         if (!defined($opt{"PATCHCHECK_START[$i]"}));
1876     die "PATCHCHECK_TYPE[$i] not defined\n"
1877         if (!defined($opt{"PATCHCHECK_TYPE[$i]"}));
1878
1879     my $start = $opt{"PATCHCHECK_START[$i]"};
1880
1881     my $end = "HEAD";
1882     if (defined($opt{"PATCHCHECK_END[$i]"})) {
1883         $end = $opt{"PATCHCHECK_END[$i]"};
1884     }
1885
1886     # Get the true sha1's since we can use things like HEAD~3
1887     $start = get_sha1($start);
1888     $end = get_sha1($end);
1889
1890     my $type = $opt{"PATCHCHECK_TYPE[$i]"};
1891
1892     # Can't have a test without having a test to run
1893     if ($type eq "test" && !defined($run_test)) {
1894         $type = "boot";
1895     }
1896
1897     open (IN, "git log --pretty=oneline $end|") or
1898         dodie "could not get git list";
1899
1900     my @list;
1901
1902     while (<IN>) {
1903         chomp;
1904         $list[$#list+1] = $_;
1905         last if (/^$start/);
1906     }
1907     close(IN);
1908
1909     if ($list[$#list] !~ /^$start/) {
1910         fail "SHA1 $start not found";
1911     }
1912
1913     # go backwards in the list
1914     @list = reverse @list;
1915
1916     my $save_clean = $noclean;
1917
1918     $in_patchcheck = 1;
1919     foreach my $item (@list) {
1920         my $sha1 = $item;
1921         $sha1 =~ s/^([[:xdigit:]]+).*/$1/;
1922
1923         doprint "\nProcessing commit $item\n\n";
1924
1925         run_command "git checkout $sha1" or
1926             die "Failed to checkout $sha1";
1927
1928         # only clean on the first and last patch
1929         if ($item eq $list[0] ||
1930             $item eq $list[$#list]) {
1931             $noclean = $save_clean;
1932         } else {
1933             $noclean = 1;
1934         }
1935
1936         if (defined($minconfig)) {
1937             build "useconfig:$minconfig" or return 0;
1938         } else {
1939             # ?? no config to use?
1940             build "oldconfig" or return 0;
1941         }
1942
1943         check_buildlog $sha1 or return 0;
1944
1945         next if ($type eq "build");
1946
1947         get_grub_index;
1948         get_version;
1949         install;
1950
1951         my $failed = 0;
1952
1953         start_monitor;
1954         monitor or $failed = 1;
1955
1956         if (!$failed && $type ne "boot"){
1957             do_run_test or $failed = 1;
1958         }
1959         end_monitor;
1960         return 0 if ($failed);
1961
1962         patchcheck_reboot;
1963
1964     }
1965     $in_patchcheck = 0;
1966     success $i;
1967
1968     return 1;
1969 }
1970
1971 $#ARGV < 1 or die "ktest.pl version: $VERSION\n   usage: ktest.pl config-file\n";
1972
1973 if ($#ARGV == 0) {
1974     $ktest_config = $ARGV[0];
1975     if (! -f $ktest_config) {
1976         print "$ktest_config does not exist.\n";
1977         my $ans;
1978         for (;;) {
1979             print "Create it? [Y/n] ";
1980             $ans = <STDIN>;
1981             chomp $ans;
1982             if ($ans =~ /^\s*$/) {
1983                 $ans = "y";
1984             }
1985             last if ($ans =~ /^y$/i || $ans =~ /^n$/i);
1986             print "Please answer either 'y' or 'n'.\n";
1987         }
1988         if ($ans !~ /^y$/i) {
1989             exit 0;
1990         }
1991     }
1992 } else {
1993     $ktest_config = "ktest.conf";
1994 }
1995
1996 if (! -f $ktest_config) {
1997     open(OUT, ">$ktest_config") or die "Can not create $ktest_config";
1998     print OUT << "EOF"
1999 # Generated by ktest.pl
2000 #
2001 # Define each test with TEST_START
2002 # The config options below it will override the defaults
2003 TEST_START
2004
2005 DEFAULTS
2006 EOF
2007 ;
2008     close(OUT);
2009 }
2010 read_config $ktest_config;
2011
2012 # Append any configs entered in manually to the config file.
2013 my @new_configs = keys %entered_configs;
2014 if ($#new_configs >= 0) {
2015     print "\nAppending entered in configs to $ktest_config\n";
2016     open(OUT, ">>$ktest_config") or die "Can not append to $ktest_config";
2017     foreach my $config (@new_configs) {
2018         print OUT "$config = $entered_configs{$config}\n";
2019         $opt{$config} = $entered_configs{$config};
2020     }
2021 }
2022
2023 if ($opt{"CLEAR_LOG"} && defined($opt{"LOG_FILE"})) {
2024     unlink $opt{"LOG_FILE"};
2025 }
2026
2027 doprint "\n\nSTARTING AUTOMATED TESTS\n\n";
2028
2029 for (my $i = 0, my $repeat = 1; $i <= $opt{"NUM_TESTS"}; $i += $repeat) {
2030
2031     if (!$i) {
2032         doprint "DEFAULT OPTIONS:\n";
2033     } else {
2034         doprint "\nTEST $i OPTIONS";
2035         if (defined($repeat_tests{$i})) {
2036             $repeat = $repeat_tests{$i};
2037             doprint " ITERATE $repeat";
2038         }
2039         doprint "\n";
2040     }
2041
2042     foreach my $option (sort keys %opt) {
2043
2044         if ($option =~ /\[(\d+)\]$/) {
2045             next if ($i != $1);
2046         } else {
2047             next if ($i);
2048         }
2049
2050         doprint "$option = $opt{$option}\n";
2051     }
2052 }
2053
2054 sub __set_test_option {
2055     my ($name, $i) = @_;
2056
2057     my $option = "$name\[$i\]";
2058
2059     if (defined($opt{$option})) {
2060         return $opt{$option};
2061     }
2062
2063     foreach my $test (keys %repeat_tests) {
2064         if ($i >= $test &&
2065             $i < $test + $repeat_tests{$test}) {
2066             $option = "$name\[$test\]";
2067             if (defined($opt{$option})) {
2068                 return $opt{$option};
2069             }
2070         }
2071     }
2072
2073     if (defined($opt{$name})) {
2074         return $opt{$name};
2075     }
2076
2077     return undef;
2078 }
2079
2080 sub eval_option {
2081     my ($option, $i) = @_;
2082
2083     # Add space to evaluate the character before $
2084     $option = " $option";
2085     my $retval = "";
2086
2087     while ($option =~ /(.*?[^\\])\$\{(.*?)\}(.*)/) {
2088         my $start = $1;
2089         my $var = $2;
2090         my $end = $3;
2091
2092         # Append beginning of line
2093         $retval = "$retval$start";
2094
2095         # If the iteration option OPT[$i] exists, then use that.
2096         # otherwise see if the default OPT (without [$i]) exists.
2097
2098         my $o = "$var\[$i\]";
2099
2100         if (defined($opt{$o})) {
2101             $o = $opt{$o};
2102             $retval = "$retval$o";
2103         } elsif (defined($opt{$var})) {
2104             $o = $opt{$var};
2105             $retval = "$retval$o";
2106         } else {
2107             $retval = "$retval\$\{$var\}";
2108         }
2109
2110         $option = $end;
2111     }
2112
2113     $retval = "$retval$option";
2114
2115     $retval =~ s/^ //;
2116
2117     return $retval;
2118 }
2119
2120 sub set_test_option {
2121     my ($name, $i) = @_;
2122
2123     my $option = __set_test_option($name, $i);
2124     return $option if (!defined($option));
2125
2126     my $prev = "";
2127
2128     # Since an option can evaluate to another option,
2129     # keep iterating until we do not evaluate any more
2130     # options.
2131     my $r = 0;
2132     while ($prev ne $option) {
2133         # Check for recursive evaluations.
2134         # 100 deep should be more than enough.
2135         if ($r++ > 100) {
2136             die "Over 100 evaluations accurred with $name\n" .
2137                 "Check for recursive variables\n";
2138         }
2139         $prev = $option;
2140         $option = eval_option($option, $i);
2141     }
2142
2143     return $option;
2144 }
2145
2146 # First we need to do is the builds
2147 for (my $i = 1; $i <= $opt{"NUM_TESTS"}; $i++) {
2148
2149     $iteration = $i;
2150
2151     my $makecmd = set_test_option("MAKE_CMD", $i);
2152
2153     $machine = set_test_option("MACHINE", $i);
2154     $ssh_user = set_test_option("SSH_USER", $i);
2155     $tmpdir = set_test_option("TMP_DIR", $i);
2156     $outputdir = set_test_option("OUTPUT_DIR", $i);
2157     $builddir = set_test_option("BUILD_DIR", $i);
2158     $test_type = set_test_option("TEST_TYPE", $i);
2159     $build_type = set_test_option("BUILD_TYPE", $i);
2160     $build_options = set_test_option("BUILD_OPTIONS", $i);
2161     $power_cycle = set_test_option("POWER_CYCLE", $i);
2162     $reboot = set_test_option("REBOOT", $i);
2163     $noclean = set_test_option("BUILD_NOCLEAN", $i);
2164     $minconfig = set_test_option("MIN_CONFIG", $i);
2165     $run_test = set_test_option("TEST", $i);
2166     $addconfig = set_test_option("ADD_CONFIG", $i);
2167     $reboot_type = set_test_option("REBOOT_TYPE", $i);
2168     $grub_menu = set_test_option("GRUB_MENU", $i);
2169     $post_install = set_test_option("POST_INSTALL", $i);
2170     $reboot_script = set_test_option("REBOOT_SCRIPT", $i);
2171     $reboot_on_error = set_test_option("REBOOT_ON_ERROR", $i);
2172     $poweroff_on_error = set_test_option("POWEROFF_ON_ERROR", $i);
2173     $die_on_failure = set_test_option("DIE_ON_FAILURE", $i);
2174     $power_off = set_test_option("POWER_OFF", $i);
2175     $powercycle_after_reboot = set_test_option("POWERCYCLE_AFTER_REBOOT", $i);
2176     $poweroff_after_halt = set_test_option("POWEROFF_AFTER_HALT", $i);
2177     $sleep_time = set_test_option("SLEEP_TIME", $i);
2178     $bisect_sleep_time = set_test_option("BISECT_SLEEP_TIME", $i);
2179     $patchcheck_sleep_time = set_test_option("PATCHCHECK_SLEEP_TIME", $i);
2180     $bisect_manual = set_test_option("BISECT_MANUAL", $i);
2181     $bisect_skip = set_test_option("BISECT_SKIP", $i);
2182     $config_bisect_good = set_test_option("CONFIG_BISECT_GOOD", $i);
2183     $store_failures = set_test_option("STORE_FAILURES", $i);
2184     $timeout = set_test_option("TIMEOUT", $i);
2185     $booted_timeout = set_test_option("BOOTED_TIMEOUT", $i);
2186     $console = set_test_option("CONSOLE", $i);
2187     $detect_triplefault = set_test_option("DETECT_TRIPLE_FAULT", $i);
2188     $success_line = set_test_option("SUCCESS_LINE", $i);
2189     $stop_after_success = set_test_option("STOP_AFTER_SUCCESS", $i);
2190     $stop_after_failure = set_test_option("STOP_AFTER_FAILURE", $i);
2191     $stop_test_after = set_test_option("STOP_TEST_AFTER", $i);
2192     $build_target = set_test_option("BUILD_TARGET", $i);
2193     $ssh_exec = set_test_option("SSH_EXEC", $i);
2194     $scp_to_target = set_test_option("SCP_TO_TARGET", $i);
2195     $target_image = set_test_option("TARGET_IMAGE", $i);
2196     $localversion = set_test_option("LOCALVERSION", $i);
2197
2198     chdir $builddir || die "can't change directory to $builddir";
2199
2200     if (!-d $tmpdir) {
2201         mkpath($tmpdir) or
2202             die "can't create $tmpdir";
2203     }
2204
2205     $ENV{"SSH_USER"} = $ssh_user;
2206     $ENV{"MACHINE"} = $machine;
2207
2208     $target = "$ssh_user\@$machine";
2209
2210     $buildlog = "$tmpdir/buildlog-$machine";
2211     $dmesg = "$tmpdir/dmesg-$machine";
2212     $make = "$makecmd O=$outputdir";
2213     $output_config = "$outputdir/.config";
2214
2215     if ($reboot_type eq "grub") {
2216         dodie "GRUB_MENU not defined" if (!defined($grub_menu));
2217     } elsif (!defined($reboot_script)) {
2218         dodie "REBOOT_SCRIPT not defined"
2219     }
2220
2221     my $run_type = $build_type;
2222     if ($test_type eq "patchcheck") {
2223         $run_type = $opt{"PATCHCHECK_TYPE[$i]"};
2224     } elsif ($test_type eq "bisect") {
2225         $run_type = $opt{"BISECT_TYPE[$i]"};
2226     } elsif ($test_type eq "config_bisect") {
2227         $run_type = $opt{"CONFIG_BISECT_TYPE[$i]"};
2228     }
2229
2230     # mistake in config file?
2231     if (!defined($run_type)) {
2232         $run_type = "ERROR";
2233     }
2234
2235     doprint "\n\n";
2236     doprint "RUNNING TEST $i of $opt{NUM_TESTS} with option $test_type $run_type\n\n";
2237
2238     unlink $dmesg;
2239     unlink $buildlog;
2240
2241     if (!defined($minconfig)) {
2242         $minconfig = $addconfig;
2243
2244     } elsif (defined($addconfig)) {
2245         run_command "cat $addconfig $minconfig > $tmpdir/add_config" or
2246             dodie "Failed to create temp config";
2247         $minconfig = "$tmpdir/add_config";
2248     }
2249
2250     my $checkout = $opt{"CHECKOUT[$i]"};
2251     if (defined($checkout)) {
2252         run_command "git checkout $checkout" or
2253             die "failed to checkout $checkout";
2254     }
2255
2256     if ($test_type eq "bisect") {
2257         bisect $i;
2258         next;
2259     } elsif ($test_type eq "config_bisect") {
2260         config_bisect $i;
2261         next;
2262     } elsif ($test_type eq "patchcheck") {
2263         patchcheck $i;
2264         next;
2265     }
2266
2267     if ($build_type ne "nobuild") {
2268         build $build_type or next;
2269     }
2270
2271     if ($test_type ne "build") {
2272         get_grub_index;
2273         get_version;
2274         install;
2275
2276         my $failed = 0;
2277         start_monitor;
2278         monitor or $failed = 1;;
2279
2280         if (!$failed && $test_type ne "boot" && defined($run_test)) {
2281             do_run_test or $failed = 1;
2282         }
2283         end_monitor;
2284         next if ($failed);
2285     }
2286
2287     success $i;
2288 }
2289
2290 if ($opt{"POWEROFF_ON_SUCCESS"}) {
2291     halt;
2292 } elsif ($opt{"REBOOT_ON_SUCCESS"} && !do_not_reboot) {
2293     reboot;
2294 }
2295
2296 doprint "\n    $successes of $opt{NUM_TESTS} tests were successful\n\n";
2297
2298 exit 0;