credentials results from the CPAN

Authen-CAS-External

package Authen::CAS::External::UserAgent;

use 5.008001;
use strict;
use utf8;
use warnings 'all';

# Module metadata
our $AUTHORITY = 'cpan:DOUGDUDE';
our $VERSION   = '0.08';

use Authen::CAS::External::Response 0.05;
use HTML::Form 5.817;
use HTML::TokeParser 3.00;
use HTTP::Status 5.817 qw(HTTP_BAD_REQUEST);
use LWP::UserAgent 5.819;
use Moose::Role 0.89;
use MooseX::Types::Moose qw(Bool Str);
use MooseX::Types::URI qw(Uri);
use Scalar::Util 1.14;
use URI 1.22;
use URI::QueryParam;

# Clean the imports are the end of scope
use namespace::clean 0.04 -except => [qw(meta)];

# Role requires

requires qw(
	get_cas_credentials
	get_cas_ticket_granting_cookie
);

# Attributes

has previous_response => (
	is  => 'rw',
	isa => 'Authen::CAS::External::Response',

	clearer       => 'clear_previous_response',
	documentation => q{The previous response from a request on the UserAgent},
	predicate     => 'has_previous_response',
);
has redirect_back => (
	is  => 'rw',
	isa => Bool,

	default       => 0,
	documentation => q{Weither or not for the UserAgent to make a request outside of the CAS site},
);
has user_agent => (
	is  => 'rw',
	isa => 'LWP::UserAgent',

	default       => sub {
		my $ua = LWP::UserAgent->new(cookie_jar => {});
		push @{$ua->requests_redirectable}, 'POST';
		return $ua;
	},
	documentation => q{The LWP::UserAgent to use to make requests},
	handles       => ['get'],
	trigger       => \&_user_agent_trigger,
);
has cas_url => (
	is  => 'rw',
	isa => Uri,

	documentation => q{The URL of the CAS site. This does not include /login},
	coerce        => 1,
	required      => 1,
	trigger       => \&_cas_url_trigger,
);

has _handler_owner_name => (
	is  => 'ro',
	isa => 'Num',

	default  => sub { Scalar::Util::refaddr(shift); },
	init_arg => undef,
);

# Methods

sub service_request_url {
	my ($self, %args) = @_;

	# Get the CAS URL to use
	my $cas_url = exists $args{cas_url} ? $args{cas_url}
	                                    : $self->cas_url;

lib/Authen/CAS/External/UserAgent.pm view on Meta::CPAN

		if (exists $token->[2]->{class}
		    && defined $token->[2]->{class}
		    && $token->[2]->{class} =~ m{\berrors?\b}imsx) {
			# This token has a class of "error" or "errors" and so should be
			# this notification.
			$notification = $parser->get_trimmed_text("/$tag");

			# End token parsing
			last TOKEN;
		}
	}

	# Return the notification
	return $notification;
}

sub _extract_service_redirect_link {
	my ($response) = @_;

	# For the service redirect to be populated into
	my $service_redirect;

	# Prase the document using HTML::TokeParser
	my $parser = HTML::TokeParser->new($response->content_ref);

	# Cycle through the tokens on the page
	TOKEN: while (my $token = $parser->get_token) {
		# Move to the next token if this is not a start tag
		next TOKEN
			if $token->[0] ne q{S};

		# Get the tag of this start tag
		my $tag = lc $token->[1];

		if ($tag eq q{a}) {
			# This is the start of an anchor tag. Anchor tags need to be
			# scanned for the service redirect.
			if (exists $token->[2]->{href} && $token->[2]->{href} =~ m{ticket=ST-}msx) {
				# This is the service redirect link.

				# Set the service redirect link from this link
				$service_redirect = URI->new($token->[2]->{href});

				# End the parsing
				last TOKEN;
			}
		}
	}

	# Return the service redirect
	return $service_redirect;
}

sub _process_login_page {
	my ($response, $user_agent, $info) = @_;
	my $self = ${$info->{object_instance}};

	if ($response->request->method eq 'POST') {
		if (!$self->has_previous_response) {
			# A POST returning to the login page is a failure
			confess 'The login failed with the supplied credentials';
		}

		# The previous response can determine what occurred
		return;
	}

	# Parse the forms on the page
	my @forms = HTML::Form->parse($response->decoded_content, $response->base);

	# Find the login form
	my $login_form;
	FORM: foreach my $form (@forms) {
		if (defined $form->find_input('lt')
			&& defined $form->find_input('username')
			&& defined $form->find_input('password')) {
			# Set this as the login form
			$login_form = $form;

			# Do not continue to search the forms
			last FORM;
		}
	}

	if (!defined $login_form) {
		confess 'The login form could not be identified on the login page';
	}

	# The service this form is for
	my $service = $login_form->param('service');

	# Get the username and password
	my ($username, $password) = $self->get_cas_credentials($service);

	# Fill in the form
	$login_form->param(username => $username);
	$login_form->param(password => $password);

	# Get the request to make
	my $request = $login_form->make_request;

	return $request;
}

