Firefox-Marionette

 view release on metacpan or  search on metacpan

t/01-marionette.t  view on Meta::CPAN


sub wait_for_server_on {
	my ($daemon, $url, $pid) = @_;
	my $host = URI->new($url)->host();
	my $port = URI->new($url)->port();
	undef $daemon;
	CONNECT: while (!IO::Socket::IP->new(Type => Socket::SOCK_STREAM(), PeerPort => $port, PeerHost => $host)) {
		diag("Waiting for server ($pid) to listen on $host:$port:$!");
		waitpid $pid, POSIX::WNOHANG();
		if (kill 0, $pid) {
			sleep 1;
		} else {
			diag("Server ($pid) has exited");
			last CONNECT;
		}
	}
	return 
}

sub empty_port {
	socket my $socket, Socket::PF_INET(), Socket::SOCK_STREAM(), 0 or die "Failed to create a socket:$!";
	bind $socket, Socket::sockaddr_in( 0, Socket::INADDR_LOOPBACK() ) or die "Failed to bind socket:$!";
	my $port = ( Socket::sockaddr_in( getsockname $socket ) )[0];
	close $socket or die "Failed to close random socket:$!";
	return $port;
}

sub process_alive {
	my ($pid) = @_;
	if ($^O eq 'MSWin32') {
		if (Win32::Process::Open(my $process, $pid, 0)) {
			$process->GetExitCode( my $exit_code );
			if ( $exit_code == Win32::Process::STILL_ACTIVE() ) {
				return 1;
			}
		} else {
			return 0;
		}
	} else {
		return kill 0, $pid;
	}
}

sub out_of_time {
	my ($package, $file, $line) = caller 1;
	if (!defined $line) {
		($package, $file, $line) = caller;
	}
	diag("Testing has been running for " . (time - $^T) . " seconds at $file line $line");
	if ($ENV{RELEASE_TESTING}) {
		return;
	} elsif (time - $^T > $test_time_limit) {
		return 1;
	} else {
		return;
	}
}

my $launches = 0;
my $ca_cert_handle;
my $ca_private_key_handle;
my $metacpan_ca_cert_handle;
my $guid_regex = qr/[a-f\d]{8}\-[a-f\d]{4}\-[a-f\d]{4}\-[a-f\d]{4}\-[a-f\d]{12}/smx;
my @old_binary_keys = (qw(firefox_binary firefox marionette));;

