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