#!/usr/bin/perl
# -*- Mode: perl; indent-tabs-mode: nil -*-
# ***** BEGIN LICENSE BLOCK *****
# Version: MPL 1.1/GPL 2.0/LGPL 2.1
#
# The contents of this file are subject to the Mozilla Public License Version
# 1.1 (the "License"); you may not use this file except in compliance with
# the License. You may obtain a copy of the License at
# http://www.mozilla.org/MPL/
#
# Software distributed under the License is distributed on an "AS IS" basis,
# WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
# for the specific language governing rights and limitations under the
# License.
#
# The Original Code is Mozilla Automated Testing Code.
#
# The Initial Developer of the Original Code is
# Mozilla Corporation.
# Portions created by the Initial Developer are Copyright (C) 2005
# the Initial Developer. All Rights Reserved.
#
# Contributor(s): Bob Clary <bob@bclary.com>
#
# Alternatively, the contents of this file may be used under the terms of
# either the GNU General Public License Version 2 or later (the "GPL"), or
# the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
# in which case the provisions of the GPL or the LGPL are applicable instead
# of those above. If you wish to allow use of your version of this file only
# under the terms of either the GPL or the LGPL, and not to allow others to
# use your version of this file under the terms of the MPL, indicate your
# decision by deleting the provisions above and replace them with the notice
# and other provisions required by the GPL or the LGPL. If you do not delete
# the provisions above, a recipient may use your version of this file under
# the terms of any one of the MPL, the GPL or the LGPL.
#
# ***** END LICENSE BLOCK *****
# vim:sw=4:ts=8:et:ai:
# 
# This script was pulled from 
# http://lxr.mozilla.org/mozilla/source/tools/tinderbox/build-seamonkey-util.pl
# and modified to include only process control functions.
#

require 5.003;

use strict;
use POSIX qw(sys_wait_h strftime);
use Cwd;
use File::Basename; # for basename();
use Config;         # for $Config{sig_name} and $Config{sig_num}

#package ProcessUtils;

sub start
{
    my ($logfile) = @_;

    open LOG, ">$logfile"
        or die "Can not open logfile, $logfile: $?\n";
}

sub stop
{
    close LOG;
}

sub print_log {
    my ($text) = @_;
    print LOG $text;
    print $text;
}

sub run_shell_command_with_timeout {
    my ($shell_command, $timeout_secs) = @_;
    my $now = localtime();
    local $_;

    chomp($shell_command);
    print_log "Begin: $now\n";
    print_log "$shell_command\n";

    my $pid = fork; # Fork off a child process.

    unless ($pid) { # child
        my $status = 0;
        open CMD, "$shell_command 2>&1 |" or die "open: $!";
        print_log $_ while <CMD>;
        close CMD or $status = 1;
        exit($status);
    }
    my $result = wait_for_pid($pid, $timeout_secs);

    $now = localtime();
    print_log "End:   $now\n";

    return $result;
}


sub run_shell_command {
    my ($shell_command) = @_;
    local $_;

    my $status = 0;
    chomp($shell_command);
    print_log "$shell_command\n";
    open CMD, "$shell_command 2>&1 |" or die "open: $!";
    print_log $_ while <CMD>;
    close CMD or $status = 1;
    return $status;
}

# Parse a file for $token, given a file handle.
sub file_has_token {
    my ($filename, $token) = @_;
    local $_;
    my $has_token = 0;
    open TESTLOG, "<$filename" or die "Cannot open file, $filename: $!";
    while (<TESTLOG>) {
        if (/$token/) {
            $has_token = 1;
            last;
        }
    }
    close TESTLOG;
    return $has_token;
}

# Parse a file for $token, return the token.
# Look for the line "<token><delimiter><return-value>", e.g.
# for "__startuptime,5501"
#   token        = "__startuptime"
#   delimiter    = ","
#   return-value = "5501";
#
sub extract_token_from_file {
    my ($filename, $token, $delimiter) = @_;
    local $_;
    my $token_value = 0;
    open TESTLOG, "<$filename" or die "Cannot open file, $filename: $!";
    while (<TESTLOG>) {
        if (/$token/) {
            # pull the token out of $_
            $token_value = substr($_, index($_, $delimiter) + 1);
            chomp($token_value);
            last;
        }
    }
    close TESTLOG;
    return $token_value;
}


sub kill_process {
    my ($target_pid) = @_;
    my $start_time = time;

    # Try to kill and wait 10 seconds, then try a kill -9
    my $sig;
    for $sig ('TERM', 'KILL') {
        print "kill $sig $target_pid\n";
        kill $sig => $target_pid;
        my $interval_start = time;
        while (time - $interval_start < 10) {
            # the following will work with 'cygwin' perl on win32, but not 
            # with 'MSWin32' (ActiveState) perl
            my $pid = waitpid($target_pid, POSIX::WNOHANG());
            if (($pid == $target_pid and POSIX::WIFEXITED($?)) or $pid == -1) {
                my $secs = time - $start_time;
                $secs = $secs == 1 ? '1 second' : "$secs seconds";
                print_log "Process killed. Took $secs to die.\n";
                return;
            }
            sleep 1;
        }
    }
    die "Unable to kill process: $target_pid";
}