my ($major_version, $minor_version, $patch_version); 
sub start_firefox {
	my ($require_visible, %parameters) = @_;
	if ($terminated) {
		die "Caught a signal";
	}
	if ($ENV{FIREFOX_BINARY}) {
		my $key = shift @old_binary_keys;
		$key ||= 'binary';
		$parameters{$key} = $ENV{FIREFOX_BINARY};
		diag("Overriding firefox binary to $parameters{$key}");
	}
	if ($ENV{FIREFOX_FORCE_SCP}) {
		$parameters{scp} = 1;
	}
	if ($parameters{manual_certificate_add}) {
		delete $parameters{manual_certificate_add};
	} elsif ((defined $parameters{system_access}) && ($parameters{system_access} == 0)) {
	} elsif (defined $ca_cert_handle) {
		if ($launches % 2) {
			diag("Setting trust to list");
			$parameters{trust} = [ $ca_cert_handle->filename() ];
		} else {
			diag("Setting trust to scalar");
			$parameters{trust} = $ca_cert_handle->filename();
		}
	}
	if (defined $major_version) {
		if ($major_version >= $min_stealth_version) { # https://developer.mozilla.org/en-US/docs/Web/API/Navigator/webdriver#browser_compatibility
		} elsif ($parameters{stealth}) {
			diag("stealth support is not available for Firefox versions less than $min_stealth_version");
			delete $parameters{stealth};
		}
		if ($major_version >= $min_geo_version) {
		} elsif ($parameters{geo}) {
			diag("geo support is not available for Firefox versions less than $min_geo_version");
			delete $parameters{geo};
		}
		if ((defined $major_version) && ($major_version >= 61)) {
		} elsif ($parameters{har}) {
			diag("HAR support is not available for Firefox versions less than 61");
			delete $parameters{har};
		}
		if ((defined $major_version) && ($major_version >= 60)) {
		} elsif ($parameters{bookmarks}) {
			diag("Bookmark support is not available for Firefox versions less than 60");
			delete $parameters{bookmarks};
		}
	}
	if ($parameters{console}) {
		$parameters{console} = 1;
	}
	if (defined $ENV{WATERFOX_VIA_FIREFOX}) {
		$parameters{waterfox} = 1;
	}
        if (defined $ENV{FIREFOX_NIGHTLY}) {

t/01-marionette.t  view on Meta::CPAN

		if ($major_version < 50) {
			$correct_exit_status = $child_error;
		}
		ok($firefox->child_error() == $child_error, "Firefox returns $child_error for the child error, matching the return value of quit():$child_error:" . $firefox->child_error());
		ok(!$firefox->alive(), "Firefox is not still alive");
	} else {
		if ($ENV{FIREFOX_BINARY}) {
			skip("No profile testing when the FIREFOX_BINARY override is used", 6);
		}
		if (!$ENV{RELEASE_TESTING}) {
			skip("No profile testing except for RELEASE_TESTING", 6);
		}
		if (($ENV{WATERFOX}) || ($ENV{WATERFOX_VIA_FIREFOX})) {
			skip("No profile testing when any WATERFOX override is used", 6);
		}
		if ($ENV{FIREFOX_DEVELOPER}) {
			skip("No profile testing when the FIREFOX_DEVELOPER override is used", 6);
		}
		if ($ENV{FIREFOX_NIGHTLY}) {
			skip("No profile testing when the FIREFOX_NIGHTLY override is used", 6);
		}
		my $found;
		my @names = Firefox::Marionette::Profile->names();
		foreach my $name (@names) {
			if ($name eq 'throw') {
				$found = 1;
			}
		}
		if (!$found) {
			skip("No profile testing when throw profile doesn't exist", 6);
		}
		my $name = 'throw';
		($skip_message, $firefox) = start_firefox(0, debug => 1, har => 1, survive => 1, profile_name => $name );
		if (!$skip_message) {
			$at_least_one_success = 1;
		}
		if ($skip_message) {
			skip($skip_message, 8);
		}
		ok($firefox, "Firefox has started in Marionette mode with as survivable with a profile_name and har");
		my $capabilities = $firefox->capabilities();
		ok((ref $capabilities) eq 'Firefox::Marionette::Capabilities', "\$firefox->capabilities() returns a Firefox::Marionette::Capabilities object");
		my $firefox_pid = $capabilities->moz_process_id();
		ok($firefox_pid, "Firefox process has a process id of $firefox_pid when using a profile_name");
		ok(process_alive($firefox_pid), "Can contact firefox process ($firefox_pid) when using a profile_name");
		$firefox = undef;
		ok(process_alive($firefox_pid), "Can contact firefox process ($firefox_pid) when using a profile_name");
		($skip_message, $firefox) = start_firefox(0, debug => 1, reconnect => 1, profile_name => $name);
		ok($firefox, "Firefox has reconnected in Marionette mode when using a profile_name");
		ok($firefox_pid == $capabilities->moz_process_id(), "Firefox has the same process id when using a profile_name");
		$firefox = undef;
		ok(!process_alive($firefox_pid), "Cannot contact firefox process ($firefox_pid)");
	}
}

