#!/usr/bin/perl -w## Copyright 2010 - Steven Rostedt <srostedt@redhat.com>, Red Hat Inc.# Licensed under the terms of the GNU GPL License version 2# use strict;use IPC::Open2;use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);use File::Path qw(mkpath);use File::Copy qw(cp);use FileHandle; my $VERSION = "0.2"; $| = 1; my %opt;my %repeat_tests;my %repeats;my %default; #default opts$default{"NUM_TESTS"}		= 1;$default{"REBOOT_TYPE"}		= "grub";$default{"TEST_TYPE"}		= "test";$default{"BUILD_TYPE"}		= "randconfig";$default{"MAKE_CMD"}		= "make";$default{"TIMEOUT"}		= 120;$default{"TMP_DIR"}		= "/tmp/ktest/\${MACHINE}";$default{"SLEEP_TIME"}		= 60;	# sleep time between tests$default{"BUILD_NOCLEAN"}	= 0;$default{"REBOOT_ON_ERROR"}	= 0;$default{"POWEROFF_ON_ERROR"}	= 0;$default{"REBOOT_ON_SUCCESS"}	= 1;$default{"POWEROFF_ON_SUCCESS"}	= 0;$default{"BUILD_OPTIONS"}	= "";$default{"BISECT_SLEEP_TIME"}	= 60;   # sleep time between bisects$default{"PATCHCHECK_SLEEP_TIME"} = 60; # sleep time between patch checks$default{"CLEAR_LOG"}		= 0;$default{"BISECT_MANUAL"}	= 0;$default{"BISECT_SKIP"}		= 1;$default{"SUCCESS_LINE"}	= "login:";$default{"DETECT_TRIPLE_FAULT"} = 1;$default{"NO_INSTALL"}		= 0;$default{"BOOTED_TIMEOUT"}	= 1;$default{"DIE_ON_FAILURE"}	= 1;$default{"SSH_EXEC"}		= "ssh \$SSH_USER\@\$MACHINE \$SSH_COMMAND";$default{"SCP_TO_TARGET"}	= "scp \$SRC_FILE \$SSH_USER\@\$MACHINE:\$DST_FILE";$default{"REBOOT"}		= "ssh \$SSH_USER\@\$MACHINE reboot";$default{"STOP_AFTER_SUCCESS"}	= 10;$default{"STOP_AFTER_FAILURE"}	= 60;$default{"STOP_TEST_AFTER"}	= 600;$default{"LOCALVERSION"}	= "-test"; my $ktest_config;my $version;my $machine;my $ssh_user;my $tmpdir;my $builddir;my $outputdir;my $output_config;my $test_type;my $build_type;my $build_options;my $pre_build;my $post_build;my $pre_build_die;my $post_build_die;my $reboot_type;my $reboot_script;my $power_cycle;my $reboot;my $reboot_on_error;my $poweroff_on_error;my $die_on_failure;my $powercycle_after_reboot;my $poweroff_after_halt;my $ssh_exec;my $scp_to_target;my $power_off;my $grub_menu;my $grub_number;my $target;my $make;my $post_install;my $no_install;my $noclean;my $minconfig;my $start_minconfig;my $start_minconfig_defined;my $output_minconfig;my $ignore_config;my $addconfig;my $in_bisect = 0;my $bisect_bad = "";my $reverse_bisect;my $bisect_manual;my $bisect_skip;my $config_bisect_good;my $in_patchcheck = 0;my $run_test;my $redirect;my $buildlog;my $dmesg;my $monitor_fp;my $monitor_pid;my $monitor_cnt = 0;my $sleep_time;my $bisect_sleep_time;my $patchcheck_sleep_time;my $ignore_warnings;my $store_failures;my $test_name;my $timeout;my $booted_timeout;my $detect_triplefault;my $console;my $reboot_success_line;my $success_line;my $stop_after_success;my $stop_after_failure;my $stop_test_after;my $build_target;my $target_image;my $localversion;my $iteration = 0;my $successes = 0; my %entered_configs;my %config_help;my %variable;my %force_config; # do not force reboots on config problemsmy $no_reboot = 1; # default variables that can be usedchomp ($variable{"PWD"} = `pwd`); $config_help{"MACHINE"} = << "EOF" The machine hostname that you will test.EOF    ;$config_help{"SSH_USER"} = << "EOF" The box is expected to have ssh on normal bootup, provide the user  (most likely root, since you need privileged operations)EOF    ;$config_help{"BUILD_DIR"} = << "EOF" The directory that contains the Linux source code (full path).EOF    ;$config_help{"OUTPUT_DIR"} = << "EOF" The directory that the objects will be built (full path). (can not be same as BUILD_DIR)EOF    ;$config_help{"BUILD_TARGET"} = << "EOF" The location of the compiled file to copy to the target. (relative to OUTPUT_DIR)EOF    ;$config_help{"TARGET_IMAGE"} = << "EOF" The place to put your image on the test machine.EOF    ;$config_help{"POWER_CYCLE"} = << "EOF" A script or command to reboot the box.  Here is a digital loggers power switch example POWER_CYCLE = wget --no-proxy -O /dev/null -q  --auth-no-challenge 'http://admin:admin\@power/outlet?5=CCL'  Here is an example to reboot a virtual box on the current host with the name "Guest". POWER_CYCLE = virsh destroy Guest; sleep 5; virsh start GuestEOF    ;$config_help{"CONSOLE"} = << "EOF" The script or command that reads the console   If you use ttywatch server, something like the following would work.CONSOLE = nc -d localhost 3001  For a virtual machine with guest name "Guest".CONSOLE =  virsh console GuestEOF    ;$config_help{"LOCALVERSION"} = << "EOF" Required version ending to differentiate the test from other linux builds on the system.EOF    ;$config_help{"REBOOT_TYPE"} = << "EOF" Way to reboot the box to the test kernel. Only valid options so far are "grub" and "script".  If you specify grub, it will assume grub version 1 and will search in /boot/grub/menu.lst for the title \$GRUB_MENU and select that target to reboot to the kernel. If this is not your setup, then specify "script" and have a command or script specified in REBOOT_SCRIPT to boot to the target.  The entry in /boot/grub/menu.lst must be entered in manually. The test will not modify that file.EOF    ;$config_help{"GRUB_MENU"} = << "EOF" The grub title name for the test kernel to boot (Only mandatory if REBOOT_TYPE = grub)  Note, ktest.pl will not update the grub menu.lst, you need to manually add an option for the test. ktest.pl will search the grub menu.lst for this option to find what kernel to reboot into.  For example, if in the /boot/grub/menu.lst the test kernel title has: title Test Kernel kernel vmlinuz-test GRUB_MENU = Test KernelEOF    ;$config_help{"REBOOT_SCRIPT"} = << "EOF" A script to reboot the target into the test kernel (Only mandatory if REBOOT_TYPE = script)EOF    ; sub read_yn {    my ($prompt) = @_;     my $ans;     for (;;) {	print "$prompt [Y/n] ";	$ans = <STDIN>;	chomp $ans;	if ($ans =~ /^\s*$/) {	    $ans = "y";	}	last if ($ans =~ /^y$/i || $ans =~ /^n$/i);	print "Please answer either 'y' or 'n'.\n";    }    if ($ans !~ /^y$/i) {	return 0;    }    return 1;} sub get_ktest_config {    my ($config) = @_;    my $ans;     return if (defined($opt{$config}));     if (defined($config_help{$config})) {	print "\n";	print $config_help{$config};    }     for (;;) {	print "$config = ";	if (defined($default{$config})) {	    print "\[$default{$config}\] ";	}	$ans = <STDIN>;	$ans =~ s/^\s*(.*\S)\s*$/$1/;	if ($ans =~ /^\s*$/) {	    if ($default{$config}) {		$ans = $default{$config};	    } else {		print "Your answer can not be blank\n";		next;	    }	}	$entered_configs{$config} = process_variables($ans);	last;    }} sub get_ktest_configs {    get_ktest_config("MACHINE");    get_ktest_config("SSH_USER");    get_ktest_config("BUILD_DIR");    get_ktest_config("OUTPUT_DIR");    get_ktest_config("BUILD_TARGET");    get_ktest_config("TARGET_IMAGE");    get_ktest_config("POWER_CYCLE");    get_ktest_config("CONSOLE");    get_ktest_config("LOCALVERSION");     my $rtype = $opt{"REBOOT_TYPE"};     if (!defined($rtype)) {	if (!defined($opt{"GRUB_MENU"})) {	    get_ktest_config("REBOOT_TYPE");	    $rtype = $entered_configs{"REBOOT_TYPE"};	} else {	    $rtype = "grub";	}    }     if ($rtype eq "grub") {	get_ktest_config("GRUB_MENU");    } else {	get_ktest_config("REBOOT_SCRIPT");    }} sub process_variables {    my ($value, $remove_undef) = @_;    my $retval = "";     # We want to check for '\', and it is just easier    # to check the previous characet of '$' and not need    # to worry if '$' is the first character. By adding    # a space to $value, we can just check [^\\]\$ and    # it will still work.    $value = " $value";     while ($value =~ /(.*?[^\\])\$\{(.*?)\}(.*)/) {	my $begin = $1;	my $var = $2;	my $end = $3;	# append beginning of value to retval	$retval = "$retval$begin";	if (defined($variable{$var})) {	    $retval = "$retval$variable{$var}";	} elsif (defined($remove_undef) && $remove_undef) {	    # for if statements, any variable that is not defined,	    # we simple convert to 0	    $retval = "${retval}0";	} else {	    # put back the origin piece.	    $retval = "$retval\$\{$var\}";	}	$value = $end;    }    $retval = "$retval$value";     # remove the space added in the beginning    $retval =~ s/ //;     return "$retval"} sub set_value {    my ($lvalue, $rvalue, $override, $overrides, $name) = @_;     if (defined($opt{$lvalue})) {	if (!$override || defined(${$overrides}{$lvalue})) {	    my $extra = "";	    if ($override) {		$extra = "In the same override section!\n";	    }	    die "$name: $.: Option $lvalue defined more than once!\n$extra";	}	${$overrides}{$lvalue} = $rvalue;    }    if ($rvalue =~ /^\s*$/) {	delete $opt{$lvalue};    } else {	$rvalue = process_variables($rvalue);	$opt{$lvalue} = $rvalue;    }} sub set_variable {    my ($lvalue, $rvalue) = @_;     if ($rvalue =~ /^\s*$/) {	delete $variable{$lvalue};    } else {	$rvalue = process_variables($rvalue);	$variable{$lvalue} = $rvalue;    }} sub process_compare {    my ($lval, $cmp, $rval) = @_;     # remove whitespace     $lval =~ s/^\s*//;    $lval =~ s/\s*$//;     $rval =~ s/^\s*//;    $rval =~ s/\s*$//;     if ($cmp eq "==") {	return $lval eq $rval;    } elsif ($cmp eq "!=") {	return $lval ne $rval;    }     my $statement = "$lval $cmp $rval";    my $ret = eval $statement;     # $@ stores error of eval    if ($@) {	return -1;    }     return $ret;} sub value_defined {    my ($val) = @_;     return defined($variable{$2}) ||	defined($opt{$2});} my $d = 0;sub process_expression {    my ($name, $val) = @_;     my $c = $d++;     while ($val =~ s/\(([^\(]*?)\)/\&\&\&\&VAL\&\&\&\&/) {	my $express = $1; 	if (process_expression($name, $express)) {	    $val =~ s/\&\&\&\&VAL\&\&\&\&/ 1 /;	} else {	    $val =~ s/\&\&\&\&VAL\&\&\&\&/ 0 /;	}    }     $d--;    my $OR = "\\|\\|";    my $AND = "\\&\\&";     while ($val =~ s/^(.*?)($OR|$AND)//) {	my $express = $1;	my $op = $2; 	if (process_expression($name, $express)) {	    if ($op eq "||") {		return 1;	    }	} else {	    if ($op eq "&&") {		return 0;	    }	}    }     if ($val =~ /(.*)(==|\!=|>=|<=|>|<)(.*)/) {	my $ret = process_compare($1, $2, $3);	if ($ret < 0) {	    die "$name: $.: Unable to process comparison\n";	}	return $ret;    }     if ($val =~ /^\s*(NOT\s*)?DEFINED\s+(\S+)\s*$/) {	if (defined $1) {	    return !value_defined($2);	} else {	    return value_defined($2);	}    }     if ($val =~ /^\s*0\s*$/) {	return 0;    } elsif ($val =~ /^\s*\d+\s*$/) {	return 1;    }     die ("$name: $.: Undefined content $val in if statement\n");} sub process_if {    my ($name, $value) = @_;     # Convert variables and replace undefined ones with 0    my $val = process_variables($value, 1);    my $ret = process_expression $name, $val;     return $ret;} sub __read_config {    my ($config, $current_test_num) = @_;     my $in;    open($in, $config) || die "can't read file $config";     my $name = $config;    $name =~ s,.*/(.*),$1,;     my $test_num = $$current_test_num;    my $default = 1;    my $repeat = 1;    my $num_tests_set = 0;    my $skip = 0;    my $rest;    my $line;

Lines 1–500 of 3275. Load more