# Distribution Checker
# Core Testsuite Module (Core_test.pm)
#
# Copyright (C) 2007-2009 The Linux Foundation. All rights reserved.
#
# This program has been developed by ISP RAS for LF.
# The ptyshell tool is originally written by Jiri Dluhos <jdluhos@suse.cz>
# Copyright (C) 2005-2007 SuSE Linux Products GmbH
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# version 2 as published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #

package Core_test;
use strict;

use Misc;
use Subshell;

use Test_common;
our @ISA = qw(Test_common); # Inherit Test_common
#----------------------------------------------------------------------

my $VSX0_PASSWORD = crypt("gu112jj6", time() );
my $VSX1_PASSWORD = crypt("gu112jj4", time() );
my $VSX2_PASSWORD = crypt("gu112jj2", time() );

my $checkpoints = undef;

#----------------------------------------------------------------------

sub check {
	my ($self) = @_;

	# Call the parent's check() function
	is_ok $self->Test_common::check() or return $Error::Last;

	(defined $self->{OPTIONS} )
		or return error "Answers are undefined"; # Should not happen
	
	return 1;
}

sub detach_loops {
	if ( does_shell_know("losetup") ) {
		if ( cmd("losetup -a >/dev/null 2>&1") == 0 ) {
			# If '-a' option is supported
			cmd ( "for loop in `losetup -a 2>/dev/null | grep -F 'loopback_disk.ext2' | sed s/:.*//`;"
						." do (umount \$loop; losetup -d \$loop;) 2>/dev/null; "
					."done" );
		} else {
			cmd ( "for i in `seq 0 9`; do"
					." losetup \"/dev/loop\$i\" 2>/dev/null | grep -F 'loopback_disk.ext2'"
						." && (umount \"/dev/loop\$i\"; losetup -d \"/dev/loop\$i\") 2>/dev/null; "
				."done" );
		}
	}
}

sub prepare {
	my ($self) = @_;

	# Call the parent's prepare function
	is_ok $self->Test_common::prepare() or return $Error::Last;
	
	# Create temporary directory
	is_ok $self->create_temp_dir()
		or return error "Failed to create temporary directory.", $Error::Last;
	
	my $testsuite_dir = $self->option('TESTSUITE_DIR') || "/opt/lsb/test/core/tet/test_sets";
	$self->{TESTSUITE_DIR} = $testsuite_dir;
	$self->{TESTRUN_PATH} = $self->option('TESTRUN_PATH') || "/home/tet/test_sets";
	$self->{RESULTS_DIR} = $self->option('RESULTS_DIR') || "/opt/lsb/test/core/tet/test_sets/results";
	
	# Remove stale loops
	detach_loops();
	
	# Remove stale config and results files.
	cmd("rm -f ".shq($testsuite_dir)."/.configured");
	cmd("rm -f ".shq($testsuite_dir)."/loopback_disk.ext2");
	cmd("rm -f ".shq($testsuite_dir)."/TESTROOT/tetexec.cfg.old");
	cmd("rm -rf ".shq($self->{RESULTS_DIR})."/*");

	# Remove stale locks (can be left behind if the previous run
	# was stopped or crashed).
	cmd("rm -f `find ".shq($testsuite_dir."/TESTROOT/tset")." -name tet_lock`");
	
	init_checkpoint_data($self->{VERSION});
	
	# Reset the `loop' module in case of absence of loop0 device
	if ( ! -e "/dev/loop0" ) {
		if ( does_shell_know("modprobe") ) {
			cmd("modprobe loop");
		}
		if ( does_shell_know("losetup") ) {
			cmd("losetup -f");
		}
		# Check the result
		if ( ! -e "/dev/loop0" ) {
			return error "There is no /dev/loop0 device."
				." The testsuite is known to do bad things in such case."
				." Do not run.";
		}
	}
	
	# Open a subshell to set passwords for test users.
	my $subshell = $self->Spawn_subshell();
	is_ok $subshell or return $Error::Last;
	
	# Set passwords for testing users
	$subshell->Settle();
	$subshell->Send( "passwd vsx0"."\n" );
	is_ok $subshell->expect_and_reply("assword:", $VSX0_PASSWORD."\n") or return $Error::Last;
	is_ok $subshell->expect_and_reply("assword:", $VSX0_PASSWORD."\n") or return $Error::Last;
	
	$subshell->Settle();
	$subshell->Send( "passwd vsx1"."\n" );
	is_ok $subshell->expect_and_reply("assword:", $VSX1_PASSWORD."\n") or return $Error::Last;
	is_ok $subshell->expect_and_reply("assword:", $VSX1_PASSWORD."\n") or return $Error::Last;

	$subshell->Settle();
	$subshell->Send( "passwd vsx2"."\n" );
	is_ok $subshell->expect_and_reply("assword:", $VSX2_PASSWORD."\n") or return $Error::Last;
	is_ok $subshell->expect_and_reply("assword:", $VSX2_PASSWORD."\n") or return $Error::Last;

	$subshell->Settle();
	$subshell->Send( "exit"."\n" );
	
	is_ok $subshell->ExpectLogout() or return $Error::Last;
	
	if ( !defined $globals->{'rootpw'} ) {
		# Install the PAM backdoor
		is_ok install_backdoor() or return error "Failed to install the PAM backdoor", $Error::Last;
	}
	
	return 1;
}