if ($^O eq 'MSWin32') {
} elsif ($ENV{RELEASE_TESTING}) {
	eval {
		$ca_cert_handle = File::Temp->new( TEMPLATE => File::Spec->catfile( File::Spec->tmpdir(), 'firefox_test_ca_cert_XXXXXXXXXXX')) or Firefox::Marionette::Exception->throw( "Failed to open temporary file for writing:$!");
		fcntl $ca_cert_handle, Fcntl::F_SETFD(), 0 or Carp::croak("Can't clear close-on-exec flag on temporary file:$!");
		$ca_private_key_handle = File::Temp->new( TEMPLATE => File::Spec->catfile( File::Spec->tmpdir(), 'firefox_test_ca_private_XXXXXXXXXXX')) or Firefox::Marionette::Exception->throw( "Failed to open temporary file for writing:$!");
		system {'openssl'} 'openssl', 'genrsa', '-out' => $ca_private_key_handle->filename(), 4096 and Carp::croak("Failed to generate a private key:$!");
		my $ca_config_handle = File::Temp->new( TEMPLATE => File::Spec->catfile( File::Spec->tmpdir(), 'firefox_test_ca_config_XXXXXXXXXXX')) or Firefox::Marionette::Exception->throw( "Failed to open temporary file for writing:$!");
		$ca_config_handle->print(<<"_CONFIG_");
[ req ]
distinguished_name     = req_distinguished_name
attributes             = req_attributes
prompt                 = no

[ req_distinguished_name ]
C                      = AU
ST                     = Victoria
L                      = Melbourne
O                      = David Dick
OU                     = CPAN
CN                     = Firefox::Marionette Root CA
emailAddress           = ddick\@cpan.org

[ req_attributes ]
_CONFIG_
		seek $ca_config_handle, 0, 0 or Carp::croak("Failed to seek to start of temporary file:$!");
		fcntl $ca_config_handle, Fcntl::F_SETFD(), 0 or Carp::croak("Can't clear close-on-exec flag on temporary file:$!");
		system {'openssl'} 'openssl', 'req', '-new', '-x509',
			'-set_serial' => '1',
			'-config'     => $ca_config_handle->filename(),
			'-days'       => 10,
			'-key'        => $ca_private_key_handle->filename(),
			'-out'        => $ca_cert_handle->filename()
			and Carp::croak("Failed to generate a CA root certificate:$!");
		1;
	} or do {
		chomp $@;
		diag("Did not generate a CA root certificate:$@");
	};
}

