#
# ***** 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.org code.
#
# The Initial Developer of the Original Code is
# Mozilla Foundation.
# Portions created by the Initial Developer are Copyright (C) 1998
# the Initial Developer. All Rights Reserved.
#
# Contributor(s):
#   Robert Sayre <sayrer@gmail.com>
#   Jeff Walden <jwalden+bmo@mit.edu>
#
# 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 *****

# Win32 path munging for msys courtesy the Curl project under an
# MIT/X license http://curl.haxx.se/
#
# Copyright (c) 1996 - 2007, Daniel Stenberg, <daniel@haxx.se>.
# All rights reserved.
#
# Permission to use, copy, modify, and distribute this software for
# any purpose with or without fee is hereby granted, provided that the
# above copyright notice and this permission notice appear in all
# copies.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
# NONINFRINGEMENT OF THIRD PARTY RIGHTS. IN NO EVENT SHALL THE AUTHORS
# OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
# ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE
# OR OTHER DEALINGS IN THE SOFTWARE.
#
# Except as contained in this notice, the name of a copyright holder
# shall not be used in advertising or otherwise to promote the sale,
# use or other dealings in this Software without prior written
# authorization of the copyright holder.

 # Perl script to start server and browser
 # For usage instructions, run:
 # perl runtests.pl --help 

use FindBin;
use File::Path;
use File::Spec;
use File::Basename;
use Getopt::Long;
use Cwd 'abs_path';
use POSIX qw(sys_wait_h strftime);

use strict;

 # URL parameters to test URL:
 #
 # autorun -- kick off tests automatically
 # closeWhenDone -- runs quit.js after tests
 # logFile -- logs test run to an absolute path
 #

 # consoleLevel, fileLevel: set the logging level of the console and
 # file logs, if activated.
 # <http://mochikit.com/doc/html/MochiKit/Logging.html>

 # Path to the test script on the server
use constant TEST_SERVER_HOST => "localhost:8888";
use constant TEST_PATH => "/tests/";
use constant CHROME_PATH => "/redirect.html";
use constant A11Y_PATH => "/redirect-a11y.html";
use constant TESTS_URL => "http://" . TEST_SERVER_HOST . TEST_PATH;
use constant CHROMETESTS_URL => "http://" . TEST_SERVER_HOST . CHROME_PATH;
use constant A11YTESTS_URL => "http://" . TEST_SERVER_HOST . A11Y_PATH;
 # main browser chrome URL, same as browser.chromeURL pref
#ifdef MOZ_SUITE
use constant BROWSER_CHROME_URL => "chrome://navigator/content/navigator.xul";
#else
use constant BROWSER_CHROME_URL => "chrome://browser/content/browser.xul";
#endif

 # Max time in seconds to wait for server startup before tests will fail -- if
 # this seems big, it's mostly for debug machines where cold startup
 # (particularly after a build) takes forever.
use constant SERVER_STARTUP_TIMEOUT => 45;


 # Since some tests require cross-domain support in Mochitest, across ports,
 # domains, subdomains, etc. we use a proxy autoconfig hack to map a bunch of
 # servers onto localhost:8888.  We have to grant them the same privileges as
 # localhost:8888 here, since the browser only knows them as the URLs they're
 # pretending to be.
my @servers = (
               "localhost:8888", # MUST be first -- see PAC pref-setting code
               "example.org:80",
               "test1.example.org:80",
               "test2.example.org:80",
               "sub1.test1.example.org:80",
               "sub1.test2.example.org:80",
               "sub2.test1.example.org:80",
               "sub2.test2.example.org:80",
               "example.org:8000",
               "test1.example.org:8000",
               "test2.example.org:8000",
               "sub1.test1.example.org:8000",
               "sub1.test2.example.org:8000",
               "sub2.test1.example.org:8000",
               "sub2.test2.example.org:8000",
               "example.com:80",
               "test1.example.com:80",
               "test2.example.com:80",
               "sub1.test1.example.com:80",
               "sub1.test2.example.com:80",
               "sub2.test1.example.com:80",
               "sub2.test2.example.com:80",
               "sectest1.example.org:80",
               "sub.sectest2.example.org:80",
               "sub1.xn--lt-uia.example.org:8000", # U+00E4 U+006C U+0074
               "sub2.xn--lt-uia.example.org:80",   # U+00E4 U+006C U+0074
               "xn--exmple-cua.test:80",
               "sub1.xn--exmple-cua.test:80",
               "xn--hxajbheg2az3al.xn--jxalpdlp:80", # Greek IDN for example.test
               "sub1.xn--hxajbheg2az3al.xn--jxalpdlp:80",
              );


