#!/usr/bin/perl -w # # Test CAS (fed's) # # By Igor Gubenko (igubenko@Princeton.EDU), 09/25/2013 # 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 == 3; my $mech = WWW::Mechanize->new (agent => 'Mozilla/5.0 (X11; Linux x86_64; rv:24.0) Gecko/20100101 Firefox/24.0', stack_depth => '1', noproxy => '1', quiet => '1', onerror => undef, onwarn => undef, timeout => '20') or die ("Unable to instantiate WWW::Mechanize!\n"); #$mech->proxy (['http', 'https'], 'http://malka.princeton.edu:8888'); #$mech -> add_handler("request_send", sub { shift->dump; return }); #$mech -> add_handler("response_done", sub { shift->dump; return }); my ($URL, $user, $pass) = @ARGV; $mech->get ($URL); unless ($mech -> success() && $mech->title() =~ m#Princeton University Authentication Service#) { print "Failed to fetch \"$URL\". Current URL: " . $mech->uri->as_string . ". Answer: " . $mech->status() . ";\n"; exit 2; } #my @tmp = $mech->find_all_inputs; #foreach (@tmp) { print $_->type, "###", $_->name, "\n"; } #exit 1; # Login $mech->submit_form ( with_fields => { username => $user, password => $pass, }, image => '', ); unless ($mech -> success() && $mech->title() =~ m#Princeton University Authentication Service - Success#) { print "Failed to login to CAS. Current URL: ". $mech->uri->as_string . ". Answer: " . $mech->status() . "; \n"; exit 2; } $mech->follow_link (text => 'logout'); unless ($mech -> success() && $mech->response()->decoded_content =~ m#You have been logged out#) { print "Failed to sign out of CAS. Current URL: ". $mech->uri->as_string . ". Answer: " . $mech->status() . "; " . ((defined $mech->title() ? $mech->title() : "" )) . "\n"; exit 1; } #print "\n#########################\n\n\n", $mech -> response() -> decoded_content, "\n"; print "Successfully accessed CAS, logged in and logged out\n"; exit 0; sub usage { print "Usage: $progname \n"; exit 2; }