You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
74 lines
2.2 KiB
Perl
74 lines
2.2 KiB
Perl
#!/usr/bin/perl -w
|
|
#
|
|
# Test Webspace login
|
|
#
|
|
# By Igor Gubenko (igubenko@Princeton.EDU), 06/12/2012
|
|
# Updated line 36 4/3/2019
|
|
|
|
use strict;
|
|
use lib qw(/usr/local/perl/lib/perl5/x86_64-linux-thread-multi /usr/local/perl/lib/perl5);
|
|
use WWW::Mechanize;
|
|
#use Net::SSL; # From Crypt-SSLeay
|
|
#use LWP::Protocol::https;
|
|
#BEGIN {
|
|
# $Net::HTTPS::SSL_SOCKET_CLASS = "Net::SSL"; # Force use of Net::SSL
|
|
# $ENV{PERL_NET_HTTPS_SSL_SOCKET_CLASS}="IO::Socket::SSL";
|
|
#}
|
|
$ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = 0;
|
|
#$ENV{HTTPS_VERSION} = 3;
|
|
|
|
sub usage;
|
|
|
|
my $progname = $0;
|
|
|
|
usage unless @ARGV == 1;
|
|
|
|
my $mech = WWW::Mechanize->new (agent => 'Mozilla/5.0', stack_depth => '1', noproxy => '1', quiet => '1', onerror => undef, onwarn => undef, timeout => '20') or die ("Unable to instantiate WWW::Mechanize!\n");
|
|
#$mech -> add_handler("request_send", sub { shift->dump; return });
|
|
#$mech -> add_handler("response_done", sub { shift->dump; return });
|
|
|
|
my ($url) = @ARGV;
|
|
|
|
# Retrieve initial URL - this is just a redirect
|
|
$mech->get ($url);
|
|
|
|
unless ($mech -> success() && $mech->title() =~ m#Xythos WFS#) {
|
|
print "Redirection to CAS Server Failed - Error Code:" . $mech->status() . "\n";
|
|
# print "Failed to fetch \"${url}\". Answer: " . $mech->status() . "; " . $mech->title() . "\n";
|
|
exit 2;
|
|
}
|
|
|
|
unless ($mech -> response() -> decoded_content =~ m#meta http-equiv="refresh".*content="\d;\s*url=([^"]+)#i) {
|
|
print "META Redirect not detected in response. Answer: " . $mech->status() . "; " . $mech -> response() -> decoded_content . "\n";
|
|
exit 2;
|
|
}
|
|
|
|
$url = $1 =~ m#^http#i ? $1 : $mech->uri->as_string . $1;
|
|
|
|
$mech -> get ($url);
|
|
|
|
unless ($mech -> success()) {
|
|
print "Failed to fetch \"${url}\". Answer: " . $mech->status() . "\n";
|
|
exit 2;
|
|
}
|
|
|
|
my $cont = $mech->response()->decoded_content;
|
|
my $nwebspace = 0;
|
|
|
|
while ($cont =~ m#WebSpace#mg) { $nwebspace++; }
|
|
|
|
if ($nwebspace < 4) {
|
|
print "ERROR: I couldn't find at least 4 occurences of \"WebSpace\" on the resulting page. Check it for yourself:\n";
|
|
print $cont, "\n";
|
|
exit (1);
|
|
}
|
|
|
|
print "Successfully tested \"${url}\", and found $nwebspace occurrences of the word \"WebSpace\" on the resulting page\n";
|
|
|
|
exit 0;
|
|
|
|
sub usage {
|
|
print "Usage: $progname <url>\n";
|
|
exit 2;
|
|
}
|