my $profile = "mochitesttestingprofile";
my $profile_dir = "$FindBin::Bin/$profile";

 # These are generated in mozilla/testing/mochitest/Makefile.in
#expand my $app = "$FindBin::Bin/" . __BROWSER_PATH__;
#expand my $dist_bin = "$FindBin::Bin/" . __XPC_BIN_PATH__;
#ifdef WIN32
#expand my $is_win32 = __WIN32__;
#else
my $is_win32 = 0;
#endif
my $is_mac = ($^O =~ m/darwin/);
my $unixish = (!($is_win32) && !($is_mac));

 # Do everything.
 main();


 #################
 # MAIN FUNCTION #
 #################

sub main {
  my ($close_when_done, $appoverride, $log_path, $autorun,
      $console_level, $file_level, $help, $do_chrome, $test_path,
      $do_browser_chrome, $do_a11y, %browser_env, %browser_args);
  GetOptions("close-when-done!"=> \$close_when_done,
             "appname:s"=> \$appoverride,
             "log-file:s" => \$log_path,
             "autorun!" => \$autorun,
             "console-level:s" => \$console_level,
             "file-level:s" => \$file_level,
             "chrome!" => \$do_chrome,
             "test-path:s" => \$test_path,
             "browser-chrome!" => \$do_browser_chrome,
             "a11y!" => \$do_a11y,
             "setenv=s%" => \%browser_env,
             "browser-arg=s%" => \%browser_args,
             "help!" => \$help);

  # if the switches include --help, exit and print directions
  if ($help) {
    usage_and_exit();
  }

  # we were passed an explicit path to the app
  if ($appoverride) {
    $app = $appoverride;
  }

  # make sure the application we're going to use exists
  unless (-e $app) {
    my $error_message = "\nError: Path \"$app\" doesn't exist.\n";
    $error_message .= "Are you executing ";
    $error_message .= "\$objdir/_tests/testing/mochitest/runtests.pl?\n\n";
    die $error_message;
  }

  my $manifest = initializeProfile($app, $do_browser_chrome);
  my $serverPid = startServer($close_when_done);

  # If we're lucky, the server has fully started by now, and all paths are
  # ready, etc.  However, xpcshell cold start times suck, at least for debug
  # builds.  We'll try to connect to the server for 30 seconds or until we
  # succeed, whichever is first.  If we succeed, then we continue with
  # execution.  If we fail, we try to kill the server and exit with an error.
  wait_for_server_startup($serverPid, SERVER_STARTUP_TIMEOUT);

  my $url;
  if ($do_chrome) {
   $url = CHROMETESTS_URL . ($test_path ? $test_path : "") . "?";
  } elsif ($do_browser_chrome) {
   # Tests will run from an overlay, no need to load any URL.  We'll include
   # the test path in the config file so the browser chrome harness can use it.
   $url = "about:blank";
  } elsif ($do_a11y) {
   $url = A11YTESTS_URL . ($test_path ? $test_path : "") . "?";
  } else {
   $url = TESTS_URL . ($test_path ? $test_path : "") . "?";
  }

  if ($do_browser_chrome) {
    generate_test_config($autorun, $close_when_done, $log_path, $test_path);
  } else {
    if ($autorun) {
      $url .= "&autorun=1";
    }
    if ($close_when_done) {
      $url .= "&closeWhenDone=1";
    }
    if ($log_path) {
      $url .= "&logFile=$log_path";
    }
    if ($file_level) {
      $url .= "&fileLevel=$file_level";
    }
    if ($console_level) {
      $url .= "&consoleLevel=$console_level";
    }
  }
  
  my $test_start = runTests($url, \%browser_env, \%browser_args);

  shutdownServer($serverPid);

  # print test run times
  my $test_finish = localtime();
  print " started: $test_start\n";
  print "finished: $test_finish\n";

  # delete the profile and manifest
  # rmtree($profile_dir, 0, 0);
  unlink($manifest);
}

 #######################
 # COMMANDLINE USAGE   #
 #######################

