view release on metacpan or  search on metacpan

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

		request_prepare => \&_process_ticket_granting_cookie,
		m_host          => $cas_host,
		m_method        => 'GET',
		m_path_match    => qr{\A \Q$cas_path\E}msx,
		object_instance => $owner,
		owner           => $self->_handler_owner_name,
	);
	$user_agent->add_handler(
		response_redirect => \&_process_login_page,
		m_host            => $cas_host,
		m_media_type      => 'html',
		m_path_match      => qr{\A \Q$cas_path\E}msx,
		object_instance   => $owner,
		owner             => $self->_handler_owner_name,
	);
	$user_agent->add_handler(
		response_done   => \&_determine_complete_login,
		m_host          => $cas_host,
		m_path_match    => qr{\A \Q$cas_path\E}msx,
		object_instance => $owner,
		owner           => $self->_handler_owner_name,
	);

	return;
}

sub _cas_url_trigger {
	my ($self, $cas_url, $previous_cas_url) = @_;

	if (defined $previous_cas_url) {
		# Remove the handlers from the current user agent for the previous
		# CAS URL.
		$self->_remove_user_agent_handlers(
			cas_url => $previous_cas_url,
		);
	}

	# Now add the handlers back to the user agent for the new CAS URL.
	$self->_add_user_agent_handlers(
		cas_url => $cas_url,
	);

	return;
}

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

	if ($response->request->method ne 'POST' && !$response->is_redirect) {
		# Redriects are when the login process is completing
		return;
	}

	# Create a location to store the response data
	my %response_data;

	COOKIE:
	{
		# Manually extract the cookies into our own jar
		my $cookie_jar = HTTP::Cookies->new;

		$cookie_jar->extract_cookies($response);

		# Gather the ticket granting ticket
		$cookie_jar->scan(sub {
			my (undef, $key, $value, undef, $domain) = @_;

			if ($domain eq $self->cas_url->host && $key eq 'CASTGC') {
				# Set the ticket
				$response_data{ticket_granting_cookie} = $value;
			}
		});
	}

	# This is for the service redirect link as a URI object
	my $service_redirect;

	if (defined $response->header('Location')) {
		# Set the service redirect link from the Location header
		$service_redirect = URI->new($response->header('Location'));
	}
	else {
		# There was no Location header. This should not happen in the CAS
		# protocol outline. But there is a new addon created by Eric Pierce
		# http://www.ja-sig.org/wiki/display/CASUM/LDAP+Password+Policy+Enforcement
		# which is ment to enforce password expiration policies.
		# THIS SECTION LAST UPDATED 2010-01-11

		# Get the service redirect link from the page
		my $destination = _extract_service_redirect_link($response);

		if (defined $destination) {
			# Set the service redirect
			$response_data{destination} = $destination;
		}

		# Get the notification from the page
		my $notification = _extract_notification($response);

		if (defined $notification) {
			# Set the notification
			$response_data{notification} = $notification;
		}
	}

	# Process the service redirect link
	if (defined $service_redirect
	    && defined(my $ticket = $service_redirect->query_param('ticket'))) {
		# Store the destination
		$response_data{destination} = $service_redirect->clone;

		# Store the ticket
		$response_data{service_ticket} = $ticket;

		# Remove the ticket from the query
		$service_redirect->query_param_delete('ticket');

		# Store the service
		$response_data{service} = $service_redirect->clone;
	}