sub install_backdoor {
	inform "Installing the PAM vsx0-to-root backdoor (will be removed at end)";
	
	if ( !-f "/etc/pam.d/su.orig0" ) {
		cmd("cp -f /etc/pam.d/su /etc/pam.d/su.orig0");
	}
	( -f "/etc/pam.d/su.orig0" ) or return error "Failed to backup /etc/pam.d/su";
	
	my $pam_su_content = read_file("/etc/pam.d/su.orig0");
	is_ok $pam_su_content or return error "Failed to read /etc/pam.d/su.orig0", $Error::Last;
	
	# Find the pam_wheel module
	# Notes on this code: not sure why the full path to the module
	# is ever needed, and it seems to cause problems (bug 3218,
	# bug 3784).  So, let's just set it and not worry about it.
	my $wheel_module = "pam_wheel.so";
	( $wheel_module ) or return error "Could not find the pam_wheel.so module";
	
	my $wheel_line = "auth       sufficient ".$wheel_module." trust group=vsxg0 use_uid";
	
	if ( $pam_su_content !~ /trust group=vsxg0/ ) {
		if ( $pam_su_content =~ /\#%/ ) {
			# Insert wheel_line after the first \n
			$pam_su_content =~ s/\n/\n$wheel_line\n/;
		} else {
			# Insert wheel_line at the very beginning
			$pam_su_content = $wheel_line."\n".$pam_su_content;
		}
	}
	
	is_ok write_string_as_file("/etc/pam.d/su", $pam_su_content)
		or return error "Failed to write /etc/pam.d/su", $Error::Last;
	
	return 1; # OK
}

sub remove_backdoor {
	if ( -f "/etc/pam.d/su.orig0" ) {
		inform "Removing the PAM backdoor";
		cmd("mv /etc/pam.d/su.orig0 /etc/pam.d/su");
	}
}

sub run {
	my ($self) = @_;
	
	my $subshell = $self->Spawn_subshell('vsx0');
	is_ok $subshell or return $Error::Last;
	
	if ( DEBUG ) {
		$subshell->Settle();
		$subshell->Send( "id"."\n" ); # DBG:
		
		$subshell->Settle();
		$subshell->Send( "env"."\n" ); # DBG:
	}

	# Change to the testsuite directory
	$subshell->Settle();
	$subshell->Send( "cd ".shq($self->{TESTRUN_PATH})."\n" );
   
	# Prepare the environment.
	$subshell->Settle();
	$subshell->Send(". ./.profile >/dev/null"."\n");

	if ( DEBUG ) {
		$subshell->Settle();
		$subshell->Send( "echo \$PATH"."\n" ); # DBG:
		
		$subshell->Settle();
		$subshell->Send( "tty; ls -la /dev/pts"."\n" ); # DBG:
	}
	
	# Run the test
	$subshell->Settle();
	$subshell->Send("./run_tests; exit\n");
	
	my $questions_wait_time = 10*60; # In seconds
	my $questions_deadline = time() + $questions_wait_time;
	
	my $started = 0;
	
	my $line;
	DIALOG_LOOP:
	while ( $line = $subshell->Read($questions_wait_time) ) {
		last if !$line; # required for 'redo'
		
		if ( $line =~ /Executing the test suites/ ) {
			# OK, the tests started
			
			# Remove the PAM backdoor
			remove_backdoor();
			
			$started = 1;
			
			last;
		}
		if ( $line =~ /mount: unknown filesystem type 'ext2'/i ) {
			# Immediatly stop the test 
			my $err = error "Can't mount 'ext2' filesystem", error $line;
			is_ok $subshell->ExpectLogout(0);
			return $err, $Error::Last;
		}
		
		# Answer the prompts
		
		$subshell->Settle($line) or redo DIALOG_LOOP;
		
		# Formalized questions
		foreach my $opt ( values %{$self->{OPTIONS}} ) {
			next if !defined $opt->{PRE} || !defined $opt->{VALUE};

			my $pre = $opt->{PRE};
			if ( $line =~ /$pre/  ) {
				
				$subshell->Send( $opt->{VALUE}."\n" );
				next DIALOG_LOOP;
			}
		}
		
		if ( $line =~ /Block special filename[^\?]*\?/ ) {
			$subshell->Send( $self->{TESTSUITE_DIR}."/nonexistb"."\n" );
		}
		elsif ( $line =~ /name of the user for PAM tests[^:]*:/ ) {
			$subshell->Send( "vsx0"."\n" );
		}
		elsif ( $line =~ /password of the user for PAM tests[^:]*:/ ) {
			$subshell->Send( $VSX0_PASSWORD );
			$subshell->Send( "\n" );
		}
		elsif ( $line =~ /password of the test user vsx1[^:]*:/ ) {
			$subshell->Send( $VSX1_PASSWORD );
			$subshell->Send( "\n" );
		}
		elsif ( $line =~ /password of the test user vsx2[^:]*:/ ) {
			$subshell->Send( $VSX2_PASSWORD );
			$subshell->Send( "\n" );
		}
		
		if ( defined $globals->{'rootpw'} ) {
			if ( $line =~ /assword:\s+$/ ) {
				$subshell->Send( $globals->{'rootpw'}."\n" );
			}
		}
		
	} continue {
		
		# Check the questions timeout
		if ( time() > $questions_deadline ) {
			inform "Time for questions is over.";
			is_ok $subshell->ExpectLogout() or return $Error::Last;
			return error "Timeout";
		}
	}
	if ( $subshell->{TIMEOUT} ) { inform "!!! Warning: timeout at subshell"; }
	
	# Just wait for the test finished
	while ( my $line = $subshell->Read(2) ) {
		$self->check_progress($line);
	}
	
	# Just confirm that the subshell has finished
	$subshell->WaitForSubshell();
	
	if ( $subshell->{EXIT_CODE} ) {
		$self->report_warning(warning "subshell exited with code ".$subshell->{EXIT_CODE}
			.".\n".$subshell->get_last_lines);
	}
	
	if ( !$started ) {
		return error "The test hasn't started";
	}
	
	return 1; # Ok
}