BEGIN {
    my %sig_num = ();
    my @sig_name = ();

    sub signal_name {
        # Find the name of a signal number
        my ($number) = @_;

        unless (@sig_name) {
            unless($Config::Config{sig_name} && $Config::Config{sig_num}) {
                die "No sigs?";
            } else {
                my @names = split ' ', $Config::Config{sig_name};
                @sig_num{@names} = split ' ', $Config::Config{sig_num};
                foreach (@names) {
                    $sig_name[$sig_num{$_}] ||= $_;
                }
            }
        }
        return $sig_name[$number];
    }
}

sub fork_and_log {
    # Fork a sub process and log the output.
    my ($home, $dir, $args, $logfile) = @_;

    my $pid = fork; # Fork off a child process.

    unless ($pid) { # child

        # Explicitly set cwd to home dir.
        chdir $home or die "chdir($home): $!\n";

        # Now cd to dir where binary is..
        chdir $dir or die "chdir($dir): $!\n";

        open STDOUT, ">$logfile";
        open STDERR, ">&STDOUT";
        select STDOUT; $| = 1;  # make STDOUT unbuffered
        select STDERR; $| = 1;  # make STDERR unbuffered
        exec { $args->[0] } @$args;
        die "Could not exec()";
    }
    return $pid;
}

# Stripped down version of fork_and_log().
sub system_fork_and_log {
    # Fork a sub process and log the output.
    my ($cmd) = @_;

    my $pid = fork; # Fork off a child process.

    unless ($pid) { # child
        exec $cmd;
        die "Could not exec()";
    }
    return $pid;
}


sub wait_for_pid {
    # Wait for a process to exit or kill it if it takes too long.
    my ($pid, $timeout_secs) = @_;
    my ($exit_value, $signal_num, $dumped_core, $timed_out) = (0,0,0,0);
    my $sig_name;
    my $loop_count;

    die ("Invalid timeout value passed to wait_for_pid()\n")
        if ($timeout_secs <= 0);

    eval {
        $loop_count = 0;
        while (++$loop_count < $timeout_secs) {
            my $wait_pid = waitpid($pid, POSIX::WNOHANG());
            # the following will work with 'cygwin' perl on win32, but not 
            # with 'MSWin32' (ActiveState) perl
            last if ($wait_pid == $pid and POSIX::WIFEXITED($?)) or $wait_pid == -1;
            sleep 1;
        }

        $exit_value = $? >> 8;
        $signal_num = $? >> 127;
        $dumped_core = $? & 128;
        if ($loop_count >= $timeout_secs) {
            die "timeout";
        }
        return "done";
    };

    if ($@) {
        if ($@ =~ /timeout/) {
            kill_process($pid);
            $timed_out = 1;
        } else { # Died for some other reason.
            die; # Propagate the error up.
        }
    }
    $sig_name = $signal_num ? signal_name($signal_num) : '';

    return { timed_out=>$timed_out,
             exit_value=>$exit_value,
             sig_name=>$sig_name,
             dumped_core=>$dumped_core };
}

#
# Note that fork_and_log() sets the HOME env variable to do
# the command, this allows us to have a local profile in the
# shared cltbld user account.
#
sub run_cmd {
    my ($home_dir, $binary_dir, $args, $logfile, $timeout_secs) = @_;
    my $now = localtime();

    print_log "Begin: $now\n";
    print_log "cmd = " . join(' ', @{$args}) . "\n";

    my $pid = fork_and_log($home_dir, $binary_dir, $args, $logfile);
    my $result = wait_for_pid($pid, $timeout_secs);

    $now = localtime();
    print_log "End:   $now\n";

    return $result;
}

# System version of run_cmd().
sub run_system_cmd {
    my ($cmd, $timeout_secs) = @_;

    print_log "cmd = $cmd\n";
    my $pid = system_fork_and_log($cmd);
    my $result = wait_for_pid($pid, $timeout_secs);

    return $result;
}

sub get_system_cwd {
    my $a = Cwd::getcwd()||`pwd`;
    chomp($a);
    return $a;
}

sub print_test_errors {
    my ($result, $name) = @_;

    if (not $result->{timed_out} and $result->{exit_value} != 0) {
        if ($result->{sig_name} ne '') {
            print_log "Error: $name: received SIG$result->{sig_name}\n";
        }
        print_log "Error: $name: exited with status $result->{exit_value}\n";
        if ($result->{dumped_core}) {
            print_log "Error: $name: dumped core.\n";
        }
    }
}



