tools/testing/ktest/ktest.pl

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