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/\${MACHINE}";
  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{"NO_INSTALL"}          = 0;
  46 $default{"BOOTED_TIMEOUT"}      = 1;
  47 $default{"DIE_ON_FAILURE"}      = 1;
  48 $default{"SSH_EXEC"}            = "ssh \$SSH_USER\@\$MACHINE \$SSH_COMMAND";
  49 $default{"SCP_TO_TARGET"}       = "scp \$SRC_FILE \$SSH_USER\@\$MACHINE:\$DST_FILE";
  50 $default{"REBOOT"}              = "ssh \$SSH_USER\@\$MACHINE reboot";
  51 $default{"STOP_AFTER_SUCCESS"}  = 10;
  52 $default{"STOP_AFTER_FAILURE"}  = 60;
  53 $default{"STOP_TEST_AFTER"}     = 600;
  54 $default{"LOCALVERSION"}        = "-test";
  55
  56 my $ktest_config;
  57 my $version;
  58 my $machine;
  59 my $ssh_user;
  60 my $tmpdir;
  61 my $builddir;
  62 my $outputdir;
  63 my $output_config;
  64 my $test_type;
  65 my $build_type;
  66 my $build_options;
  67 my $pre_build;
  68 my $post_build;
  69 my $pre_build_die;
  70 my $post_build_die;
  71 my $reboot_type;
  72 my $reboot_script;
  73 my $power_cycle;
  74 my $reboot;
  75 my $reboot_on_error;
  76 my $poweroff_on_error;
  77 my $die_on_failure;
  78 my $powercycle_after_reboot;
  79 my $poweroff_after_halt;
  80 my $ssh_exec;
  81 my $scp_to_target;
  82 my $power_off;
  83 my $grub_menu;
  84 my $grub_number;
  85 my $target;
  86 my $make;
  87 my $post_install;
  88 my $no_install;
  89 my $noclean;
  90 my $minconfig;
  91 my $start_minconfig;
  92 my $start_minconfig_defined;
  93 my $output_minconfig;
  94 my $ignore_config;
  95 my $addconfig;
  96 my $in_bisect = 0;
  97 my $bisect_bad = "";
  98 my $reverse_bisect;
  99 my $bisect_manual;
 100 my $bisect_skip;
 101 my $config_bisect_good;
 102 my $in_patchcheck = 0;
 103 my $run_test;
 104 my $redirect;
 105 my $buildlog;
 106 my $dmesg;
 107 my $monitor_fp;
 108 my $monitor_pid;
 109 my $monitor_cnt = 0;
 110 my $sleep_time;
 111 my $bisect_sleep_time;
 112 my $patchcheck_sleep_time;
 113 my $ignore_warnings;
 114 my $store_failures;
 115 my $test_name;
 116 my $timeout;
 117 my $booted_timeout;
 118 my $detect_triplefault;
 119 my $console;
 120 my $reboot_success_line;
 121 my $success_line;
 122 my $stop_after_success;
 123 my $stop_after_failure;
 124 my $stop_test_after;
 125 my $build_target;
 126 my $target_image;
 127 my $localversion;
 128 my $iteration = 0;
 129 my $successes = 0;
 130
 131 my %entered_configs;
 132 my %config_help;
 133 my %variable;
 134 my %force_config;
 135
 136 # do not force reboots on config problems
 137 my $no_reboot = 1;
 138
 139 $config_help{"MACHINE"} = << "EOF"
 140  The machine hostname that you will test.
 141 EOF
 142     ;
 143 $config_help{"SSH_USER"} = << "EOF"
 144  The box is expected to have ssh on normal bootup, provide the user
 145   (most likely root, since you need privileged operations)
 146 EOF
 147     ;
 148 $config_help{"BUILD_DIR"} = << "EOF"
 149  The directory that contains the Linux source code (full path).
 150 EOF
 151     ;
 152 $config_help{"OUTPUT_DIR"} = << "EOF"
 153  The directory that the objects will be built (full path).
 154  (can not be same as BUILD_DIR)
 155 EOF
 156     ;
 157 $config_help{"BUILD_TARGET"} = << "EOF"
 158  The location of the compiled file to copy to the target.
 159  (relative to OUTPUT_DIR)
 160 EOF
 161     ;
 162 $config_help{"TARGET_IMAGE"} = << "EOF"
 163  The place to put your image on the test machine.
 164 EOF
 165     ;
 166 $config_help{"POWER_CYCLE"} = << "EOF"
 167  A script or command to reboot the box.
 168
 169  Here is a digital loggers power switch example
 170  POWER_CYCLE = wget --no-proxy -O /dev/null -q  --auth-no-challenge 'http://admin:admin\@power/outlet?5=CCL'
 171
 172  Here is an example to reboot a virtual box on the current host
 173  with the name "Guest".
 174  POWER_CYCLE = virsh destroy Guest; sleep 5; virsh start Guest
 175 EOF
 176     ;
 177 $config_help{"CONSOLE"} = << "EOF"
 178  The script or command that reads the console
 179
 180   If you use ttywatch server, something like the following would work.
 181 CONSOLE = nc -d localhost 3001
 182
 183  For a virtual machine with guest name "Guest".
 184 CONSOLE =  virsh console Guest
 185 EOF
 186     ;
 187 $config_help{"LOCALVERSION"} = << "EOF"
 188  Required version ending to differentiate the test
 189  from other linux builds on the system.
 190 EOF
 191     ;
 192 $config_help{"REBOOT_TYPE"} = << "EOF"
 193  Way to reboot the box to the test kernel.
 194  Only valid options so far are "grub" and "script".
 195
 196  If you specify grub, it will assume grub version 1
 197  and will search in /boot/grub/menu.lst for the title \$GRUB_MENU
 198  and select that target to reboot to the kernel. If this is not
 199  your setup, then specify "script" and have a command or script
 200  specified in REBOOT_SCRIPT to boot to the target.
 201
 202  The entry in /boot/grub/menu.lst must be entered in manually.
 203  The test will not modify that file.
 204 EOF
 205     ;
 206 $config_help{"GRUB_MENU"} = << "EOF"
 207  The grub title name for the test kernel to boot
 208  (Only mandatory if REBOOT_TYPE = grub)
 209
 210  Note, ktest.pl will not update the grub menu.lst, you need to
 211  manually add an option for the test. ktest.pl will search
 212  the grub menu.lst for this option to find what kernel to
 213  reboot into.
 214
 215  For example, if in the /boot/grub/menu.lst the test kernel title has:
 216  title Test Kernel
 217  kernel vmlinuz-test
 218  GRUB_MENU = Test Kernel
 219 EOF
 220     ;
 221 $config_help{"REBOOT_SCRIPT"} = << "EOF"
 222  A script to reboot the target into the test kernel
 223  (Only mandatory if REBOOT_TYPE = script)
 224 EOF
 225     ;
 226
 227 sub read_yn {
 228     my ($prompt) = @_;
 229
 230     my $ans;
 231
 232     for (;;) {
 233         print "$prompt [Y/n] ";
 234         $ans = <STDIN>;
 235         chomp $ans;
 236         if ($ans =~ /^\s*$/) {
 237             $ans = "y";
 238         }
 239         last if ($ans =~ /^y$/i || $ans =~ /^n$/i);
 240         print "Please answer either 'y' or 'n'.\n";
 241     }
 242     if ($ans !~ /^y$/i) {
 243         return 0;
 244     }
 245     return 1;
 246 }
 247
 248 sub get_ktest_config {
 249     my ($config) = @_;
 250
 251     return if (defined($opt{$config}));
 252
 253     if (defined($config_help{$config})) {
 254         print "\n";
 255         print $config_help{$config};
 256     }
 257
 258     for (;;) {
 259         print "$config = ";
 260         if (defined($default{$config})) {
 261             print "\[$default{$config}\] ";
 262         }
 263         $entered_configs{$config} = <STDIN>;
 264         $entered_configs{$config} =~ s/^\s*(.*\S)\s*$/$1/;
 265         if ($entered_configs{$config} =~ /^\s*$/) {
 266             if ($default{$config}) {
 267                 $entered_configs{$config} = $default{$config};
 268             } else {
 269                 print "Your answer can not be blank\n";
 270                 next;
 271             }
 272         }
 273         last;
 274     }
 275 }
 276
 277 sub get_ktest_configs {
 278     get_ktest_config("MACHINE");
 279     get_ktest_config("SSH_USER");
 280     get_ktest_config("BUILD_DIR");
 281     get_ktest_config("OUTPUT_DIR");
 282     get_ktest_config("BUILD_TARGET");
 283     get_ktest_config("TARGET_IMAGE");
 284     get_ktest_config("POWER_CYCLE");
 285     get_ktest_config("CONSOLE");
 286     get_ktest_config("LOCALVERSION");
 287
 288     my $rtype = $opt{"REBOOT_TYPE"};
 289
 290     if (!defined($rtype)) {
 291         if (!defined($opt{"GRUB_MENU"})) {
 292             get_ktest_config("REBOOT_TYPE");
 293             $rtype = $entered_configs{"REBOOT_TYPE"};
 294         } else {
 295             $rtype = "grub";
 296         }
 297     }
 298
 299     if ($rtype eq "grub") {
 300         get_ktest_config("GRUB_MENU");
 301     } else {
 302         get_ktest_config("REBOOT_SCRIPT");
 303     }
 304 }
 305
 306 sub process_variables {
 307     my ($value) = @_;
 308     my $retval = "";
 309
 310     # We want to check for '\', and it is just easier
 311     # to check the previous characet of '$' and not need
 312     # to worry if '$' is the first character. By adding
 313     # a space to $value, we can just check [^\\]\$ and
 314     # it will still work.
 315     $value = " $value";
 316
 317     while ($value =~ /(.*?[^\\])\$\{(.*?)\}(.*)/) {
 318         my $begin = $1;
 319         my $var = $2;
 320         my $end = $3;
 321         # append beginning of value to retval
 322         $retval = "$retval$begin";
 323         if (defined($variable{$var})) {
 324             $retval = "$retval$variable{$var}";
 325         } else {
 326             # put back the origin piece.
 327             $retval = "$retval\$\{$var\}";
 328         }
 329         $value = $end;
 330     }
 331     $retval = "$retval$value";
 332
 333     # remove the space added in the beginning
 334     $retval =~ s/ //;
 335
 336     return "$retval"
 337 }
 338
 339 sub set_value {
 340     my ($lvalue, $rvalue) = @_;
 341
 342     if (defined($opt{$lvalue})) {
 343         die "Error: Option $lvalue defined more than once!\n";
 344     }
 345     if ($rvalue =~ /^\s*$/) {
 346         delete $opt{$lvalue};
 347     } else {
 348         $rvalue = process_variables($rvalue);
 349         $opt{$lvalue} = $rvalue;
 350     }
 351 }
 352
 353 sub set_variable {
 354     my ($lvalue, $rvalue) = @_;
 355
 356     if ($rvalue =~ /^\s*$/) {
 357         delete $variable{$lvalue};
 358     } else {
 359         $rvalue = process_variables($rvalue);
 360         $variable{$lvalue} = $rvalue;
 361     }
 362 }
 363
 364 sub process_compare {
 365     my ($lval, $cmp, $rval) = @_;
 366
 367     # remove whitespace
 368
 369     $lval =~ s/^\s*//;
 370     $lval =~ s/\s*$//;
 371
 372     $rval =~ s/^\s*//;
 373     $rval =~ s/\s*$//;
 374
 375     if ($cmp eq "==") {
 376         return $lval eq $rval;
 377     } elsif ($cmp eq "!=") {
 378         return $lval ne $rval;
 379     }
 380
 381     my $statement = "$lval $cmp $rval";
 382     my $ret = eval $statement;
 383
 384     # $@ stores error of eval
 385     if ($@) {
 386         return -1;
 387     }
 388
 389     return $ret;
 390 }
 391
 392 sub process_if {
 393     my ($name, $value) = @_;
 394
 395     my $val = process_variables($value);
 396
 397     if ($val =~ /(.*)(==|\!=|>=|<=|>|<)(.*)/) {
 398         my $ret = process_compare($1, $2, $3);
 399         if ($ret < 0) {
 400             die "$name: $.: Unable to process comparison\n";
 401         }
 402         return $ret;
 403     }
 404
 405     if ($val =~ /^\s*0\s*$/) {
 406         return 0;
 407     } elsif ($val =~ /^\s*\d+\s*$/) {
 408         return 1;
 409     }
 410
 411     die ("$name: $.: Undefined variable $val in if statement\n");
 412     return 1;
 413 }
 414
 415 sub read_config {
 416     my ($config) = @_;
 417
 418     open(IN, $config) || die "can't read file $config";
 419
 420     my $name = $config;
 421     $name =~ s,.*/(.*),$1,;
 422
 423     my $test_num = 0;
 424     my $default = 1;
 425     my $repeat = 1;
 426     my $num_tests_set = 0;
 427     my $skip = 0;
 428     my $rest;
 429     my $test_case = 0;
 430     my $if = 0;
 431     my $if_set = 0;
 432
 433     while (<IN>) {
 434
 435         # ignore blank lines and comments
 436         next if (/^\s*$/ || /\s*\#/);
 437
 438         if (/^\s*TEST_START(.*)/) {
 439
 440             $rest = $1;
 441
 442             if ($num_tests_set) {
 443                 die "$name: $.: Can not specify both NUM_TESTS and TEST_START\n";
 444             }
 445
 446             my $old_test_num = $test_num;
 447             my $old_repeat = $repeat;
 448
 449             $test_num += $repeat;
 450             $default = 0;
 451             $repeat = 1;
 452
 453             if ($rest =~ /\s+SKIP\b(.*)/) {
 454                 $rest = $1;
 455                 $skip = 1;
 456             } else {
 457                 $test_case = 1;
 458                 $skip = 0;
 459             }
 460
 461             if ($rest =~ /\s+ITERATE\s+(\d+)(.*)$/) {
 462                 $repeat = $1;
 463                 $rest = $2;
 464                 $repeat_tests{"$test_num"} = $repeat;
 465             }
 466
 467             if ($rest =~ /\sIF\s+(.*)/) {
 468                 $rest = "";
 469                 if (process_if($name, $1)) {
 470                     $if_set = 1;
 471                 } else {
 472                     $skip = 1;
 473                 }
 474                 $if = 1;
 475             } else {
 476                 $if = 0;
 477             }
 478
 479             if ($rest !~ /^\s*$/) {
 480                 die "$name: $.: Gargbage found after TEST_START\n$_";
 481             }
 482
 483             if ($skip) {
 484                 $test_num = $old_test_num;
 485                 $repeat = $old_repeat;
 486             }
 487
 488         } elsif (/^\s*DEFAULTS(.*)$/) {
 489             $default = 1;
 490
 491             $rest = $1;
 492
 493             if ($rest =~ /\s+SKIP(.*)/) {
 494                 $rest = $1;
 495                 $skip = 1;
 496             } else {
 497                 $skip = 0;
 498             }
 499
 500             if ($rest =~ /\sIF\s+(.*)/) {
 501                 $if = 1;
 502                 if (process_if($name, $1)) {
 503                     $if_set = 1;
 504                 } else {
 505                     $skip = 1;
 506                 }
 507                 $rest = "";
 508             } else {
 509                 $if = 0;
 510             }
 511
 512             if ($rest !~ /^\s*$/) {
 513                 die "$name: $.: Gargbage found after DEFAULTS\n$_";
 514             }
 515
 516         } elsif (/^\s*ELSE\b(.*)$/) {
 517             if (!$if) {
 518                 die "$name: $.: ELSE found with out matching IF section\n$_";
 519             }
 520             $rest = $1;
 521             if ($if_set) {
 522                 $skip = 1;
 523                 $rest = "";
 524             } else {
 525                 $skip = 0;
 526
 527                 if ($rest =~ /\sIF\s+(.*)/) {
 528                     # May be a ELSE IF section.
 529                     if (!process_if($name, $1)) {
 530                         $skip = 1;
 531                     }
 532                     $rest = "";
 533                 } else {
 534                     $if = 0;
 535                 }
 536             }
 537
 538             if ($rest !~ /^\s*$/) {
 539                 die "$name: $.: Gargbage found after DEFAULTS\n$_";
 540             }
 541
 542         } elsif (/^\s*([A-Z_\[\]\d]+)\s*=\s*(.*?)\s*$/) {
 543
 544             next if ($skip);
 545
 546             my $lvalue = $1;
 547             my $rvalue = $2;
 548
 549             if (!$default &&
 550                 ($lvalue eq "NUM_TESTS" ||
 551                  $lvalue eq "LOG_FILE" ||
 552                  $lvalue eq "CLEAR_LOG")) {
 553                 die "$name: $.: $lvalue must be set in DEFAULTS section\n";
 554             }
 555
 556             if ($lvalue eq "NUM_TESTS") {
 557                 if ($test_num) {
 558                     die "$name: $.: Can not specify both NUM_TESTS and TEST_START\n";
 559                 }
 560                 if (!$default) {
 561                     die "$name: $.: NUM_TESTS must be set in default section\n";
 562                 }
 563                 $num_tests_set = 1;
 564             }
 565
 566             if ($default || $lvalue =~ /\[\d+\]$/) {
 567                 set_value($lvalue, $rvalue);
 568             } else {
 569                 my $val = "$lvalue\[$test_num\]";
 570                 set_value($val, $rvalue);
 571
 572                 if ($repeat > 1) {
 573                     $repeats{$val} = $repeat;
 574                 }
 575             }
 576         } elsif (/^\s*([A-Z_\[\]\d]+)\s*:=\s*(.*?)\s*$/) {
 577             next if ($skip);
 578
 579             my $lvalue = $1;
 580             my $rvalue = $2;
 581
 582             # process config variables.
 583             # Config variables are only active while reading the
 584             # config and can be defined anywhere. They also ignore
 585             # TEST_START and DEFAULTS, but are skipped if they are in
 586             # on of these sections that have SKIP defined.
 587             # The save variable can be
 588             # defined multiple times and the new one simply overrides
 589             # the prevous one.
 590             set_variable($lvalue, $rvalue);
 591
 592         } else {
 593             die "$name: $.: Garbage found in config\n$_";
 594         }
 595     }
 596
 597     close(IN);
 598
 599     if ($test_num) {
 600         $test_num += $repeat - 1;
 601         $opt{"NUM_TESTS"} = $test_num;
 602     }
 603
 604     # make sure we have all mandatory configs
 605     get_ktest_configs;
 606
 607     # was a test specified?
 608     if (!$test_case) {
 609         print "No test case specified.\n";
 610         print "What test case would you like to run?\n";
 611         my $ans = <STDIN>;
 612         chomp $ans;
 613         $default{"TEST_TYPE"} = $ans;
 614     }
 615
 616     # set any defaults
 617
 618     foreach my $default (keys %default) {
 619         if (!defined($opt{$default})) {
 620             $opt{$default} = $default{$default};
 621         }
 622     }
 623 }
 624
 625 sub __eval_option {
 626     my ($option, $i) = @_;
 627
 628     # Add space to evaluate the character before $
 629     $option = " $option";
 630     my $retval = "";
 631
 632     while ($option =~ /(.*?[^\\])\$\{(.*?)\}(.*)/) {
 633         my $start = $1;
 634         my $var = $2;
 635         my $end = $3;
 636
 637         # Append beginning of line
 638         $retval = "$retval$start";
 639
 640         # If the iteration option OPT[$i] exists, then use that.
 641         # otherwise see if the default OPT (without [$i]) exists.
 642
 643         my $o = "$var\[$i\]";
 644
 645         if (defined($opt{$o})) {
 646             $o = $opt{$o};
 647             $retval = "$retval$o";
 648         } elsif (defined($opt{$var})) {
 649             $o = $opt{$var};
 650             $retval = "$retval$o";
 651         } else {
 652             $retval = "$retval\$\{$var\}";
 653         }
 654
 655         $option = $end;
 656     }
 657
 658     $retval = "$retval$option";
 659
 660     $retval =~ s/^ //;
 661
 662     return $retval;
 663 }
 664
 665 sub eval_option {
 666     my ($option, $i) = @_;
 667
 668     my $prev = "";
 669
 670     # Since an option can evaluate to another option,
 671     # keep iterating until we do not evaluate any more
 672     # options.
 673     my $r = 0;
 674     while ($prev ne $option) {
 675         # Check for recursive evaluations.
 676         # 100 deep should be more than enough.
 677         if ($r++ > 100) {
 678             die "Over 100 evaluations accurred with $option\n" .
 679                 "Check for recursive variables\n";
 680         }
 681         $prev = $option;
 682         $option = __eval_option($option, $i);
 683     }
 684
 685     return $option;
 686 }
 687
 688 sub _logit {
 689     if (defined($opt{"LOG_FILE"})) {
 690         open(OUT, ">> $opt{LOG_FILE}") or die "Can't write to $opt{LOG_FILE}";
 691         print OUT @_;
 692         close(OUT);
 693     }
 694 }
 695
 696 sub logit {
 697     if (defined($opt{"LOG_FILE"})) {
 698         _logit @_;
 699     } else {
 700         print @_;
 701     }
 702 }
 703
 704 sub doprint {
 705     print @_;
 706     _logit @_;
 707 }
 708
 709 sub run_command;
 710 sub start_monitor;
 711 sub end_monitor;
 712 sub wait_for_monitor;
 713
 714 sub reboot {
 715     my ($time) = @_;
 716
 717     if (defined($time)) {
 718         start_monitor;
 719         # flush out current monitor
 720         # May contain the reboot success line
 721         wait_for_monitor 1;
 722     }
 723
 724     # try to reboot normally
 725     if (run_command $reboot) {
 726         if (defined($powercycle_after_reboot)) {
 727             sleep $powercycle_after_reboot;
 728             run_command "$power_cycle";
 729         }
 730     } else {
 731         # nope? power cycle it.
 732         run_command "$power_cycle";
 733     }
 734
 735     if (defined($time)) {
 736         wait_for_monitor($time, $reboot_success_line);
 737         end_monitor;
 738     }
 739 }
 740
 741 sub do_not_reboot {
 742     my $i = $iteration;
 743
 744     return $test_type eq "build" || $no_reboot ||
 745         ($test_type eq "patchcheck" && $opt{"PATCHCHECK_TYPE[$i]"} eq "build") ||
 746         ($test_type eq "bisect" && $opt{"BISECT_TYPE[$i]"} eq "build");
 747 }
 748
 749 sub dodie {
 750     doprint "CRITICAL FAILURE... ", @_, "\n";
 751
 752     my $i = $iteration;
 753
 754     if ($reboot_on_error && !do_not_reboot) {
 755
 756         doprint "REBOOTING\n";
 757         reboot;
 758
 759     } elsif ($poweroff_on_error && defined($power_off)) {
 760         doprint "POWERING OFF\n";
 761         `$power_off`;
 762     }
 763
 764     if (defined($opt{"LOG_FILE"})) {
 765         print " See $opt{LOG_FILE} for more info.\n";
 766     }
 767
 768     die @_, "\n";
 769 }
 770
 771 sub open_console {
 772     my ($fp) = @_;
 773
 774     my $flags;
 775
 776     my $pid = open($fp, "$console|") or
 777         dodie "Can't open console $console";
 778
 779     $flags = fcntl($fp, F_GETFL, 0) or
 780         dodie "Can't get flags for the socket: $!";
 781     $flags = fcntl($fp, F_SETFL, $flags | O_NONBLOCK) or
 782         dodie "Can't set flags for the socket: $!";
 783
 784     return $pid;
 785 }
 786
 787 sub close_console {
 788     my ($fp, $pid) = @_;
 789
 790     doprint "kill child process $pid\n";
 791     kill 2, $pid;
 792
 793     print "closing!\n";
 794     close($fp);
 795 }
 796
 797 sub start_monitor {
 798     if ($monitor_cnt++) {
 799         return;
 800     }
 801     $monitor_fp = \*MONFD;
 802     $monitor_pid = open_console $monitor_fp;
 803
 804     return;
 805
 806     open(MONFD, "Stop perl from warning about single use of MONFD");
 807 }
 808
 809 sub end_monitor {
 810     if (--$monitor_cnt) {
 811         return;
 812     }
 813     close_console($monitor_fp, $monitor_pid);
 814 }
 815
 816 sub wait_for_monitor {
 817     my ($time, $stop) = @_;
 818     my $full_line = "";
 819     my $line;
 820     my $booted = 0;
 821
 822     doprint "** Wait for monitor to settle down **\n";
 823
 824     # read the monitor and wait for the system to calm down
 825     while (!$booted) {
 826         $line = wait_for_input($monitor_fp, $time);
 827         last if (!defined($line));
 828         print "$line";
 829         $full_line .= $line;
 830
 831         if (defined($stop) && $full_line =~ /$stop/) {
 832             doprint "wait for monitor detected $stop\n";
 833             $booted = 1;
 834         }
 835
 836         if ($line =~ /\n/) {
 837             $full_line = "";
 838         }
 839     }
 840     print "** Monitor flushed **\n";
 841 }
 842
 843 sub fail {
 844
 845         if ($die_on_failure) {
 846                 dodie @_;
 847         }
 848
 849         doprint "FAILED\n";
 850
 851         my $i = $iteration;
 852
 853         # no need to reboot for just building.
 854         if (!do_not_reboot) {
 855             doprint "REBOOTING\n";
 856             reboot $sleep_time;
 857         }
 858
 859         my $name = "";
 860
 861         if (defined($test_name)) {
 862             $name = " ($test_name)";
 863         }
 864
 865         doprint "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n";
 866         doprint "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n";
 867         doprint "KTEST RESULT: TEST $i$name Failed: ", @_, "\n";
 868         doprint "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n";
 869         doprint "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n";
 870
 871         return 1 if (!defined($store_failures));
 872
 873         my @t = localtime;
 874         my $date = sprintf "%04d%02d%02d%02d%02d%02d",
 875                 1900+$t[5],$t[4],$t[3],$t[2],$t[1],$t[0];
 876
 877         my $type = $build_type;
 878         if ($type =~ /useconfig/) {
 879             $type = "useconfig";
 880         }
 881
 882         my $dir = "$machine-$test_type-$type-fail-$date";
 883         my $faildir = "$store_failures/$dir";
 884
 885         if (!-d $faildir) {
 886             mkpath($faildir) or
 887                 die "can't create $faildir";
 888         }
 889         if (-f "$output_config") {
 890             cp "$output_config", "$faildir/config" or
 891                 die "failed to copy .config";
 892         }
 893         if (-f $buildlog) {
 894             cp $buildlog, "$faildir/buildlog" or
 895                 die "failed to move $buildlog";
 896         }
 897         if (-f $dmesg) {
 898             cp $dmesg, "$faildir/dmesg" or
 899                 die "failed to move $dmesg";
 900         }
 901
 902         doprint "*** Saved info to $faildir ***\n";
 903
 904         return 1;
 905 }
 906
 907 sub run_command {
 908     my ($command) = @_;
 909     my $dolog = 0;
 910     my $dord = 0;
 911     my $pid;
 912
 913     $command =~ s/\$SSH_USER/$ssh_user/g;
 914     $command =~ s/\$MACHINE/$machine/g;
 915
 916     doprint("$command ... ");
 917
 918     $pid = open(CMD, "$command 2>&1 |") or
 919         (fail "unable to exec $command" and return 0);
 920
 921     if (defined($opt{"LOG_FILE"})) {
 922         open(LOG, ">>$opt{LOG_FILE}") or
 923             dodie "failed to write to log";
 924         $dolog = 1;
 925     }
 926
 927     if (defined($redirect)) {
 928         open (RD, ">$redirect") or
 929             dodie "failed to write to redirect $redirect";
 930         $dord = 1;
 931     }
 932
 933     while (<CMD>) {
 934         print LOG if ($dolog);
 935         print RD  if ($dord);
 936     }
 937
 938     waitpid($pid, 0);
 939     my $failed = $?;
 940
 941     close(CMD);
 942     close(LOG) if ($dolog);
 943     close(RD)  if ($dord);
 944
 945     if ($failed) {
 946         doprint "FAILED!\n";
 947     } else {
 948         doprint "SUCCESS\n";
 949     }
 950
 951     return !$failed;
 952 }
 953
 954 sub run_ssh {
 955     my ($cmd) = @_;
 956     my $cp_exec = $ssh_exec;
 957
 958     $cp_exec =~ s/\$SSH_COMMAND/$cmd/g;
 959     return run_command "$cp_exec";
 960 }
 961
 962 sub run_scp {
 963     my ($src, $dst) = @_;
 964     my $cp_scp = $scp_to_target;
 965
 966     $cp_scp =~ s/\$SRC_FILE/$src/g;
 967     $cp_scp =~ s/\$DST_FILE/$dst/g;
 968
 969     return run_command "$cp_scp";
 970 }
 971
 972 sub get_grub_index {
 973
 974     if ($reboot_type ne "grub") {
 975         return;
 976     }
 977     return if (defined($grub_number));
 978
 979     doprint "Find grub menu ... ";
 980     $grub_number = -1;
 981
 982     my $ssh_grub = $ssh_exec;
 983     $ssh_grub =~ s,\$SSH_COMMAND,cat /boot/grub/menu.lst,g;
 984
 985     open(IN, "$ssh_grub |")
 986         or die "unable to get menu.lst";
 987
 988     my $found = 0;
 989
 990     while (<IN>) {
 991         if (/^\s*title\s+$grub_menu\s*$/) {
 992             $grub_number++;
 993             $found = 1;
 994             last;
 995         } elsif (/^\s*title\s/) {
 996             $grub_number++;
 997         }
 998     }
 999     close(IN);
1000
1001     die "Could not find '$grub_menu' in /boot/grub/menu on $machine"
1002         if (!$found);
1003     doprint "$grub_number\n";
1004 }
1005
1006 sub wait_for_input
1007 {
1008     my ($fp, $time) = @_;
1009     my $rin;
1010     my $ready;
1011     my $line;
1012     my $ch;
1013
1014     if (!defined($time)) {
1015         $time = $timeout;
1016     }
1017
1018     $rin = '';
1019     vec($rin, fileno($fp), 1) = 1;
1020     $ready = select($rin, undef, undef, $time);
1021
1022     $line = "";
1023
1024     # try to read one char at a time
1025     while (sysread $fp, $ch, 1) {
1026         $line .= $ch;
1027         last if ($ch eq "\n");
1028     }
1029
1030     if (!length($line)) {
1031         return undef;
1032     }
1033
1034     return $line;
1035 }
1036
1037 sub reboot_to {
1038     if ($reboot_type eq "grub") {
1039         run_ssh "'(echo \"savedefault --default=$grub_number --once\" | grub --batch && reboot)'";
1040         return;
1041     }
1042
1043     run_command "$reboot_script";
1044 }
1045
1046 sub get_sha1 {
1047     my ($commit) = @_;
1048
1049     doprint "git rev-list --max-count=1 $commit ... ";
1050     my $sha1 = `git rev-list --max-count=1 $commit`;
1051     my $ret = $?;
1052
1053     logit $sha1;
1054
1055     if ($ret) {
1056         doprint "FAILED\n";
1057         dodie "Failed to get git $commit";
1058     }
1059
1060     print "SUCCESS\n";
1061
1062     chomp $sha1;
1063
1064     return $sha1;
1065 }
1066
1067 sub monitor {
1068     my $booted = 0;
1069     my $bug = 0;
1070     my $skip_call_trace = 0;
1071     my $loops;
1072
1073     wait_for_monitor 5;
1074
1075     my $line;
1076     my $full_line = "";
1077
1078     open(DMESG, "> $dmesg") or
1079         die "unable to write to $dmesg";
1080
1081     reboot_to;
1082
1083     my $success_start;
1084     my $failure_start;
1085     my $monitor_start = time;
1086     my $done = 0;
1087     my $version_found = 0;
1088
1089     while (!$done) {
1090
1091         if ($bug && defined($stop_after_failure) &&
1092             $stop_after_failure >= 0) {
1093             my $time = $stop_after_failure - (time - $failure_start);
1094             $line = wait_for_input($monitor_fp, $time);
1095             if (!defined($line)) {
1096                 doprint "bug timed out after $booted_timeout seconds\n";
1097                 doprint "Test forced to stop after $stop_after_failure seconds after failure\n";
1098                 last;
1099             }
1100         } elsif ($booted) {
1101             $line = wait_for_input($monitor_fp, $booted_timeout);
1102             if (!defined($line)) {
1103                 my $s = $booted_timeout == 1 ? "" : "s";
1104                 doprint "Successful boot found: break after $booted_timeout second$s\n";
1105                 last;
1106             }
1107         } else {
1108             $line = wait_for_input($monitor_fp);
1109             if (!defined($line)) {
1110                 my $s = $timeout == 1 ? "" : "s";
1111                 doprint "Timed out after $timeout second$s\n";
1112                 last;
1113             }
1114         }
1115
1116         doprint $line;
1117         print DMESG $line;
1118
1119         # we are not guaranteed to get a full line
1120         $full_line .= $line;
1121
1122         if ($full_line =~ /$success_line/) {
1123             $booted = 1;
1124             $success_start = time;
1125         }
1126
1127         if ($booted && defined($stop_after_success) &&
1128             $stop_after_success >= 0) {
1129             my $now = time;
1130             if ($now - $success_start >= $stop_after_success) {
1131                 doprint "Test forced to stop after $stop_after_success seconds after success\n";
1132                 last;
1133             }
1134         }
1135
1136         if ($full_line =~ /\[ backtrace testing \]/) {
1137             $skip_call_trace = 1;
1138         }
1139
1140         if ($full_line =~ /call trace:/i) {
1141             if (!$bug && !$skip_call_trace) {
1142                 $bug = 1;
1143                 $failure_start = time;
1144             }
1145         }
1146
1147         if ($bug && defined($stop_after_failure) &&
1148             $stop_after_failure >= 0) {
1149             my $now = time;
1150             if ($now - $failure_start >= $stop_after_failure) {
1151                 doprint "Test forced to stop after $stop_after_failure seconds after failure\n";
1152                 last;
1153             }
1154         }
1155
1156         if ($full_line =~ /\[ end of backtrace testing \]/) {
1157             $skip_call_trace = 0;
1158         }
1159
1160         if ($full_line =~ /Kernel panic -/) {
1161             $failure_start = time;
1162             $bug = 1;
1163         }
1164
1165         # Detect triple faults by testing the banner
1166         if ($full_line =~ /\bLinux version (\S+).*\n/) {
1167             if ($1 eq $version) {
1168                 $version_found = 1;
1169             } elsif ($version_found && $detect_triplefault) {
1170                 # We already booted into the kernel we are testing,
1171                 # but now we booted into another kernel?
1172                 # Consider this a triple fault.
1173                 doprint "Aleady booted in Linux kernel $version, but now\n";
1174                 doprint "we booted into Linux kernel $1.\n";
1175                 doprint "Assuming that this is a triple fault.\n";
1176                 doprint "To disable this: set DETECT_TRIPLE_FAULT to 0\n";
1177                 last;
1178             }
1179         }
1180
1181         if ($line =~ /\n/) {
1182             $full_line = "";
1183         }
1184
1185         if ($stop_test_after > 0 && !$booted && !$bug) {
1186             if (time - $monitor_start > $stop_test_after) {
1187                 doprint "STOP_TEST_AFTER ($stop_test_after seconds) timed out\n";
1188                 $done = 1;
1189             }
1190         }
1191     }
1192
1193     close(DMESG);
1194
1195     if ($bug) {
1196         return 0 if ($in_bisect);
1197         fail "failed - got a bug report" and return 0;
1198     }
1199
1200     if (!$booted) {
1201         return 0 if ($in_bisect);
1202         fail "failed - never got a boot prompt." and return 0;
1203     }
1204
1205     return 1;
1206 }
1207
1208 sub do_post_install {
1209
1210     return if (!defined($post_install));
1211
1212     my $cp_post_install = $post_install;
1213     $cp_post_install =~ s/\$KERNEL_VERSION/$version/g;
1214     run_command "$cp_post_install" or
1215         dodie "Failed to run post install";
1216 }
1217
1218 sub install {
1219
1220     return if ($no_install);
1221
1222     run_scp "$outputdir/$build_target", "$target_image" or
1223         dodie "failed to copy image";
1224
1225     my $install_mods = 0;
1226
1227     # should we process modules?
1228     $install_mods = 0;
1229     open(IN, "$output_config") or dodie("Can't read config file");
1230     while (<IN>) {
1231         if (/CONFIG_MODULES(=y)?/) {
1232             $install_mods = 1 if (defined($1));
1233             last;
1234         }
1235     }
1236     close(IN);
1237
1238     if (!$install_mods) {
1239         do_post_install;
1240         doprint "No modules needed\n";
1241         return;
1242     }
1243
1244     run_command "$make INSTALL_MOD_PATH=$tmpdir modules_install" or
1245         dodie "Failed to install modules";
1246
1247     my $modlib = "/lib/modules/$version";
1248     my $modtar = "ktest-mods.tar.bz2";
1249
1250     run_ssh "rm -rf $modlib" or
1251         dodie "failed to remove old mods: $modlib";
1252
1253     # would be nice if scp -r did not follow symbolic links
1254     run_command "cd $tmpdir && tar -cjf $modtar lib/modules/$version" or
1255         dodie "making tarball";
1256
1257     run_scp "$tmpdir/$modtar", "/tmp" or
1258         dodie "failed to copy modules";
1259
1260     unlink "$tmpdir/$modtar";
1261
1262     run_ssh "'(cd / && tar xjf /tmp/$modtar)'" or
1263         dodie "failed to tar modules";
1264
1265     run_ssh "rm -f /tmp/$modtar";
1266
1267     do_post_install;
1268 }
1269
1270 sub get_version {
1271     # get the release name
1272     doprint "$make kernelrelease ... ";
1273     $version = `$make kernelrelease | tail -1`;
1274     chomp($version);
1275     doprint "$version\n";
1276 }
1277
1278 sub start_monitor_and_boot {
1279     get_grub_index;
1280     get_version;
1281     install;
1282
1283     start_monitor;
1284     return monitor;
1285 }
1286
1287 sub check_buildlog {
1288     my ($patch) = @_;
1289
1290     my @files = `git show $patch | diffstat -l`;
1291
1292     open(IN, "git show $patch |") or
1293         dodie "failed to show $patch";
1294     while (<IN>) {
1295         if (m,^--- a/(.*),) {
1296             chomp $1;
1297             $files[$#files] = $1;
1298         }
1299     }
1300     close(IN);
1301
1302     open(IN, $buildlog) or dodie "Can't open $buildlog";
1303     while (<IN>) {
1304         if (/^\s*(.*?):.*(warning|error)/) {
1305             my $err = $1;
1306             foreach my $file (@files) {
1307                 my $fullpath = "$builddir/$file";
1308                 if ($file eq $err || $fullpath eq $err) {
1309                     fail "$file built with warnings" and return 0;
1310                 }
1311             }
1312         }
1313     }
1314     close(IN);
1315
1316     return 1;
1317 }
1318
1319 sub apply_min_config {
1320     my $outconfig = "$output_config.new";
1321
1322     # Read the config file and remove anything that
1323     # is in the force_config hash (from minconfig and others)
1324     # then add the force config back.
1325
1326     doprint "Applying minimum configurations into $output_config.new\n";
1327
1328     open (OUT, ">$outconfig") or
1329         dodie "Can't create $outconfig";
1330
1331     if (-f $output_config) {
1332         open (IN, $output_config) or
1333             dodie "Failed to open $output_config";
1334         while (<IN>) {
1335             if (/^(# )?(CONFIG_[^\s=]*)/) {
1336                 next if (defined($force_config{$2}));
1337             }
1338             print OUT;
1339         }
1340         close IN;
1341     }
1342     foreach my $config (keys %force_config) {
1343         print OUT "$force_config{$config}\n";
1344     }
1345     close OUT;
1346
1347     run_command "mv $outconfig $output_config";
1348 }
1349
1350 sub make_oldconfig {
1351
1352     my @force_list = keys %force_config;
1353
1354     if ($#force_list >= 0) {
1355         apply_min_config;
1356     }
1357
1358     if (!run_command "$make oldnoconfig") {
1359         # Perhaps oldnoconfig doesn't exist in this version of the kernel
1360         # try a yes '' | oldconfig
1361         doprint "oldnoconfig failed, trying yes '' | make oldconfig\n";
1362         run_command "yes '' | $make oldconfig" or
1363             dodie "failed make config oldconfig";
1364     }
1365 }
1366
1367 # read a config file and use this to force new configs.
1368 sub load_force_config {
1369     my ($config) = @_;
1370
1371     open(IN, $config) or
1372         dodie "failed to read $config";
1373     while (<IN>) {
1374         chomp;
1375         if (/^(CONFIG[^\s=]*)(\s*=.*)/) {
1376             $force_config{$1} = $_;
1377         } elsif (/^# (CONFIG_\S*) is not set/) {
1378             $force_config{$1} = $_;
1379         }
1380     }
1381     close IN;
1382 }
1383
1384 sub build {
1385     my ($type) = @_;
1386
1387     unlink $buildlog;
1388
1389     # Failed builds should not reboot the target
1390     my $save_no_reboot = $no_reboot;
1391     $no_reboot = 1;
1392
1393     if (defined($pre_build)) {
1394         my $ret = run_command $pre_build;
1395         if (!$ret && defined($pre_build_die) &&
1396             $pre_build_die) {
1397             dodie "failed to pre_build\n";
1398         }
1399     }
1400
1401     if ($type =~ /^useconfig:(.*)/) {
1402         run_command "cp $1 $output_config" or
1403             dodie "could not copy $1 to .config";
1404
1405         $type = "oldconfig";
1406     }
1407
1408     # old config can ask questions
1409     if ($type eq "oldconfig") {
1410         $type = "oldnoconfig";
1411
1412         # allow for empty configs
1413         run_command "touch $output_config";
1414
1415         if (!$noclean) {
1416             run_command "mv $output_config $outputdir/config_temp" or
1417                 dodie "moving .config";
1418
1419             run_command "$make mrproper" or dodie "make mrproper";
1420
1421             run_command "mv $outputdir/config_temp $output_config" or
1422                 dodie "moving config_temp";
1423         }
1424
1425     } elsif (!$noclean) {
1426         unlink "$output_config";
1427         run_command "$make mrproper" or
1428             dodie "make mrproper";
1429     }
1430
1431     # add something to distinguish this build
1432     open(OUT, "> $outputdir/localversion") or dodie("Can't make localversion file");
1433     print OUT "$localversion\n";
1434     close(OUT);
1435
1436     if (defined($minconfig)) {
1437         load_force_config($minconfig);
1438     }
1439
1440     if ($type ne "oldnoconfig") {
1441         run_command "$make $type" or
1442             dodie "failed make config";
1443     }
1444     # Run old config regardless, to enforce min configurations
1445     make_oldconfig;
1446
1447     $redirect = "$buildlog";
1448     my $build_ret = run_command "$make $build_options";
1449     undef $redirect;
1450
1451     if (defined($post_build)) {
1452         my $ret = run_command $post_build;
1453         if (!$ret && defined($post_build_die) &&
1454             $post_build_die) {
1455             dodie "failed to post_build\n";
1456         }
1457     }
1458
1459     if (!$build_ret) {
1460         # bisect may need this to pass
1461         if ($in_bisect) {
1462             $no_reboot = $save_no_reboot;
1463             return 0;
1464         }
1465         fail "failed build" and return 0;
1466     }
1467
1468     $no_reboot = $save_no_reboot;
1469
1470     return 1;
1471 }
1472
1473 sub halt {
1474     if (!run_ssh "halt" or defined($power_off)) {
1475         if (defined($poweroff_after_halt)) {
1476             sleep $poweroff_after_halt;
1477             run_command "$power_off";
1478         }
1479     } else {
1480         # nope? the zap it!
1481         run_command "$power_off";
1482     }
1483 }
1484
1485 sub success {
1486     my ($i) = @_;
1487
1488     $successes++;
1489
1490     my $name = "";
1491
1492     if (defined($test_name)) {
1493         $name = " ($test_name)";
1494     }
1495
1496     doprint "\n\n*******************************************\n";
1497     doprint     "*******************************************\n";
1498     doprint     "KTEST RESULT: TEST $i$name SUCCESS!!!!         **\n";
1499     doprint     "*******************************************\n";
1500     doprint     "*******************************************\n";
1501
1502     if ($i != $opt{"NUM_TESTS"} && !do_not_reboot) {
1503         doprint "Reboot and wait $sleep_time seconds\n";
1504         reboot $sleep_time;
1505     }
1506 }
1507
1508 sub answer_bisect {
1509     for (;;) {
1510         doprint "Pass or fail? [p/f]";
1511         my $ans = <STDIN>;
1512         chomp $ans;
1513         if ($ans eq "p" || $ans eq "P") {
1514             return 1;
1515         } elsif ($ans eq "f" || $ans eq "F") {
1516             return 0;
1517         } else {
1518             print "Please answer 'P' or 'F'\n";
1519         }
1520     }
1521 }
1522
1523 sub child_run_test {
1524     my $failed = 0;
1525
1526     # child should have no power
1527     $reboot_on_error = 0;
1528     $poweroff_on_error = 0;
1529     $die_on_failure = 1;
1530
1531     run_command $run_test or $failed = 1;
1532     exit $failed;
1533 }
1534
1535 my $child_done;
1536
1537 sub child_finished {
1538     $child_done = 1;
1539 }
1540
1541 sub do_run_test {
1542     my $child_pid;
1543     my $child_exit;
1544     my $line;
1545     my $full_line;
1546     my $bug = 0;
1547
1548     wait_for_monitor 1;
1549
1550     doprint "run test $run_test\n";
1551
1552     $child_done = 0;
1553
1554     $SIG{CHLD} = qw(child_finished);
1555
1556     $child_pid = fork;
1557
1558     child_run_test if (!$child_pid);
1559
1560     $full_line = "";
1561
1562     do {
1563         $line = wait_for_input($monitor_fp, 1);
1564         if (defined($line)) {
1565
1566             # we are not guaranteed to get a full line
1567             $full_line .= $line;
1568             doprint $line;
1569
1570             if ($full_line =~ /call trace:/i) {
1571                 $bug = 1;
1572             }
1573
1574             if ($full_line =~ /Kernel panic -/) {
1575                 $bug = 1;
1576             }
1577
1578             if ($line =~ /\n/) {
1579                 $full_line = "";
1580             }
1581         }
1582     } while (!$child_done && !$bug);
1583
1584     if ($bug) {
1585         my $failure_start = time;
1586         my $now;
1587         do {
1588             $line = wait_for_input($monitor_fp, 1);
1589             if (defined($line)) {
1590                 doprint $line;
1591             }
1592             $now = time;
1593             if ($now - $failure_start >= $stop_after_failure) {
1594                 last;
1595             }
1596         } while (defined($line));
1597
1598         doprint "Detected kernel crash!\n";
1599         # kill the child with extreme prejudice
1600         kill 9, $child_pid;
1601     }
1602
1603     waitpid $child_pid, 0;
1604     $child_exit = $?;
1605
1606     if ($bug || $child_exit) {
1607         return 0 if $in_bisect;
1608         fail "test failed" and return 0;
1609     }
1610     return 1;
1611 }
1612
1613 sub run_git_bisect {
1614     my ($command) = @_;
1615
1616     doprint "$command ... ";
1617
1618     my $output = `$command 2>&1`;
1619     my $ret = $?;
1620
1621     logit $output;
1622
1623     if ($ret) {
1624         doprint "FAILED\n";
1625         dodie "Failed to git bisect";
1626     }
1627
1628     doprint "SUCCESS\n";
1629     if ($output =~ m/^(Bisecting: .*\(roughly \d+ steps?\))\s+\[([[:xdigit:]]+)\]/) {
1630         doprint "$1 [$2]\n";
1631     } elsif ($output =~ m/^([[:xdigit:]]+) is the first bad commit/) {
1632         $bisect_bad = $1;
1633         doprint "Found bad commit... $1\n";
1634         return 0;
1635     } else {
1636         # we already logged it, just print it now.
1637         print $output;
1638     }
1639
1640     return 1;
1641 }
1642
1643 sub bisect_reboot {
1644     doprint "Reboot and sleep $bisect_sleep_time seconds\n";
1645     reboot $bisect_sleep_time;
1646 }
1647
1648 # returns 1 on success, 0 on failure, -1 on skip
1649 sub run_bisect_test {
1650     my ($type, $buildtype) = @_;
1651
1652     my $failed = 0;
1653     my $result;
1654     my $output;
1655     my $ret;
1656
1657     $in_bisect = 1;
1658
1659     build $buildtype or $failed = 1;
1660
1661     if ($type ne "build") {
1662         if ($failed && $bisect_skip) {
1663             $in_bisect = 0;
1664             return -1;
1665         }
1666         dodie "Failed on build" if $failed;
1667
1668         # Now boot the box
1669         start_monitor_and_boot or $failed = 1;
1670
1671         if ($type ne "boot") {
1672             if ($failed && $bisect_skip) {
1673                 end_monitor;
1674                 bisect_reboot;
1675                 $in_bisect = 0;
1676                 return -1;
1677             }
1678             dodie "Failed on boot" if $failed;
1679
1680             do_run_test or $failed = 1;
1681         }
1682         end_monitor;
1683     }
1684
1685     if ($failed) {
1686         $result = 0;
1687     } else {
1688         $result = 1;
1689     }
1690
1691     # reboot the box to a kernel we can ssh to
1692     if ($type ne "build") {
1693         bisect_reboot;
1694     }
1695     $in_bisect = 0;
1696
1697     return $result;
1698 }
1699
1700 sub run_bisect {
1701     my ($type) = @_;
1702     my $buildtype = "oldconfig";
1703
1704     # We should have a minconfig to use?
1705     if (defined($minconfig)) {
1706         $buildtype = "useconfig:$minconfig";
1707     }
1708
1709     my $ret = run_bisect_test $type, $buildtype;
1710
1711     if ($bisect_manual) {
1712         $ret = answer_bisect;
1713     }
1714
1715     # Are we looking for where it worked, not failed?
1716     if ($reverse_bisect) {
1717         $ret = !$ret;
1718     }
1719
1720     if ($ret > 0) {
1721         return "good";
1722     } elsif ($ret == 0) {
1723         return  "bad";
1724     } elsif ($bisect_skip) {
1725         doprint "HIT A BAD COMMIT ... SKIPPING\n";
1726         return "skip";
1727     }
1728 }
1729
1730 sub bisect {
1731     my ($i) = @_;
1732
1733     my $result;
1734
1735     die "BISECT_GOOD[$i] not defined\n" if (!defined($opt{"BISECT_GOOD[$i]"}));
1736     die "BISECT_BAD[$i] not defined\n"  if (!defined($opt{"BISECT_BAD[$i]"}));
1737     die "BISECT_TYPE[$i] not defined\n" if (!defined($opt{"BISECT_TYPE[$i]"}));
1738
1739     my $good = $opt{"BISECT_GOOD[$i]"};
1740     my $bad = $opt{"BISECT_BAD[$i]"};
1741     my $type = $opt{"BISECT_TYPE[$i]"};
1742     my $start = $opt{"BISECT_START[$i]"};
1743     my $replay = $opt{"BISECT_REPLAY[$i]"};
1744     my $start_files = $opt{"BISECT_FILES[$i]"};
1745
1746     if (defined($start_files)) {
1747         $start_files = " -- " . $start_files;
1748     } else {
1749         $start_files = "";
1750     }
1751
1752     # convert to true sha1's
1753     $good = get_sha1($good);
1754     $bad = get_sha1($bad);
1755
1756     if (defined($opt{"BISECT_REVERSE[$i]"}) &&
1757         $opt{"BISECT_REVERSE[$i]"} == 1) {
1758         doprint "Performing a reverse bisect (bad is good, good is bad!)\n";
1759         $reverse_bisect = 1;
1760     } else {
1761         $reverse_bisect = 0;
1762     }
1763
1764     # Can't have a test without having a test to run
1765     if ($type eq "test" && !defined($run_test)) {
1766         $type = "boot";
1767     }
1768
1769     my $check = $opt{"BISECT_CHECK[$i]"};
1770     if (defined($check) && $check ne "0") {
1771
1772         # get current HEAD
1773         my $head = get_sha1("HEAD");
1774
1775         if ($check ne "good") {
1776             doprint "TESTING BISECT BAD [$bad]\n";
1777             run_command "git checkout $bad" or
1778                 die "Failed to checkout $bad";
1779
1780             $result = run_bisect $type;
1781
1782             if ($result ne "bad") {
1783                 fail "Tested BISECT_BAD [$bad] and it succeeded" and return 0;
1784             }
1785         }
1786
1787         if ($check ne "bad") {
1788             doprint "TESTING BISECT GOOD [$good]\n";
1789             run_command "git checkout $good" or
1790                 die "Failed to checkout $good";
1791
1792             $result = run_bisect $type;
1793
1794             if ($result ne "good") {
1795                 fail "Tested BISECT_GOOD [$good] and it failed" and return 0;
1796             }
1797         }
1798
1799         # checkout where we started
1800         run_command "git checkout $head" or
1801             die "Failed to checkout $head";
1802     }
1803
1804     run_command "git bisect start$start_files" or
1805         dodie "could not start bisect";
1806
1807     run_command "git bisect good $good" or
1808         dodie "could not set bisect good to $good";
1809
1810     run_git_bisect "git bisect bad $bad" or
1811         dodie "could not set bisect bad to $bad";
1812
1813     if (defined($replay)) {
1814         run_command "git bisect replay $replay" or
1815             dodie "failed to run replay";
1816     }
1817
1818     if (defined($start)) {
1819         run_command "git checkout $start" or
1820             dodie "failed to checkout $start";
1821     }
1822
1823     my $test;
1824     do {
1825         $result = run_bisect $type;
1826         $test = run_git_bisect "git bisect $result";
1827     } while ($test);
1828
1829     run_command "git bisect log" or
1830         dodie "could not capture git bisect log";
1831
1832     run_command "git bisect reset" or
1833         dodie "could not reset git bisect";
1834
1835     doprint "Bad commit was [$bisect_bad]\n";
1836
1837     success $i;
1838 }
1839
1840 my %config_ignore;
1841 my %config_set;
1842
1843 my %config_list;
1844 my %null_config;
1845
1846 my %dependency;
1847
1848 sub assign_configs {
1849     my ($hash, $config) = @_;
1850
1851     open (IN, $config)
1852         or dodie "Failed to read $config";
1853
1854     while (<IN>) {
1855         if (/^((CONFIG\S*)=.*)/) {
1856             ${$hash}{$2} = $1;
1857         }
1858     }
1859
1860     close(IN);
1861 }
1862
1863 sub process_config_ignore {
1864     my ($config) = @_;
1865
1866     assign_configs \%config_ignore, $config;
1867 }
1868
1869 sub read_current_config {
1870     my ($config_ref) = @_;
1871
1872     %{$config_ref} = ();
1873     undef %{$config_ref};
1874
1875     my @key = keys %{$config_ref};
1876     if ($#key >= 0) {
1877         print "did not delete!\n";
1878         exit;
1879     }
1880     open (IN, "$output_config");
1881
1882     while (<IN>) {
1883         if (/^(CONFIG\S+)=(.*)/) {
1884             ${$config_ref}{$1} = $2;
1885         }
1886     }
1887     close(IN);
1888 }
1889
1890 sub get_dependencies {
1891     my ($config) = @_;
1892
1893     my $arr = $dependency{$config};
1894     if (!defined($arr)) {
1895         return ();
1896     }
1897
1898     my @deps = @{$arr};
1899
1900     foreach my $dep (@{$arr}) {
1901         print "ADD DEP $dep\n";
1902         @deps = (@deps, get_dependencies $dep);
1903     }
1904
1905     return @deps;
1906 }
1907
1908 sub create_config {
1909     my @configs = @_;
1910
1911     open(OUT, ">$output_config") or dodie "Can not write to $output_config";
1912
1913     foreach my $config (@configs) {
1914         print OUT "$config_set{$config}\n";
1915         my @deps = get_dependencies $config;
1916         foreach my $dep (@deps) {
1917             print OUT "$config_set{$dep}\n";
1918         }
1919     }
1920
1921     foreach my $config (keys %config_ignore) {
1922         print OUT "$config_ignore{$config}\n";
1923     }
1924     close(OUT);
1925
1926 #    exit;
1927     make_oldconfig;
1928 }
1929
1930 sub compare_configs {
1931     my (%a, %b) = @_;
1932
1933     foreach my $item (keys %a) {
1934         if (!defined($b{$item})) {
1935             print "diff $item\n";
1936             return 1;
1937         }
1938         delete $b{$item};
1939     }
1940
1941     my @keys = keys %b;
1942     if ($#keys) {
1943         print "diff2 $keys[0]\n";
1944     }
1945     return -1 if ($#keys >= 0);
1946
1947     return 0;
1948 }
1949
1950 sub run_config_bisect_test {
1951     my ($type) = @_;
1952
1953     return run_bisect_test $type, "oldconfig";
1954 }
1955
1956 sub process_passed {
1957     my (%configs) = @_;
1958
1959     doprint "These configs had no failure: (Enabling them for further compiles)\n";
1960     # Passed! All these configs are part of a good compile.
1961     # Add them to the min options.
1962     foreach my $config (keys %configs) {
1963         if (defined($config_list{$config})) {
1964             doprint " removing $config\n";
1965             $config_ignore{$config} = $config_list{$config};
1966             delete $config_list{$config};
1967         }
1968     }
1969     doprint "config copied to $outputdir/config_good\n";
1970     run_command "cp -f $output_config $outputdir/config_good";
1971 }
1972
1973 sub process_failed {
1974     my ($config) = @_;
1975
1976     doprint "\n\n***************************************\n";
1977     doprint "Found bad config: $config\n";
1978     doprint "***************************************\n\n";
1979 }
1980
1981 sub run_config_bisect {
1982
1983     my @start_list = keys %config_list;
1984
1985     if ($#start_list < 0) {
1986         doprint "No more configs to test!!!\n";
1987         return -1;
1988     }
1989
1990     doprint "***** RUN TEST ***\n";
1991     my $type = $opt{"CONFIG_BISECT_TYPE[$iteration]"};
1992     my $ret;
1993     my %current_config;
1994
1995     my $count = $#start_list + 1;
1996     doprint "  $count configs to test\n";
1997
1998     my $half = int($#start_list / 2);
1999
2000     do {
2001         my @tophalf = @start_list[0 .. $half];
2002
2003         create_config @tophalf;
2004         read_current_config \%current_config;
2005
2006         $count = $#tophalf + 1;
2007         doprint "Testing $count configs\n";
2008         my $found = 0;
2009         # make sure we test something
2010         foreach my $config (@tophalf) {
2011             if (defined($current_config{$config})) {
2012                 logit " $config\n";
2013                 $found = 1;
2014             }
2015         }
2016         if (!$found) {
2017             # try the other half
2018             doprint "Top half produced no set configs, trying bottom half\n";
2019             @tophalf = @start_list[$half + 1 .. $#start_list];
2020             create_config @tophalf;
2021             read_current_config \%current_config;
2022             foreach my $config (@tophalf) {
2023                 if (defined($current_config{$config})) {
2024                     logit " $config\n";
2025                     $found = 1;
2026                 }
2027             }
2028             if (!$found) {
2029                 doprint "Failed: Can't make new config with current configs\n";
2030                 foreach my $config (@start_list) {
2031                     doprint "  CONFIG: $config\n";
2032                 }
2033                 return -1;
2034             }
2035             $count = $#tophalf + 1;
2036             doprint "Testing $count configs\n";
2037         }
2038
2039         $ret = run_config_bisect_test $type;
2040         if ($bisect_manual) {
2041             $ret = answer_bisect;
2042         }
2043         if ($ret) {
2044             process_passed %current_config;
2045             return 0;
2046         }
2047
2048         doprint "This config had a failure.\n";
2049         doprint "Removing these configs that were not set in this config:\n";
2050         doprint "config copied to $outputdir/config_bad\n";
2051         run_command "cp -f $output_config $outputdir/config_bad";
2052
2053         # A config exists in this group that was bad.
2054         foreach my $config (keys %config_list) {
2055             if (!defined($current_config{$config})) {
2056                 doprint " removing $config\n";
2057                 delete $config_list{$config};
2058             }
2059         }
2060
2061         @start_list = @tophalf;
2062
2063         if ($#start_list == 0) {
2064             process_failed $start_list[0];
2065             return 1;
2066         }
2067
2068         # remove half the configs we are looking at and see if
2069         # they are good.
2070         $half = int($#start_list / 2);
2071     } while ($#start_list > 0);
2072
2073     # we found a single config, try it again unless we are running manually
2074
2075     if ($bisect_manual) {
2076         process_failed $start_list[0];
2077         return 1;
2078     }
2079
2080     my @tophalf = @start_list[0 .. 0];
2081
2082     $ret = run_config_bisect_test $type;
2083     if ($ret) {
2084         process_passed %current_config;
2085         return 0;
2086     }
2087
2088     process_failed $start_list[0];
2089     return 1;
2090 }
2091
2092 sub config_bisect {
2093     my ($i) = @_;
2094
2095     my $start_config = $opt{"CONFIG_BISECT[$i]"};
2096
2097     my $tmpconfig = "$tmpdir/use_config";
2098
2099     if (defined($config_bisect_good)) {
2100         process_config_ignore $config_bisect_good;
2101     }
2102
2103     # Make the file with the bad config and the min config
2104     if (defined($minconfig)) {
2105         # read the min config for things to ignore
2106         run_command "cp $minconfig $tmpconfig" or
2107             dodie "failed to copy $minconfig to $tmpconfig";
2108     } else {
2109         unlink $tmpconfig;
2110     }
2111
2112     if (-f $tmpconfig) {
2113         load_force_config($tmpconfig);
2114         process_config_ignore $tmpconfig;
2115     }
2116
2117     # now process the start config
2118     run_command "cp $start_config $output_config" or
2119         dodie "failed to copy $start_config to $output_config";
2120
2121     # read directly what we want to check
2122     my %config_check;
2123     open (IN, $output_config)
2124         or dodie "faied to open $output_config";
2125
2126     while (<IN>) {
2127         if (/^((CONFIG\S*)=.*)/) {
2128             $config_check{$2} = $1;
2129         }
2130     }
2131     close(IN);
2132
2133     # Now run oldconfig with the minconfig
2134     make_oldconfig;
2135
2136     # check to see what we lost (or gained)
2137     open (IN, $output_config)
2138         or dodie "Failed to read $start_config";
2139
2140     my %removed_configs;
2141     my %added_configs;
2142
2143     while (<IN>) {
2144         if (/^((CONFIG\S*)=.*)/) {
2145             # save off all options
2146             $config_set{$2} = $1;
2147             if (defined($config_check{$2})) {
2148                 if (defined($config_ignore{$2})) {
2149                     $removed_configs{$2} = $1;
2150                 } else {
2151                     $config_list{$2} = $1;
2152                 }
2153             } elsif (!defined($config_ignore{$2})) {
2154                 $added_configs{$2} = $1;
2155                 $config_list{$2} = $1;
2156             }
2157         }
2158     }
2159     close(IN);
2160
2161     my @confs = keys %removed_configs;
2162     if ($#confs >= 0) {
2163         doprint "Configs overridden by default configs and removed from check:\n";
2164         foreach my $config (@confs) {
2165             doprint " $config\n";
2166         }
2167     }
2168     @confs = keys %added_configs;
2169     if ($#confs >= 0) {
2170         doprint "Configs appearing in make oldconfig and added:\n";
2171         foreach my $config (@confs) {
2172             doprint " $config\n";
2173         }
2174     }
2175
2176     my %config_test;
2177     my $once = 0;
2178
2179     # Sometimes kconfig does weird things. We must make sure
2180     # that the config we autocreate has everything we need
2181     # to test, otherwise we may miss testing configs, or
2182     # may not be able to create a new config.
2183     # Here we create a config with everything set.
2184     create_config (keys %config_list);
2185     read_current_config \%config_test;
2186     foreach my $config (keys %config_list) {
2187         if (!defined($config_test{$config})) {
2188             if (!$once) {
2189                 $once = 1;
2190                 doprint "Configs not produced by kconfig (will not be checked):\n";
2191             }
2192             doprint "  $config\n";
2193             delete $config_list{$config};
2194         }
2195     }
2196     my $ret;
2197     do {
2198         $ret = run_config_bisect;
2199     } while (!$ret);
2200
2201     return $ret if ($ret < 0);
2202
2203     success $i;
2204 }
2205
2206 sub patchcheck_reboot {
2207     doprint "Reboot and sleep $patchcheck_sleep_time seconds\n";
2208     reboot $patchcheck_sleep_time;
2209 }
2210
2211 sub patchcheck {
2212     my ($i) = @_;
2213
2214     die "PATCHCHECK_START[$i] not defined\n"
2215         if (!defined($opt{"PATCHCHECK_START[$i]"}));
2216     die "PATCHCHECK_TYPE[$i] not defined\n"
2217         if (!defined($opt{"PATCHCHECK_TYPE[$i]"}));
2218
2219     my $start = $opt{"PATCHCHECK_START[$i]"};
2220
2221     my $end = "HEAD";
2222     if (defined($opt{"PATCHCHECK_END[$i]"})) {
2223         $end = $opt{"PATCHCHECK_END[$i]"};
2224     }
2225
2226     # Get the true sha1's since we can use things like HEAD~3
2227     $start = get_sha1($start);
2228     $end = get_sha1($end);
2229
2230     my $type = $opt{"PATCHCHECK_TYPE[$i]"};
2231
2232     # Can't have a test without having a test to run
2233     if ($type eq "test" && !defined($run_test)) {
2234         $type = "boot";
2235     }
2236
2237     open (IN, "git log --pretty=oneline $end|") or
2238         dodie "could not get git list";
2239
2240     my @list;
2241
2242     while (<IN>) {
2243         chomp;
2244         $list[$#list+1] = $_;
2245         last if (/^$start/);
2246     }
2247     close(IN);
2248
2249     if ($list[$#list] !~ /^$start/) {
2250         fail "SHA1 $start not found";
2251     }
2252
2253     # go backwards in the list
2254     @list = reverse @list;
2255
2256     my $save_clean = $noclean;
2257     my %ignored_warnings;
2258
2259     if (defined($ignore_warnings)) {
2260         foreach my $sha1 (split /\s+/, $ignore_warnings) {
2261             $ignored_warnings{$sha1} = 1;
2262         }
2263     }
2264
2265     $in_patchcheck = 1;
2266     foreach my $item (@list) {
2267         my $sha1 = $item;
2268         $sha1 =~ s/^([[:xdigit:]]+).*/$1/;
2269
2270         doprint "\nProcessing commit $item\n\n";
2271
2272         run_command "git checkout $sha1" or
2273             die "Failed to checkout $sha1";
2274
2275         # only clean on the first and last patch
2276         if ($item eq $list[0] ||
2277             $item eq $list[$#list]) {
2278             $noclean = $save_clean;
2279         } else {
2280             $noclean = 1;
2281         }
2282
2283         if (defined($minconfig)) {
2284             build "useconfig:$minconfig" or return 0;
2285         } else {
2286             # ?? no config to use?
2287             build "oldconfig" or return 0;
2288         }
2289
2290
2291         if (!defined($ignored_warnings{$sha1})) {
2292             check_buildlog $sha1 or return 0;
2293         }
2294
2295         next if ($type eq "build");
2296
2297         my $failed = 0;
2298
2299         start_monitor_and_boot or $failed = 1;
2300
2301         if (!$failed && $type ne "boot"){
2302             do_run_test or $failed = 1;
2303         }
2304         end_monitor;
2305         return 0 if ($failed);
2306
2307         patchcheck_reboot;
2308
2309     }
2310     $in_patchcheck = 0;
2311     success $i;
2312
2313     return 1;
2314 }
2315
2316 my %depends;
2317 my $iflevel = 0;
2318 my @ifdeps;
2319
2320 # prevent recursion
2321 my %read_kconfigs;
2322
2323 # taken from streamline_config.pl
2324 sub read_kconfig {
2325     my ($kconfig) = @_;
2326
2327     my $state = "NONE";
2328     my $config;
2329     my @kconfigs;
2330
2331     my $cont = 0;
2332     my $line;
2333
2334
2335     if (! -f $kconfig) {
2336         doprint "file $kconfig does not exist, skipping\n";
2337         return;
2338     }
2339
2340     open(KIN, "$kconfig")
2341         or die "Can't open $kconfig";
2342     while (<KIN>) {
2343         chomp;
2344
2345         # Make sure that lines ending with \ continue
2346         if ($cont) {
2347             $_ = $line . " " . $_;
2348         }
2349
2350         if (s/\\$//) {
2351             $cont = 1;
2352             $line = $_;
2353             next;
2354         }
2355
2356         $cont = 0;
2357
2358         # collect any Kconfig sources
2359         if (/^source\s*"(.*)"/) {
2360             $kconfigs[$#kconfigs+1] = $1;
2361         }
2362
2363         # configs found
2364         if (/^\s*(menu)?config\s+(\S+)\s*$/) {
2365             $state = "NEW";
2366             $config = $2;
2367
2368             for (my $i = 0; $i < $iflevel; $i++) {
2369                 if ($i) {
2370                     $depends{$config} .= " " . $ifdeps[$i];
2371                 } else {
2372                     $depends{$config} = $ifdeps[$i];
2373                 }
2374                 $state = "DEP";
2375             }
2376
2377         # collect the depends for the config
2378         } elsif ($state eq "NEW" && /^\s*depends\s+on\s+(.*)$/) {
2379
2380             if (defined($depends{$1})) {
2381                 $depends{$config} .= " " . $1;
2382             } else {
2383                 $depends{$config} = $1;
2384             }
2385
2386         # Get the configs that select this config
2387         } elsif ($state ne "NONE" && /^\s*select\s+(\S+)/) {
2388             if (defined($depends{$1})) {
2389                 $depends{$1} .= " " . $config;
2390             } else {
2391                 $depends{$1} = $config;
2392             }
2393
2394         # Check for if statements
2395         } elsif (/^if\s+(.*\S)\s*$/) {
2396             my $deps = $1;
2397             # remove beginning and ending non text
2398             $deps =~ s/^[^a-zA-Z0-9_]*//;
2399             $deps =~ s/[^a-zA-Z0-9_]*$//;
2400
2401             my @deps = split /[^a-zA-Z0-9_]+/, $deps;
2402
2403             $ifdeps[$iflevel++] = join ':', @deps;
2404
2405         } elsif (/^endif/) {
2406
2407             $iflevel-- if ($iflevel);
2408
2409         # stop on "help"
2410         } elsif (/^\s*help\s*$/) {
2411             $state = "NONE";
2412         }
2413     }
2414     close(KIN);
2415
2416     # read in any configs that were found.
2417     foreach $kconfig (@kconfigs) {
2418         if (!defined($read_kconfigs{$kconfig})) {
2419             $read_kconfigs{$kconfig} = 1;
2420             read_kconfig("$builddir/$kconfig");
2421         }
2422     }
2423 }
2424
2425 sub read_depends {
2426     # find out which arch this is by the kconfig file
2427     open (IN, $output_config)
2428         or dodie "Failed to read $output_config";
2429     my $arch;
2430     while (<IN>) {
2431         if (m,Linux/(\S+)\s+\S+\s+Kernel Configuration,) {
2432             $arch = $1;
2433             last;
2434         }
2435     }
2436     close IN;
2437
2438     if (!defined($arch)) {
2439         doprint "Could not find arch from config file\n";
2440         doprint "no dependencies used\n";
2441         return;
2442     }
2443
2444     # arch is really the subarch, we need to know
2445     # what directory to look at.
2446     if ($arch eq "i386" || $arch eq "x86_64") {
2447         $arch = "x86";
2448     } elsif ($arch =~ /^tile/) {
2449         $arch = "tile";
2450     }
2451
2452     my $kconfig = "$builddir/arch/$arch/Kconfig";
2453
2454     if (! -f $kconfig && $arch =~ /\d$/) {
2455         my $orig = $arch;
2456         # some subarchs have numbers, truncate them
2457         $arch =~ s/\d*$//;
2458         $kconfig = "$builddir/arch/$arch/Kconfig";
2459         if (! -f $kconfig) {
2460             doprint "No idea what arch dir $orig is for\n";
2461             doprint "no dependencies used\n";
2462             return;
2463         }
2464     }
2465
2466     read_kconfig($kconfig);
2467 }
2468
2469 sub read_config_list {
2470     my ($config) = @_;
2471
2472     open (IN, $config)
2473         or dodie "Failed to read $config";
2474
2475     while (<IN>) {
2476         if (/^((CONFIG\S*)=.*)/) {
2477             if (!defined($config_ignore{$2})) {
2478                 $config_list{$2} = $1;
2479             }
2480         }
2481     }
2482
2483     close(IN);
2484 }
2485
2486 sub read_output_config {
2487     my ($config) = @_;
2488
2489     assign_configs \%config_ignore, $config;
2490 }
2491
2492 sub make_new_config {
2493     my @configs = @_;
2494
2495     open (OUT, ">$output_config")
2496         or dodie "Failed to write $output_config";
2497
2498     foreach my $config (@configs) {
2499         print OUT "$config\n";
2500     }
2501     close OUT;
2502 }
2503
2504 sub get_depends {
2505     my ($dep) = @_;
2506
2507     my $kconfig = $dep;
2508     $kconfig =~ s/CONFIG_//;
2509
2510     $dep = $depends{"$kconfig"};
2511
2512     # the dep string we have saves the dependencies as they
2513     # were found, including expressions like ! && ||. We
2514     # want to split this out into just an array of configs.
2515
2516     my $valid = "A-Za-z_0-9";
2517
2518     my @configs;
2519
2520     while ($dep =~ /[$valid]/) {
2521
2522         if ($dep =~ /^[^$valid]*([$valid]+)/) {
2523             my $conf = "CONFIG_" . $1;
2524
2525             $configs[$#configs + 1] = $conf;
2526
2527             $dep =~ s/^[^$valid]*[$valid]+//;
2528         } else {
2529             die "this should never happen";
2530         }
2531     }
2532
2533     return @configs;
2534 }
2535
2536 my %min_configs;
2537 my %keep_configs;
2538 my %save_configs;
2539 my %processed_configs;
2540 my %nochange_config;
2541
2542 sub test_this_config {
2543     my ($config) = @_;
2544
2545     my $found;
2546
2547     # if we already processed this config, skip it
2548     if (defined($processed_configs{$config})) {
2549         return undef;
2550     }
2551     $processed_configs{$config} = 1;
2552
2553     # if this config failed during this round, skip it
2554     if (defined($nochange_config{$config})) {
2555         return undef;
2556     }
2557
2558     my $kconfig = $config;
2559     $kconfig =~ s/CONFIG_//;
2560
2561     # Test dependencies first
2562     if (defined($depends{"$kconfig"})) {
2563         my @parents = get_depends $config;
2564         foreach my $parent (@parents) {
2565             # if the parent is in the min config, check it first
2566             next if (!defined($min_configs{$parent}));
2567             $found = test_this_config($parent);
2568             if (defined($found)) {
2569                 return $found;
2570             }
2571         }
2572     }
2573
2574     # Remove this config from the list of configs
2575     # do a make oldnoconfig and then read the resulting
2576     # .config to make sure it is missing the config that
2577     # we had before
2578     my %configs = %min_configs;
2579     delete $configs{$config};
2580     make_new_config ((values %configs), (values %keep_configs));
2581     make_oldconfig;
2582     undef %configs;
2583     assign_configs \%configs, $output_config;
2584
2585     return $config if (!defined($configs{$config}));
2586
2587     doprint "disabling config $config did not change .config\n";
2588
2589     $nochange_config{$config} = 1;
2590
2591     return undef;
2592 }
2593
2594 sub make_min_config {
2595     my ($i) = @_;
2596
2597     if (!defined($output_minconfig)) {
2598         fail "OUTPUT_MIN_CONFIG not defined" and return;
2599     }
2600
2601     # If output_minconfig exists, and the start_minconfig
2602     # came from min_config, than ask if we should use
2603     # that instead.
2604     if (-f $output_minconfig && !$start_minconfig_defined) {
2605         print "$output_minconfig exists\n";
2606         if (read_yn " Use it as minconfig?") {
2607             $start_minconfig = $output_minconfig;
2608         }
2609     }
2610
2611     if (!defined($start_minconfig)) {
2612         fail "START_MIN_CONFIG or MIN_CONFIG not defined" and return;
2613     }
2614
2615     my $temp_config = "$tmpdir/temp_config";
2616
2617     # First things first. We build an allnoconfig to find
2618     # out what the defaults are that we can't touch.
2619     # Some are selections, but we really can't handle selections.
2620
2621     my $save_minconfig = $minconfig;
2622     undef $minconfig;
2623
2624     run_command "$make allnoconfig" or return 0;
2625
2626     read_depends;
2627
2628     process_config_ignore $output_config;
2629
2630     undef %save_configs;
2631     undef %min_configs;
2632
2633     if (defined($ignore_config)) {
2634         # make sure the file exists
2635         `touch $ignore_config`;
2636         assign_configs \%save_configs, $ignore_config;
2637     }
2638
2639     %keep_configs = %save_configs;
2640
2641     doprint "Load initial configs from $start_minconfig\n";
2642
2643     # Look at the current min configs, and save off all the
2644     # ones that were set via the allnoconfig
2645     assign_configs \%min_configs, $start_minconfig;
2646
2647     my @config_keys = keys %min_configs;
2648
2649     # Remove anything that was set by the make allnoconfig
2650     # we shouldn't need them as they get set for us anyway.
2651     foreach my $config (@config_keys) {
2652         # Remove anything in the ignore_config
2653         if (defined($keep_configs{$config})) {
2654             my $file = $ignore_config;
2655             $file =~ s,.*/(.*?)$,$1,;
2656             doprint "$config set by $file ... ignored\n";
2657             delete $min_configs{$config};
2658             next;
2659         }
2660         # But make sure the settings are the same. If a min config
2661         # sets a selection, we do not want to get rid of it if
2662         # it is not the same as what we have. Just move it into
2663         # the keep configs.
2664         if (defined($config_ignore{$config})) {
2665             if ($config_ignore{$config} ne $min_configs{$config}) {
2666                 doprint "$config is in allnoconfig as '$config_ignore{$config}'";
2667                 doprint " but it is '$min_configs{$config}' in minconfig .. keeping\n";
2668                 $keep_configs{$config} = $min_configs{$config};
2669             } else {
2670                 doprint "$config set by allnoconfig ... ignored\n";
2671             }
2672             delete $min_configs{$config};
2673         }
2674     }
2675
2676     my $done = 0;
2677     my $take_two = 0;
2678
2679     while (!$done) {
2680
2681         my $config;
2682         my $found;
2683
2684         # Now disable each config one by one and do a make oldconfig
2685         # till we find a config that changes our list.
2686
2687         # Put configs that did not modify the config at the end.
2688         my @test_configs = keys %min_configs;
2689         my $reset = 1;
2690         for (my $i = 0; $i < $#test_configs; $i++) {
2691             if (!defined($nochange_config{$test_configs[0]})) {
2692                 $reset = 0;
2693                 last;
2694             }
2695             # This config didn't change the .config last time.
2696             # Place it at the end
2697             my $config = shift @test_configs;
2698             push @test_configs, $config;
2699         }
2700
2701         # if every test config has failed to modify the .config file
2702         # in the past, then reset and start over.
2703         if ($reset) {
2704             undef %nochange_config;
2705         }
2706
2707         undef %processed_configs;
2708
2709         foreach my $config (@test_configs) {
2710
2711             $found = test_this_config $config;
2712
2713             last if (defined($found));
2714
2715             # oh well, try another config
2716         }
2717
2718         if (!defined($found)) {
2719             # we could have failed due to the nochange_config hash
2720             # reset and try again
2721             if (!$take_two) {
2722                 undef %nochange_config;
2723                 $take_two = 1;
2724                 next;
2725             }
2726             doprint "No more configs found that we can disable\n";
2727             $done = 1;
2728             last;
2729         }
2730         $take_two = 0;
2731
2732         $config = $found;
2733
2734         doprint "Test with $config disabled\n";
2735
2736         # set in_bisect to keep build and monitor from dieing
2737         $in_bisect = 1;
2738
2739         my $failed = 0;
2740         build "oldconfig";
2741         start_monitor_and_boot or $failed = 1;
2742         end_monitor;
2743
2744         $in_bisect = 0;
2745
2746         if ($failed) {
2747             doprint "$min_configs{$config} is needed to boot the box... keeping\n";
2748             # this config is needed, add it to the ignore list.
2749             $keep_configs{$config} = $min_configs{$config};
2750             $save_configs{$config} = $min_configs{$config};
2751             delete $min_configs{$config};
2752
2753             # update new ignore configs
2754             if (defined($ignore_config)) {
2755                 open (OUT, ">$temp_config")
2756                     or die "Can't write to $temp_config";
2757                 foreach my $config (keys %save_configs) {
2758                     print OUT "$save_configs{$config}\n";
2759                 }
2760                 close OUT;
2761                 run_command "mv $temp_config $ignore_config" or
2762                     dodie "failed to copy update to $ignore_config";
2763             }
2764
2765         } else {
2766             # We booted without this config, remove it from the minconfigs.
2767             doprint "$config is not needed, disabling\n";
2768
2769             delete $min_configs{$config};
2770
2771             # Also disable anything that is not enabled in this config
2772             my %configs;
2773             assign_configs \%configs, $output_config;
2774             my @config_keys = keys %min_configs;
2775             foreach my $config (@config_keys) {
2776                 if (!defined($configs{$config})) {
2777                     doprint "$config is not set, disabling\n";
2778                     delete $min_configs{$config};
2779                 }
2780             }
2781
2782             # Save off all the current mandidory configs
2783             open (OUT, ">$temp_config")
2784                 or die "Can't write to $temp_config";
2785             foreach my $config (keys %keep_configs) {
2786                 print OUT "$keep_configs{$config}\n";
2787             }
2788             foreach my $config (keys %min_configs) {
2789                 print OUT "$min_configs{$config}\n";
2790             }
2791             close OUT;
2792
2793             run_command "mv $temp_config $output_minconfig" or
2794                 dodie "failed to copy update to $output_minconfig";
2795         }
2796
2797         doprint "Reboot and wait $sleep_time seconds\n";
2798         reboot $sleep_time;
2799     }
2800
2801     success $i;
2802     return 1;
2803 }
2804
2805 $#ARGV < 1 or die "ktest.pl version: $VERSION\n   usage: ktest.pl config-file\n";
2806
2807 if ($#ARGV == 0) {
2808     $ktest_config = $ARGV[0];
2809     if (! -f $ktest_config) {
2810         print "$ktest_config does not exist.\n";
2811         if (!read_yn "Create it?") {
2812             exit 0;
2813         }
2814     }
2815 } else {
2816     $ktest_config = "ktest.conf";
2817 }
2818
2819 if (! -f $ktest_config) {
2820     open(OUT, ">$ktest_config") or die "Can not create $ktest_config";
2821     print OUT << "EOF"
2822 # Generated by ktest.pl
2823 #
2824 # Define each test with TEST_START
2825 # The config options below it will override the defaults
2826 TEST_START
2827
2828 DEFAULTS
2829 EOF
2830 ;
2831     close(OUT);
2832 }
2833 read_config $ktest_config;
2834
2835 if (defined($opt{"LOG_FILE"})) {
2836     $opt{"LOG_FILE"} = eval_option($opt{"LOG_FILE"}, -1);
2837 }
2838
2839 # Append any configs entered in manually to the config file.
2840 my @new_configs = keys %entered_configs;
2841 if ($#new_configs >= 0) {
2842     print "\nAppending entered in configs to $ktest_config\n";
2843     open(OUT, ">>$ktest_config") or die "Can not append to $ktest_config";
2844     foreach my $config (@new_configs) {
2845         print OUT "$config = $entered_configs{$config}\n";
2846         $opt{$config} = $entered_configs{$config};
2847     }
2848 }
2849
2850 if ($opt{"CLEAR_LOG"} && defined($opt{"LOG_FILE"})) {
2851     unlink $opt{"LOG_FILE"};
2852 }
2853
2854 doprint "\n\nSTARTING AUTOMATED TESTS\n\n";
2855
2856 for (my $i = 0, my $repeat = 1; $i <= $opt{"NUM_TESTS"}; $i += $repeat) {
2857
2858     if (!$i) {
2859         doprint "DEFAULT OPTIONS:\n";
2860     } else {
2861         doprint "\nTEST $i OPTIONS";
2862         if (defined($repeat_tests{$i})) {
2863             $repeat = $repeat_tests{$i};
2864             doprint " ITERATE $repeat";
2865         }
2866         doprint "\n";
2867     }
2868
2869     foreach my $option (sort keys %opt) {
2870
2871         if ($option =~ /\[(\d+)\]$/) {
2872             next if ($i != $1);
2873         } else {
2874             next if ($i);
2875         }
2876
2877         doprint "$option = $opt{$option}\n";
2878     }
2879 }
2880
2881 sub __set_test_option {
2882     my ($name, $i) = @_;
2883
2884     my $option = "$name\[$i\]";
2885
2886     if (defined($opt{$option})) {
2887         return $opt{$option};
2888     }
2889
2890     foreach my $test (keys %repeat_tests) {
2891         if ($i >= $test &&
2892             $i < $test + $repeat_tests{$test}) {
2893             $option = "$name\[$test\]";
2894             if (defined($opt{$option})) {
2895                 return $opt{$option};
2896             }
2897         }
2898     }
2899
2900     if (defined($opt{$name})) {
2901         return $opt{$name};
2902     }
2903
2904     return undef;
2905 }
2906
2907 sub set_test_option {
2908     my ($name, $i) = @_;
2909
2910     my $option = __set_test_option($name, $i);
2911     return $option if (!defined($option));
2912
2913     return eval_option($option, $i);
2914 }
2915
2916 # First we need to do is the builds
2917 for (my $i = 1; $i <= $opt{"NUM_TESTS"}; $i++) {
2918
2919     # Do not reboot on failing test options
2920     $no_reboot = 1;
2921
2922     $iteration = $i;
2923
2924     my $makecmd = set_test_option("MAKE_CMD", $i);
2925
2926     $machine = set_test_option("MACHINE", $i);
2927     $ssh_user = set_test_option("SSH_USER", $i);
2928     $tmpdir = set_test_option("TMP_DIR", $i);
2929     $outputdir = set_test_option("OUTPUT_DIR", $i);
2930     $builddir = set_test_option("BUILD_DIR", $i);
2931     $test_type = set_test_option("TEST_TYPE", $i);
2932     $build_type = set_test_option("BUILD_TYPE", $i);
2933     $build_options = set_test_option("BUILD_OPTIONS", $i);
2934     $pre_build = set_test_option("PRE_BUILD", $i);
2935     $post_build = set_test_option("POST_BUILD", $i);
2936     $pre_build_die = set_test_option("PRE_BUILD_DIE", $i);
2937     $post_build_die = set_test_option("POST_BUILD_DIE", $i);
2938     $power_cycle = set_test_option("POWER_CYCLE", $i);
2939     $reboot = set_test_option("REBOOT", $i);
2940     $noclean = set_test_option("BUILD_NOCLEAN", $i);
2941     $minconfig = set_test_option("MIN_CONFIG", $i);
2942     $output_minconfig = set_test_option("OUTPUT_MIN_CONFIG", $i);
2943     $start_minconfig = set_test_option("START_MIN_CONFIG", $i);
2944     $ignore_config = set_test_option("IGNORE_CONFIG", $i);
2945     $run_test = set_test_option("TEST", $i);
2946     $addconfig = set_test_option("ADD_CONFIG", $i);
2947     $reboot_type = set_test_option("REBOOT_TYPE", $i);
2948     $grub_menu = set_test_option("GRUB_MENU", $i);
2949     $post_install = set_test_option("POST_INSTALL", $i);
2950     $no_install = set_test_option("NO_INSTALL", $i);
2951     $reboot_script = set_test_option("REBOOT_SCRIPT", $i);
2952     $reboot_on_error = set_test_option("REBOOT_ON_ERROR", $i);
2953     $poweroff_on_error = set_test_option("POWEROFF_ON_ERROR", $i);
2954     $die_on_failure = set_test_option("DIE_ON_FAILURE", $i);
2955     $power_off = set_test_option("POWER_OFF", $i);
2956     $powercycle_after_reboot = set_test_option("POWERCYCLE_AFTER_REBOOT", $i);
2957     $poweroff_after_halt = set_test_option("POWEROFF_AFTER_HALT", $i);
2958     $sleep_time = set_test_option("SLEEP_TIME", $i);
2959     $bisect_sleep_time = set_test_option("BISECT_SLEEP_TIME", $i);
2960     $patchcheck_sleep_time = set_test_option("PATCHCHECK_SLEEP_TIME", $i);
2961     $ignore_warnings = set_test_option("IGNORE_WARNINGS", $i);
2962     $bisect_manual = set_test_option("BISECT_MANUAL", $i);
2963     $bisect_skip = set_test_option("BISECT_SKIP", $i);
2964     $config_bisect_good = set_test_option("CONFIG_BISECT_GOOD", $i);
2965     $store_failures = set_test_option("STORE_FAILURES", $i);
2966     $test_name = set_test_option("TEST_NAME", $i);
2967     $timeout = set_test_option("TIMEOUT", $i);
2968     $booted_timeout = set_test_option("BOOTED_TIMEOUT", $i);
2969     $console = set_test_option("CONSOLE", $i);
2970     $detect_triplefault = set_test_option("DETECT_TRIPLE_FAULT", $i);
2971     $success_line = set_test_option("SUCCESS_LINE", $i);
2972     $reboot_success_line = set_test_option("REBOOT_SUCCESS_LINE", $i);
2973     $stop_after_success = set_test_option("STOP_AFTER_SUCCESS", $i);
2974     $stop_after_failure = set_test_option("STOP_AFTER_FAILURE", $i);
2975     $stop_test_after = set_test_option("STOP_TEST_AFTER", $i);
2976     $build_target = set_test_option("BUILD_TARGET", $i);
2977     $ssh_exec = set_test_option("SSH_EXEC", $i);
2978     $scp_to_target = set_test_option("SCP_TO_TARGET", $i);
2979     $target_image = set_test_option("TARGET_IMAGE", $i);
2980     $localversion = set_test_option("LOCALVERSION", $i);
2981
2982     $start_minconfig_defined = 1;
2983
2984     if (!defined($start_minconfig)) {
2985         $start_minconfig_defined = 0;
2986         $start_minconfig = $minconfig;
2987     }
2988
2989     chdir $builddir || die "can't change directory to $builddir";
2990
2991     foreach my $dir ($tmpdir, $outputdir) {
2992         if (!-d $dir) {
2993             mkpath($dir) or
2994                 die "can't create $dir";
2995         }
2996     }
2997
2998     $ENV{"SSH_USER"} = $ssh_user;
2999     $ENV{"MACHINE"} = $machine;
3000
3001     $target = "$ssh_user\@$machine";
3002
3003     $buildlog = "$tmpdir/buildlog-$machine";
3004     $dmesg = "$tmpdir/dmesg-$machine";
3005     $make = "$makecmd O=$outputdir";
3006     $output_config = "$outputdir/.config";
3007
3008     if ($reboot_type eq "grub") {
3009         dodie "GRUB_MENU not defined" if (!defined($grub_menu));
3010     } elsif (!defined($reboot_script)) {
3011         dodie "REBOOT_SCRIPT not defined"
3012     }
3013
3014     my $run_type = $build_type;
3015     if ($test_type eq "patchcheck") {
3016         $run_type = $opt{"PATCHCHECK_TYPE[$i]"};
3017     } elsif ($test_type eq "bisect") {
3018         $run_type = $opt{"BISECT_TYPE[$i]"};
3019     } elsif ($test_type eq "config_bisect") {
3020         $run_type = $opt{"CONFIG_BISECT_TYPE[$i]"};
3021     }
3022
3023     if ($test_type eq "make_min_config") {
3024         $run_type = "";
3025     }
3026
3027     # mistake in config file?
3028     if (!defined($run_type)) {
3029         $run_type = "ERROR";
3030     }
3031
3032     my $installme = "";
3033     $installme = " no_install" if ($no_install);
3034
3035     doprint "\n\n";
3036     doprint "RUNNING TEST $i of $opt{NUM_TESTS} with option $test_type $run_type$installme\n\n";
3037
3038     unlink $dmesg;
3039     unlink $buildlog;
3040
3041     if (defined($addconfig)) {
3042         my $min = $minconfig;
3043         if (!defined($minconfig)) {
3044             $min = "";
3045         }
3046         run_command "cat $addconfig $min > $tmpdir/add_config" or
3047             dodie "Failed to create temp config";
3048         $minconfig = "$tmpdir/add_config";
3049     }
3050
3051     my $checkout = $opt{"CHECKOUT[$i]"};
3052     if (defined($checkout)) {
3053         run_command "git checkout $checkout" or
3054             die "failed to checkout $checkout";
3055     }
3056
3057     $no_reboot = 0;
3058
3059
3060     if ($test_type eq "bisect") {
3061         bisect $i;
3062         next;
3063     } elsif ($test_type eq "config_bisect") {
3064         config_bisect $i;
3065         next;
3066     } elsif ($test_type eq "patchcheck") {
3067         patchcheck $i;
3068         next;
3069     } elsif ($test_type eq "make_min_config") {
3070         make_min_config $i;
3071         next;
3072     }
3073
3074     if ($build_type ne "nobuild") {
3075         build $build_type or next;
3076     }
3077
3078     if ($test_type eq "install") {
3079         get_version;
3080         install;
3081         success $i;
3082         next;
3083     }
3084
3085     if ($test_type ne "build") {
3086         my $failed = 0;
3087         start_monitor_and_boot or $failed = 1;
3088
3089         if (!$failed && $test_type ne "boot" && defined($run_test)) {
3090             do_run_test or $failed = 1;
3091         }
3092         end_monitor;
3093         next if ($failed);
3094     }
3095
3096     success $i;
3097 }
3098
3099 if ($opt{"POWEROFF_ON_SUCCESS"}) {
3100     halt;
3101 } elsif ($opt{"REBOOT_ON_SUCCESS"} && !do_not_reboot) {
3102     reboot;
3103 }
3104
3105 doprint "\n    $successes of $opt{NUM_TESTS} tests were successful\n\n";
3106
3107 exit 0;