sub print_logfile {
    my ($logfile, $test_name) = @_;
    print_log "----------- Output from $test_name ------------- \n";
    open READRUNLOG, "$logfile";
    print_log "  $_" while <READRUNLOG>;
    close READRUNLOG;
    print_log "----------- End Output from $test_name --------- \n";
}


# Start up Mozilla, test passes if Mozilla is still alive
# after $timeout_secs (seconds).
#
sub AliveTest {
    my ($test_name, $build_dir, $args, $timeout_secs) = @_;
    my $binary = @$args[0];
    my $binary_basename = File::Basename::basename($binary);
    my $binary_dir = File::Basename::dirname($binary);
    my $binary_log = "$build_dir/$test_name.log";
    local $_;

    # Print out testname
    print_log "\n\nRunning $test_name test ...\n";

    # Debug
    #print_log "\n\nbuild_dir = $build_dir ...\n";
    #print_log "\n\nbinary_dir = $binary_dir ...\n";
    #print_log "\n\nbinary = $binary ...\n";

    # Print out timeout.
    print_log "Timeout = $timeout_secs seconds.\n";

    my $result = run_cmd($build_dir, $binary_dir, $args,
                         $binary_log, $timeout_secs);

    print_logfile($binary_log, "$test_name");

    if ($result->{timed_out}) {
        print_log "$test_name: $binary_basename successfully stayed up"
            ." for $timeout_secs seconds.\n";
        return 'success';
    } else {
        print_test_errors($result, $binary_basename);
        print_log "$test_name: test failed\n";
        return 'testfailed';
    }
}

# Same as AliveTest, but look for a token in the log and return
# the value.  (used for startup iteration test).
sub AliveTestReturnToken {
    my ($test_name, $build_dir, $args, $timeout_secs, $token, $delimiter) = @_;
    my $status;
    my $rv = 0;

    # Same as in AliveTest, needs to match in order to find the log file.
    my $binary = @$args[0];
    my $binary_basename = File::Basename::basename($binary);
    my $binary_dir = File::Basename::dirname($binary);
    my $binary_log = "$build_dir/$test_name.log";

    $status = AliveTest($test_name, $build_dir, $args, $timeout_secs);

    # Look for and return token
    if ($status) {
        $rv = extract_token_from_file($binary_log, $token, $delimiter);
        chomp($rv);
        chop($rv) if ($rv =~ /\r$/); # cygwin perl doesn't chomp dos-newlinesproperly so use chop.
        if ($rv) {
            print "AliveTestReturnToken: token value = $rv\n";
        }
    }

    return $rv;
}


# Run a generic test that writes output to stdout, save that output to a
# file, parse the file looking for failure token and report status based
# on that.  A hack, but should be useful for many tests.
#
# test_name = Name of test we're gonna run, in $Settings::DistBin.
# testExecString = How to run the test
# testTimeoutSec = Timeout for hung tests, minimum test time.
# statusToken = What string to look for in test output to
#     determine test status.
# statusTokenMeansPass = Default use of status token is to look for
#     failure string.  If this is set to 1, then invert logic to look for
#     success string.
#
# timeout_is_ok = Don't report test failure if test times out.
#
# Note: I tried to merge this function with AliveTest(),
#       the process flow control got too confusing :(  -mcafee
#
sub FileBasedTest {
    my ($test_name, $build_dir, $binary_dir, $test_args, $timeout_secs,
        $status_token, $status_token_means_pass, $timeout_is_ok) = @_;
    local $_;

    # Assume the app is the first argument in the array.
    my ($binary_basename) = @$test_args[0];
    my $binary_log = "$build_dir/$test_name.log";

    # Print out test name
    print_log "\n\nRunning $test_name ...\n";

    my $result = run_cmd($build_dir, $binary_dir, $test_args,
                         $binary_log, $timeout_secs);

    print_logfile($binary_log, $test_name);

    if (($result->{timed_out}) and (!$timeout_is_ok)) {
      print_log "Error: $test_name timed out after $timeout_secs seconds.\n";
      return 'testfailed';
    } elsif ($result->{exit_value} != 0) {
      print_log "Error: $test_name exited with status $result->{exit_value}\n";
      print_test_errors($result, $test_name);
      return 'testfailed';
    } else {
      print_log "$test_name exited normally\n";
    }

    my $found_token = file_has_token($binary_log, $status_token);
    if ($found_token) {
        print_log "Found status token in log file: $status_token\n";
    } else {
        print_log "Status token, $status_token, not found\n";
    }

    if (($status_token_means_pass and $found_token) or
        (not $status_token_means_pass and not $found_token)) {
        return 'success';
    } else {
        print_log "Error: $test_name has failed.\n";
        return 'testfailed';
    }
} # FileBasedTest

# Need to end with a true value, (since we're using "require").
1;