sub usage_and_exit {
  print "\n";
  print "Usage instructons for runtests.pl.\n";
  print "If --log-file is specified, --file-level must be specified as well.\n";
  print "If --chrome is specified, chrome tests will be run instead of web content tests.\n";
  print "If --browser-chrome is specified, browser-chrome tests will be run instead of web content tests.\n";
  print "If --a11y is specified, a11y tests will be run instead of web content tests.";
  print "\n\n";
  print "Syntax:\n";
  print "  runtests.pl \\\n";
  print "   [--autorun] \\\n";
  print "   [--chrome] \\\n";
  print "   [--browser-chrome] \\\n";
  print "   [--a11y] \\\n";
  print "   [--close-when-done] \\\n";
  print "   [--appname=/path/to/app] \\\n";
  print "   [--log-file=/path/to/logfile] \\\n";
  print "   [--test-path=relative/path/to/tests] \\\n";
  print "   [--setenv=VAR=value] \\\n";  
  print "   [--browser-arg=VAR=value] \\\n";
  print "   [--file-level=DEBUG|INFO|ERROR|FATAL|WARNING] \\\n";  
  print "   [--console-level=DEBUG|INFO|ERROR|FATAL|WARNING] \n\n";  
  exit(1);
}

 #######################
 # MAKE A WINDOWS PATH #
 #######################

#ifdef IS_CYGWIN

sub winPathFromDir {
  my ($path) = abs_path(@_);

  # Use external cygpath command to get the windows-like path
  $path = `cygpath -w $path`;
  
  # Just remove the traling CR char
  chop($path);
  return $path;
}

#else
# Non-cygwin version

sub winPathFromDir {
  my ($path) = abs_path(@_);

  # This is a windows mingw32 build, we need to translate the
  # given path to the "actual" windows path.

  my @m = `mount`;
  my $matchlen;
  my $bestmatch;
  my $mount;

  #example mount output:
  # C:\DOCUME~1\Temp on /tmp type user (binmode,noumount)
  # c:\ActiveState\perl on /perl type user (binmode)
  # C:\msys\1.0\bin on /usr/bin type user (binmode,cygexec,noumount)
  # C:\msys\1.0\bin on /bin type user (binmode,cygexec,noumount)
  foreach $mount (@m) {
    if ( $mount =~ /(.*) on ([^ ]*) type /) {
      my ($mingw, $real)=($2, $1);
      if ($path =~ /^$mingw/i) {
        # the path starts with the path we
        # found on this line in the mount output
        my $len = length($mingw);
        if ($len > $matchlen) {
          # we remember the match that is the longest
          $matchlen = $len;
          $bestmatch = $real;
        }
      }
    }
  }
  if (!$matchlen) {
    die "Serious error, can't find our \"real\" path!\n";
  }

  my ($volume,$directories,$file) =
    File::Spec->splitpath(substr($path, $matchlen), 1);
  my @dirs = File::Spec->splitdir( $directories );
  return $bestmatch . "\\" . join "\\", @dirs;
}

# End of non-cygwin version
#endif

 ##################
 # SERVER STARTUP #
 ##################

 # Start up the server, and let the server script handle shutdown if
 # we're closing when done.  (We'll kill it later if it goes zombie
 # somehow, but that shouldn't be the way it happens except if
 # something really breaks.)

sub startServer {
  my ($close_when_done) = @_;
  my $pid = fork();
  if ($pid == 0) {
    # Run the server
    my $status = 0;

    if ($close_when_done) {
      $ENV{'CLOSE_WHEN_DONE'} = '1';
    }

    if ($unixish) {
      $ENV{'LD_LIBRARY_PATH'} = $dist_bin;
      $ENV{'MOZILLA_FIVE_HOME'} = $dist_bin;
    }

    my @runargs = ("$dist_bin/xpcshell", "-v", "170");

    # this path is passed as a string, so we need to convert it on win32
    if ($is_win32) {
      push(@runargs, "-f", winPathFromDir($FindBin::Bin) . "\\httpd.js");
      push(@runargs, "-f", winPathFromDir($FindBin::Bin) . "\\server.js");
    } else {
      push(@runargs, "-f", $FindBin::Bin . "/httpd.js");
      push(@runargs, "-f", $FindBin::Bin . "/server.js");
    }
    print "@runargs\n";
    exec @runargs or die("Error running server: $!\n");
  }

  return ($pid);
}


 ##############
 # TEST SETUP #
 ##############