sub _process_ticket_granting_cookie {
	my ($request, $user_agent, $info) = @_;
	my $self = ${$info->{object_instance}};

	# Clear previous response
	$self->clear_previous_response;

	# Get the service
	my $service = $request->uri->query_param('service');

	if (defined $user_agent->cookie_jar) {
		# Clear all CAS cookies
		$user_agent->cookie_jar->clear($self->cas_url->host);

		# Get the CAS credentials
		my ($username, $password) = $self->get_cas_credentials($service);

		# Get the ticket granting ticket
		my $ticket_granting_cookie = $self->get_cas_ticket_granting_cookie(
			$username,
			$service
		);

		if (defined $ticket_granting_cookie) {
			# Set the cookie for the upcoming request
			$user_agent->cookie_jar->set_cookie(
				undef,
				'CASTGC',
				$ticket_granting_cookie,
				$self->cas_url->path,
				$self->cas_url->host,
				$self->cas_url->port,
				1,
				$self->cas_url->scheme eq 'https',
				undef,
				0
			);

			# Add cookies due to HTTP::Config handling
			$user_agent->cookie_jar->add_cookie_header($request);
		}
	}

	return;
}

sub _remove_user_agent_handlers {
	my ($self, %args) = @_;

	# Get the arguments
	my ($user_agent, $cas_url) = @args{qw(user_agent cas_url)};

	# Default arguments
	$cas_url    ||= $self->cas_url;
	$user_agent ||= $self->user_agent;

	# Remove the handlers in the user agent
	$user_agent->remove_handler(undef,
		m_host => $cas_url->host,
		owner  => $self->_handler_owner_name,
	);

	return;
}

sub _user_agent_trigger {
	my ($self, $user_agent, $previous_user_agent) = @_;

	if (defined $previous_user_agent) {
		# Remove the handlers from the previous user agent
		$self->_remove_user_agent_handlers(
			user_agent => $previous_user_agent,
		);
	}

	# Now add the handlers to the new user agent

lib/Authen/CAS/External/UserAgent.pm view on Meta::CPAN


sub BUILD {
	my ($self) = @_;

	# Hook the respose handler
	$self->_add_user_agent_handlers();

	return;
}

sub DEMOLISH {
	my ($self) = @_;

	# Remove the handlers from the user agent
	$self->_remove_user_agent_handlers;

	return;
}

sub FOREIGNBUILDARGS {
	my ($class, @args) = @_;

	# According to LWP::UserAgent, takes straight hash
	if (@args % 2 == 1) {
		confess 'Invalid arguments passed';
	}

	# The defaults for WWW::Mechanize
	my %args = (
		autocheck   => 0,
		noproxy     => 1,
		stack_depth => 1,
		@args,
	);

	# Return the args to the super class
	return %args;
}

1;

__END__

=head1 NAME

Authen::CAS::External::UserAgent - UserAgent role for CAS session managers.

=head1 VERSION

This documentation refers to version 0.08.

=head1 SYNOPSIS

  package MyCAS::Session;

  use Moose;

  # Use this role
  with 'Authen::CAS::External::UserAgent';

  sub get_cas_credentials {
    my ($self, $service) = @_;

    # Do something

    return $username, $password;
  }

  sub get_cas_ticket_granting_cookie {
    my ($self, $username, $service) = @_;

    # Do something

    return $TGC;
  }

  1;

=head1 DESCRIPTION

Provides a way to authenticate with a CAS server just as a browser
would. This is useful with web scrapers needing to login to a CAS
site.

=head1 ROLE REQUIRES

This is a L<Moose::Role|Moose::Role> and for this role to be used, the user
MUST provide the following two methods:

=head2 get_cas_credentials

This is called as a method with the first argument being a string that is the
URL of the service that is about to be logged in to. If no service is being
logged in to, then it will be undefined. This function is expected to return
a username string and a password string, both of which are optional, but MUST
be returned in that order.

=head2 get_cas_ticket_granting_cookie

This is called as a method with the first argument being a string that is the
username being used and the second argument being a string that is the URL of
the service that is about to be logged into. This function is expected to
return a string that is the ticket granting cookie for the CAS service, or
nothing.

=head1 ATTRIBUTES

=head2 cas_url

This is a L<URI|URI> object of the base URL of the CAS site. This is typically
the path before C</login>. A string may be supplied and will automatically
be converted to a L<URI|URI> object.

=head2 previous_response

This holds the response object
L<Authen::CAS::External::Response|Authen::CAS::External::Response> from the
last executed CAS navigation.

=head2 redirect_back

This is a Boolean that determines if the L</user_agent> will navigate
outside of the L</cas_url>. The default is C<0>.

=head2 user_agent

This is a L<LWP::UserAgent|LWP::UserAgent> that is used to navigate the CAS
site. The default is L<LWP::UserAgent|LWP::UserAgent> with an in-memory cookie
jar and allows the C<POST> method to be redirectable.

=head1 METHODS

=head2 clear_previous_response

This will clear the L</previous_response> attribute.

=head2 get

This is an alias to the C<get> method of the L</user_agent>.

=head2 has_previous_response

This will return if there is a value present in the L</previous_response>
attribute.

=head2 service_request_url

B<service_request_url(%args)>

This method will return a URI object that is the URL to request for the CAS

( run in 1.520 second using v1.01-cache-2.11-cpan-39bf76dae61 )