SKIP: {
	diag("Starting new firefox for testing capabilities and accessing proxies");
	my $daemon = HTTP::Daemon->new(LocalAddr => 'localhost') || die "Failed to create HTTP::Daemon";
	my $proxyPort = URI->new($daemon->url())->port();
	my $securePort = empty_port();
	diag("Using proxy port TCP/$proxyPort");
	my $socksPort = empty_port();
	diag("Using SOCKS port TCP/$socksPort");
	my %proxy_parameters = (http => 'localhost:' . $proxyPort, https => 'localhost:' . $securePort, none => [ 'local.example.org' ], socks => 'localhost:' . $socksPort);
	my $ftpPort = empty_port();
	if ($binary =~ /waterfox/i) {
	} elsif ((defined $major_version) && ($major_version < 90)) {
		diag("Using FTP port TCP/$ftpPort");
		$proxy_parameters{ftp} = 'localhost:' . $ftpPort;
	}
	my $proxy = Firefox::Marionette::Proxy->new(%proxy_parameters);
	my $bookmarks_path = File::Spec->catfile(Cwd::cwd(), qw(t data bookmarks_edge.html));
	if ($major_version == 38) {
		skip("Skipping b/c of segmentation faults for proxy capabilities", 6);
	}
	($skip_message, $firefox) = start_firefox(0, kiosk => 1, sleep_time_in_ms => 5, profile => $profile, capabilities => Firefox::Marionette::Capabilities->new(proxy => $proxy, moz_headless => 1, strict_file_interactability => 1, accept_insecure_certs =...
	if (!$skip_message) {
		$at_least_one_success = 1;
	}
	if ($skip_message) {
		skip($skip_message, 26);
	}
	ok($firefox, "Firefox has started in Marionette mode with definable capabilities set to known values");
	if ($major_version < 61) {
		skip("HAR support not available in Firefox before version 61", 1);
	} else {
		my $har_lives = 0;
		eval { $firefox->har(); $har_lives = 1 };
		chomp $@;
		ok($har_lives == 0 && $@ =~ /^(?:webdriver|javascript|unknown)[ ]error:[ ]TypeError:[ ](?:can't[ ]access[ ]property[ ]"triggerExport",[ ])?window[.]HAR[ ]is[ ]undefined[ ]at[ ]t[\/\\]01\-marionette.t[ ]line[ ]\d+/smx, "\$firefox->har() throws an ex...
	}
	if ($major_version >= 60) {
		my ($bookmark) = $firefox->bookmarks({ url => URI::URL->new($metacpan_uri . 'pod/Firefox::Marionette') });
		ok($bookmark, "Retrieved bookmark from edge import");
		ok(ref $bookmark->url() eq 'URI::URL', "\$bookmark->url() returns a URI::URL object");
		ok($bookmark->url() eq $metacpan_uri . 'pod/Firefox::Marionette', "\$bookmark->url() is '${metacpan_uri}pod/Firefox::Marionette':" . $bookmark->url());
		ok($bookmark->date_added() == 1685610972, "\$bookmark->date_added() is " . localtime $bookmark->date_added());
		ok($bookmark->title() eq 'Firefox::Marionette - Automate the Firefox browser with the Marionette protocol - metacpan.org', "\$bookmark->title() is 'Firefox::Marionette - Automate the Firefox browser with the Marionette protocol - metacpan.org':" . ...
		ok($bookmark->type() == Firefox::Marionette::Bookmark::BOOKMARK(), "\$bookmark->type() is Firefox::Marionette::Bookmark::BOOKMARK():" . $bookmark->type());
		ok($bookmark->parent_guid(), "\$bookmark->parent_guid() " . $bookmark->parent_guid());
		ok($bookmark->guid(), "\$bookmark->guid() is " . $bookmark->guid());
		($bookmark) = $firefox->bookmarks({ url => URI::URL->new('https://perlmonks.org/') });
		ok($bookmark->url() eq 'https://perlmonks.org/', "\$bookmark->url() is 'https://perlmonks.org/':" . $bookmark->url());
		ok($bookmark->date_added() == 1686364081, "\$bookmark->date_added() is " . localtime $bookmark->date_added());
		ok($bookmark->title() eq 'PerlMonks - The Monastery Gates', "\$bookmark->title() is 'PerlMonks - The Monastery Gates':" . $bookmark->title());
		ok($bookmark->type() == Firefox::Marionette::Bookmark::BOOKMARK(), "\$bookmark->type() is Firefox::Marionette::Bookmark::BOOKMARK():" . $bookmark->type());

t/01-marionette.t  view on Meta::CPAN

		no strict;
		ok($result eq &$name(), "Firefox::Marionette::Bookmark::$name() eq $name() after Firefox::Marionette::Bookmark->import(:all)");
		use strict;
	}
	my $new_max_url_length = 4321;
	my $original_max_url_length = $firefox->get_pref('browser.history.maxStateObjectSize');
	ok($original_max_url_length =~ /^\d+$/smx, "Retrieved browser.history.maxStateObjectSize as a number '$original_max_url_length'");
	ok(ref $firefox->set_pref('browser.history.maxStateObjectSize', $new_max_url_length) eq $class, "\$firefox->set_pref correctly returns itself for chaining and set 'browser.history.maxStateObjectSize' to '$new_max_url_length'");
	my $max_url_length = $firefox->get_pref('browser.history.maxStateObjectSize');
	ok($max_url_length == $new_max_url_length, "Retrieved browser.history.maxStateObjectSize which was equal to the previous setting of '$new_max_url_length'");
	ok(ref $firefox->set_pref('browser.history.maxStateObjectSize', $original_max_url_length) eq $class, "\$firefox->set_pref correctly returns itself for chaining and set 'browser.history.maxStateObjectSize' to the original '$original_max_url_length'")...
	$max_url_length = $firefox->get_pref('browser.history.maxStateObjectSize');
	ok($max_url_length == $original_max_url_length, "Retrieved browser.history.maxStateObjectSize as a number '$max_url_length' which was equal to the original setting of '$original_max_url_length'");
	my $original_use_system_colours = $firefox->get_pref('browser.display.use_system_colors');
	ok($original_use_system_colours =~ /^[01]$/smx, "Retrieved browser.display.use_system_colors as a boolean '$original_use_system_colours', and set it as true");
	ok(ref $firefox->set_pref('browser.display.use_system_colors', \1) eq $class, "\$firefox->set_pref correctly returns itself for chaining and set 'browser.display.use_system_colors' to 'true'");;
	my $use_system_colours = $firefox->get_pref('browser.display.use_system_colors');
	ok($use_system_colours, "Retrieved browser.display.use_system_colors as true '$use_system_colours'");
	ok(ref $firefox->set_pref('browser.display.use_system_colors', \0) eq $class, "\$firefox->set_pref correctly returns itself for chaining and set 'browser.display.use_system_colors' to 'false'");;
	$use_system_colours = $firefox->get_pref('browser.display.use_system_colors');
	ok(!$use_system_colours, "Retrieved browser.display.use_system_colors as false '$use_system_colours'");
	ok(ref $firefox->clear_pref('browser.display.use_system_colors', \0) eq $class, "\$firefox->clear_pref correctly returns itself for chaining and cleared 'browser.display.use_system_colors'");
	$use_system_colours = $firefox->get_pref('browser.display.use_system_colors');
	ok($use_system_colours == $original_use_system_colours, "Retrieved original browser.display.use_system_colors as a boolean '$use_system_colours'");
	ok(!defined $firefox->get_pref('browser.no_such_key'), "Returned undef when querying for a non-existant key of 'browser.no_such_key'");
	my $new_value = "Can't be real:$$";
	ok(ref $firefox->set_pref('browser.no_such_key', $new_value) eq $class, "\$firefox->set_pref correctly returns itself for chaining and set 'browser.no_such_key' to '$new_value'");
	ok($firefox->get_pref('browser.no_such_key') eq $new_value, "Returned browser.no_such_key as a string '$new_value'");
	my $new_active_colour = '#FFFFFF';
	my $original_active_colour = $firefox->get_pref('browser.active_color');
	ok($original_active_colour =~ /^[#][[:xdigit:]]{6}$/smx, "Retrieved browser.active_color as a string '$original_active_colour'");
	my $active_colour = $firefox->get_pref('browser.active_color');
	ok($active_colour eq $original_active_colour, "Retrieved browser.active_color as a string '$active_colour' which was equal to the original setting of '$original_active_colour'");
	ok(ref $firefox->set_pref('browser.active_color', $new_active_colour) eq $class, "\$firefox->set_pref correctly returns itself for chaining and set 'browser.active_color' to '$new_active_colour'");;
	$active_colour = $firefox->get_pref('browser.active_color');
	ok($active_colour eq $new_active_colour, "Retrieved browser.active_color as a string '$active_colour' which was equal to the new setting of '$new_active_colour'");
	ok(ref $firefox->clear_pref('browser.active_color') eq $class, "\$firefox->clear_pref correctly returns itself for chaining and cleared 'browser.active_color'");;
	$active_colour = $firefox->get_pref('browser.active_color');
	ok($active_colour eq $original_active_colour, "Retrieved browser.active_color as a string '$active_colour' which was equal to the original string of '$original_active_colour'");
	my $capabilities = $firefox->capabilities();
	ok((ref $capabilities) eq 'Firefox::Marionette::Capabilities', "\$firefox->capabilities() returns a Firefox::Marionette::Capabilities object");
	if (out_of_time()) {
		skip("Running out of time.  Trying to shutdown tests as fast as possible", 2);
	}
	if (!$ENV{RELEASE_TESTING}) {
		skip("Skipping network tests", 2);
	}
	if (grep /^accept_insecure_certs$/, $capabilities->enumerate()) {
		ok(!$capabilities->accept_insecure_certs(), "\$capabilities->accept_insecure_certs() is false");
		if (($ENV{FIREFOX_HOST}) && ($ENV{FIREFOX_HOST} ne 'localhost')) {
			diag("insecure cert test is not supported for remote hosts");
		} elsif (($ENV{FIREFOX_HOST}) && ($ENV{FIREFOX_HOST} eq 'localhost') && ($ENV{FIREFOX_PORT})) {
			diag("insecure cert test is not supported for remote hosts");
		} elsif ((exists $Config::Config{'d_fork'}) && (defined $Config::Config{'d_fork'}) && ($Config::Config{'d_fork'} eq 'define')) {
			my $ip_address = '127.0.0.1';
			my $daemon = IO::Socket::SSL->new(
				LocalAddr => $ip_address,
				LocalPort => 0,
				Listen => 20,
				SSL_cert_file => $ca_cert_handle->filename(),
				SSL_key_file => $ca_private_key_handle->filename(),
			);
			my $url = "https://$ip_address:" . $daemon->sockport();
			if (my $pid = fork) {
				wait_for_server_on($daemon, $url, $pid);
				eval { $firefox->go(URI->new($url)) };
				my $exception = "$@";
				chomp $exception;
				ok(ref $@ eq 'Firefox::Marionette::Exception::InsecureCertificate', $url . " threw an exception:$exception");
				while(kill 0, $pid) {
					kill $signals_by_name{TERM}, $pid;
					sleep 1;
					waitpid $pid, POSIX::WNOHANG();
				}
			} elsif (defined $pid) {
				eval {
					local $SIG{ALRM} = sub { die "alarm during insecure cert test\n" };
					alarm 40;
					$0 = "[Test insecure cert test for " . getppid . "]";
					diag("Accepting connections on $url for $0");
					foreach ((1 .. 3)) {
						my $connection = $daemon->accept();
					}
					exit 0;
				};
				chomp $@;
				diag("insecure cert test server failed:$@");
				exit 1;
			} else {
				diag("insecure cert test fork failed:$@");
			}
		} else {
			diag("No forking available for $^O");
		}
	} else {
		diag("\$capabilities->accept_insecure_certs is not supported for " . $capabilities->browser_version());
	}
	if (out_of_time()) {
		skip("Running out of time.  Trying to shutdown tests as fast as possible", 2);
	}
	my $profile_directory = $firefox->profile_directory();
	ok($profile_directory, "\$firefox->profile_directory() returns $profile_directory");
	my $possible_logins_path = File::Spec->catfile($profile_directory, 'logins.json');
	ok(!-e $possible_logins_path, "There is no logins.json file yet");
	eval { $firefox->fill_login() };
	ok(ref $@ eq 'Firefox::Marionette::Exception', "Unable to fill in form when no form is present:$@");
	my $cant_load_github;
	my $result;
	eval {
		$result = $firefox->go('https://github.com/login');
	};
	if ($@) {
		$cant_load_github = 1;
		diag("\$firefox->go('https://github.com/login') threw an exception:$@");
	} else {
		ok($result, "\$firefox loads https://github.com/login");
	}
	if (out_of_time()) {
		skip("Running out of time.  Trying to shutdown tests as fast as possible", 2);
	}
	ok(scalar $firefox->logins() == 0, "\$firefox->logins() shows the correct number (0) of records");



( run in 3.709 seconds using v1.01-cache-2.11-cpan-364913b4093 )