sub generate_test_config {
  my ($autorun, $close_when_done, $log_path, $test_path) = @_;
  $autorun = $autorun || 0;
  $close_when_done = $close_when_done || 0;
  $log_path = $log_path || "";
  $log_path =~ s/\\/\\\\/g;
  $test_path = $test_path || "";
  $test_path =~ s/\\/\\\\/g;

  my $config_content = <<CONFIGEND;
({
  autoRun: $autorun,
  closeWhenDone: $close_when_done,
  logPath: "$log_path",
  testPath: "$test_path"
})
CONFIGEND

  open(CONFIGOUTFILE, ">$profile_dir/testConfig.js") ||
    die("Could not open testConfig.js file $!");
  print CONFIGOUTFILE ($config_content);
  close(CONFIGOUTFILE);
}

sub initializeProfile {
  my ($app_path, $do_browser_tests) = @_;
  my $pref_content = <<PREFEND;
user_pref("browser.dom.window.dump.enabled", true);
user_pref("dom.disable_open_during_load", false);
user_pref("dom.max_script_run_time", 0); // no slow script dialogs
user_pref("signed.applets.codebase_principal_support", true);
user_pref("security.warn_submit_insecure", false);
user_pref("browser.shell.checkDefaultBrowser", false);
user_pref("browser.warnOnQuit", false);
PREFEND

  # Grant God-power to all the servers on which tests can run.
  my $i = 1;
  my $server;
  foreach $server (@servers) {
    $pref_content .= <<SERVERPREFEND;
user_pref("capability.principal.codebase.p$i.granted", "UniversalXPConnect UniversalBrowserRead UniversalBrowserWrite UniversalPreferencesRead UniversalPreferencesWrite UniversalFileRead");
user_pref("capability.principal.codebase.p$i.id", "http://$server");
user_pref("capability.principal.codebase.p$i.subjectName", "");
SERVERPREFEND
    $i++;
  }

  # Now add the two servers that do NOT have God-power so we can properly test
  # the granting and receiving of God-power
  push(@servers,
       "sectest2.example.org:80",
       "sub.sectest1.example.org:80");


  # Now actually create the preference to make the proxying happen, stripping
  # off the first server because it's the one to which we proxy all the others.
  my $quotedServers = join(", ", map("'" . $_ . "'", @servers[1 .. $#servers]));

  my $pacURL = "data:text/plain,";
  $pacURL   .= "function FindProxyForURL(url, host)             ";
  $pacURL   .= "{                                               ";
  $pacURL   .= "  var servers = [$quotedServers];               ";
  $pacURL   .= "  var regex =                                   ";
  $pacURL   .= "    new RegExp('http://(?:[^/@]*@)?(.*?(:\\\\\\\\d+)?)/');  ";
  $pacURL   .= "  var matches = regex.exec(url);                ";
  $pacURL   .= "  if (!matches)                                 ";
  $pacURL   .= "    return 'DIRECT';                            ";
  $pacURL   .= "  var hostport = matches[1], port = matches[2]; ";
  $pacURL   .= "  if (!port)                                    ";
  $pacURL   .= "    hostport += ':80';                          ";
  $pacURL   .= "  if (servers.indexOf(hostport) >= 0)           ";
  $pacURL   .= "    return 'PROXY localhost:8888';              ";
  $pacURL   .= "  return 'DIRECT';                              ";
  $pacURL   .= "}";

  $pref_content .= <<PROXYPREFEND;
user_pref("network.proxy.type", 2);
user_pref("network.proxy.autoconfig_url", "$pacURL");
PROXYPREFEND


  my $chrome_content = <<CHROMEEND;
\@namespace url("http://www.mozilla.org/keymaster/gatekeeper/there.is.only.xul"); /* set default namespace to XUL */
toolbar,
toolbarpalette {
  background-color: rgb(235, 235, 235) !important;
}
toolbar#nav-bar {
  background-image: none !important;
}
CHROMEEND

  # in case we died for some reason on the last run
  rmtree($profile_dir, 0, 0);

  my $chrome_dir = "$profile_dir/chrome";
  mkdir($profile_dir);
  mkdir($chrome_dir);

  # append magic prefs to user.js
  open(PREFOUTFILE, ">>$profile_dir/user.js") ||
    die("Could not open user.js file $!\n");
  print PREFOUTFILE ($pref_content);
  close(PREFOUTFILE) or die("Couldn't close user.js file: $!\n");

  # add userChrome.css
  open(CHROMEOUTFILE, ">>$chrome_dir/userChrome.css") ||
    die("Could not open userChrome.css file $!");
  print CHROMEOUTFILE ($chrome_content);
  close(CHROMEOUTFILE);

  # register our chrome dir
  my $chrometest_dir = "$FindBin::Bin/";
  if ($is_win32) {
    # we don't have LWP, so we can't use its file url stuff
    $chrometest_dir = winPathFromDir($chrometest_dir) . "\\";
    $chrometest_dir =~ s/\\/\//g;
    $chrometest_dir = "file:///$chrometest_dir";
  }
  
  my($filename, $directories, $suffix) = fileparse($app_path);
  my $manifest = $directories . "chrome/mochikit.manifest";
  open(MANIFEST, ">$manifest") ||
    die("Could not open manifest file $!");
  print MANIFEST ("content mochikit $chrometest_dir\n");
  if ($do_browser_tests) {
    print MANIFEST ("overlay " . BROWSER_CHROME_URL . " chrome://mochikit/content/browser-test-overlay.xul\n");
  }
  close(MANIFEST);

  return $manifest;
}

 ###################
 # WAIT FOR SERVER #
 ###################

sub wait_for_server_startup {
  my ($pid, $timeout) = @_;

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

  eval {
      my $loop_count = 0;
      while ($loop_count++ < $timeout) {
          last if (-e "$profile_dir/server_alive.txt");
          sleep 1;
      }

      die "timeout" if ($loop_count >= $timeout);
      return "done";
  };

  my $time_out_message;
  if ($@) {
    if ($@ =~ /timeout/) {
      $time_out_message = "\nError: ";
      $time_out_message = "Timed out while waiting for server startup.\n";
    } else {
      # Died for some other reason.
      $time_out_message = "An unknown error occurred ";
      $time_out_message .= "while waiting for server startup.\n";
    }
  }

  if ($time_out_message) {
    kill_process($pid);
    print $time_out_message;
    exit(1);
  }
}

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 "Process killed. Took $secs to die.\n";
        return;
      }
      sleep 1;
    }
  }
  die "Unable to kill process: $target_pid";
}

 ##################
 # TEST EXECUTION #
 ##################

