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