view release on metacpan or  search on metacpan

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

	my $doc = eval {XML::LibXML->new()->parse_string($response->decoded_content('charset' => 'none'))};
	if($@ || !$doc) {
		$h->{'error'} = ERROR_PROXY_INVALIDRESPONSE;
		push @{$h->{'errors'}}, $h->{'error'};
		return;
	}

	# process the response to extract the proxy ticket or any errors
	my $xpc = XML::LibXML::XPathContext->new();
	$xpc->registerNs('cas', XMLNS_CAS);
	if($xpc->exists('/cas:serviceResponse/cas:proxyFailure', $doc)) {
		my $code = $xpc->findvalue('/cas:serviceResponse/cas:proxyFailure[position()=1]/@code', $doc);
		if($code eq 'INVALID_TICKET') {
			$h->{'error'} = ERROR_PROXY_INVALIDTICKET;
			push @{$h->{'errors'}}, $h->{'error'};
		}
		else {
			$h->{'error'} = ERROR_PROXY_UNKNOWN;
			push @{$h->{'errors'}}, $h->{'error'};
		}
	}
	elsif($xpc->exists('/cas:serviceResponse/cas:proxySuccess', $doc)) {
		return $xpc->findvalue('/cas:serviceResponse/cas:proxySuccess[position()=1]/cas:proxyTicket[position()=1]', $doc);
	}
	else {
		$h->{'error'} = ERROR_PROXY_INVALIDRESPONSE;
		push @{$h->{'errors'}}, $h->{'error'};
	}

	# default to no ticket being returned
	return;
};

#Login callback for CAS servers that implement the RESTful API
#TODO: cache the TGT
my $restLoginCallback = sub {
	my ($service, $ua, $h) = @_;

	#retrieve the tgt
	my $loginUri = URI->new_abs('v1/tickets', $h->{'casServer'});
	my $tgtResponse = $ua->simple_request(HTTP::Request::Common::POST($loginUri, [
		'username' => $h->{'username'},
		'password' => $h->{'password'},
	]));
	return if($tgtResponse->code != 201);
	my $tgtUri = $tgtResponse->header('Location');

	#retrieve a ticket for the requested service
	my $ticketResponse = $ua->simple_request(HTTP::Request::Common::POST($tgtUri, [
		'service' => $service,
	]));
	return if($ticketResponse->code != 200);
	return $ticketResponse->decoded_content;
};

##Static Methods

#return the default user agent for this class
sub _agent($) {
	return
		$_[0]->SUPER::_agent . ' ' .
		'CAS-UserAgent/' . $VERSION;
}

#Constructor
sub new($%) {
	my $self = shift;
	my (%opt) = @_;

	# remove any cas options before creating base object
	my $cas_opts = delete $opt{'cas_opts'};

	#setup the base object
	$self = $self->SUPER::new(%opt);

	#attach a cas login handler if options were specified
	$self->attach_cas_handler(%$cas_opts) if(ref($cas_opts) eq 'HASH');

	#return this object
	return $self;
}

=head1 METHODS

The following methods are available:

=over 4

=item $ua->attach_cas_handler( %options )

This method attaches a CAS handler to the current C<Authen::CAS::UserAgent>
object.

The following options are supported:

=over

=item C<server> => $url

This option defines the base CAS URL to use for this handler. The base url is
used to detect redirects to CAS for authentication and to issue any requests to
CAS when authenticating.

This option is required.

=item C<username> => $string

This option defines the username to use for authenticating with the CAS server.

This option is required unless using proxy mode.

=item C<password> => $string

This option defines the password to use for authenticating with the CAS server.

This option is required unless using proxy mode.

=item C<restful> => $bool

When this option is TRUE, C<Authen::CAS::UserAgent> will use the RESTful API to
authenticate with the CAS server.

This option defaults to FALSE.

=item C<proxy> => $bool

When this option is TRUE, C<Authen::CAS::UserAgent> using a proxy granting
ticket to authenticate with the CAS server.

This option defaults to FALSE.

=item C<pgt> => $string

This option specifies the proxy granting ticket to use when proxy mode is active.