sub runTests {
  my ($test_url, $browser_env, $browser_args) = @_;

  # mark the start
  my $test_start = localtime();

  # set env vars so Firefox doesn't quit weirdly and break the script
  $ENV{'NO_EM_RESTART'} = '1';
  $ENV{'XPCOM_DEBUG_BREAK'} = 'warn';

  if ($unixish) {
    $ENV{'LD_LIBRARY_PATH'} = $dist_bin;
    $ENV{'MOZILLA_FIVE_HOME'} = $dist_bin;
  }

  for my $key (keys(%{$browser_env})) {
    $ENV{$key} = $browser_env->{$key};
  }

  my $profile_arg = "$profile_dir";
  if ($is_win32) {
    $profile_arg = winPathFromDir($profile_dir);
  }

  # now run with the profile we created

  # On Windows and Linux, the application is focused for us. On OS X, we
  # need to use applescript to focus the app and then set the url.
  my $rc = -1;
  if (!$is_mac) {
    my @runargs = ($app, '-no-remote', '-profile', $profile_arg);
    if ($browser_args) {
      foreach my $key (keys %$browser_args) {
        push(@runargs, ($key,
			$browser_args->{$key})
	    );
      }
    }
    push(@runargs, $test_url);
    $rc = 0xffff & system @runargs;
  } else {
    $rc = executeMac($profile_arg, $test_url, $browser_args);
  }

  if ($rc != 0) {
    print "FAIL Exited with code $rc during test run\n";
  }

  return $test_start;
}

sub executeMac {
  my ($profile_arg, $test_url, $browser_args) = @_;
  my $pid = fork();
  if (not defined $pid) {
    die "cannot fork: $!";
  } elsif ($pid == 0) {
    # run only the executable so we get a pid we can focus
    if ($app !~ /-bin$/) {
        $app .= "-bin";
    }
    my @runargs = ($app, '-foreground', '-no-remote', '-profile', $profile_arg);
    if ($browser_args) {
      foreach my $key (keys %$browser_args) {     
        push(@runargs, ($key,
                        $browser_args->{$key})
            );
      }
    }
    push(@runargs, $test_url);
    
    # redirect stderr to stdout for easier buildbot / tinderbox logging
    #$ENV{'XPCOM_DEBUG_BREAK'} = 'stack';
    open (STDERR, '>&', \*STDOUT) || die $!;
    exec @runargs or die("Error starting application: $!\n");
  } else {
    waitpid($pid,0);
  }

  # return the exit code we received from waitpid
  return $?;
}

 ##################
 # SHUT DOWN      #
 ##################

sub shutdownServer {
  my ($pid) = @_;
  kill_process($pid);
}