sub check_progress {
	my ($self, $line) = @_;
	
	defined $line or $line = "";
	
	if ( $line =~ /\d+:\d+:\d+\s+Execute (.*)[\r\n]/ ) {
		my $testcase = $1;
		$self->progress_profiled($checkpoints, $testcase);
		return;
	}
	# else:
	$self->progress_profiled();
}

sub after_run {
	my ($self) = @_;
	
	$self->{JOURNAL_FILE} = $self->name.".journal";
	$self->{JOURNAL_TYPE} = 'TET';
	
	# Find the journal file and copy it to where it should be.
	is_ok $self->copy_file_globbed( $self->{RESULTS_DIR}."/0*/journal", $self->journal_file )
		or $self->report_error(complain $Error::Last);

	return 1;
}

sub Cleanup {
	my ($self) = @_;
	
	# Remove the PAM backdoor
	remove_backdoor();
	
	detach_loops();
}

sub init_checkpoint_data {
	my ($ver) = @_;
	
	# 3.1 <= $ver < 3.2
	if ( $ver lt "3.2" ) {
		$checkpoints = [
			[ 0, '/tset/ANSI.os/charhandle/Misalnum/T.isalnum' ],
			[ 6, '/tset/ANSI.os/genuts/atoi/T.atoi' ],
			[ 12, '/tset/ANSI.os/streamio/Mclearerr/T.clearerr' ],
			[ 18, '/tset/ANSI.os/streamio/getc/T.fgetc' ],
			[ 24, '/tset/ANSI.os/time/gmtime/T.gmtime' ],
			[ 31, '/tset/POSIX.os/devclass/i_spchars/T.i_spchars' ],
			[ 42, '/tset/POSIX.os/devclass/tcflush/T.tcflush' ],
			[ 48, '/tset/POSIX.os/ioprim/Mclose/T.close' ],
			[ 54, '/tset/POSIX.os/procenv/setuid/T.setuid' ],
			[ 63, '/tset/POSIX.os/procprim/kill_X/T.kill_X' ],
			[ 72, '/tset/POSIX.os/procprim/sigaction/T.sigaction' ],
			[ 81, '/tset/POSIX.os/procprim/sigdelset/T.sigdelset' ],
			[ 87, '/tset/POSIX.os/procprim/wait/T.wait' ],
			[ 93, '/tset/LSB.os/ioprim/writev_L/T.writev_L' ],
			[ 99, '/tset/PTHR.os/threadattr/pthread_attr_setstackaddr/T.pthread_attr_setstackaddr' ],
		];
	}
	else { # 4.0
		$checkpoints = [
			[ 0, '/tset/ANSI.os/charhandle/Misalnum/T.isalnum' ],
			[ 8, '/tset/ANSI.os/genuts/free/T.free' ],
			[ 14, '/tset/ANSI.os/streamio/Mputc/T.putchar' ],
			[ 20, '/tset/ANSI.os/streamio/putc/T.putc' ],
			[ 27, '/tset/POSIX.os/devclass/i_canon/T.i_canon' ],
			[ 35, '/tset/POSIX.os/devclass/tcdrain/T.tcdrain' ],
			[ 42, '/tset/POSIX.os/devclass/tcgetattr/T.tcgetattr' ],
			[ 48, '/tset/POSIX.os/ioprim/write/T.write' ],
			[ 55, '/tset/POSIX.os/procprim/alarm/T.alarm' ],
			[ 69, '/tset/POSIX.os/procprim/raise/T.raise' ],
			[ 78, '/tset/POSIX.os/procprim/sigdelset/T.sigdelset' ],
			[ 85, '/tset/POSIX.os/procprim/waitpid/T.waitpid' ],
			[ 91, '/tset/LSB.os/ipc/Mftok/T.ftok' ],
			[ 97, '/tset/LSB.os/procprim/execvp/T.execvp' ],
		];
	}
}
#-----------------------------------------------------------------------
1; # return value