view release on metacpan or  search on metacpan

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

package Authen::CAS::UserAgent;

=head1 NAME

Authen::CAS::UserAgent - CAS-aware LWP::UserAgent

=head1 SYNOPSIS

 use Authen::CAS::UserAgent;

 my $ua = Authen::CAS::UserAgent->new(
   'cas_opts' => {
     'server' => 'https://cas.example.com/cas/',
     'username' => 'user',
     'password' => 'password',
     'restful'  => 1,
   },
 );
 $ua->get('https://www.example.com/casProtectedResource');

=head1 DESCRIPTION

This module attempts to add transparent CAS authentication support to
LWP::UserAgent. It currently supports using proxy granting tickets, the RESTful
API, screen scraping the login screen, or a custom login callback when CAS
authentication is required.

=cut

use strict;
use utf8;
use base qw{LWP::UserAgent Exporter};

our $VERSION = '0.91';

use constant CASHANDLERNAME => __PACKAGE__ . '.Handler';
use constant XMLNS_CAS => 'http://www.yale.edu/tp/cas';

use constant ERROR_PROXY_INVALIDRESPONSE => 1;
use constant ERROR_PROXY_INVALIDTICKET   => 2;
use constant ERROR_PROXY_UNKNOWN         => 3;

our @EXPORT_OK = qw{
	ERROR_PROXY_INVALIDRESPONSE
	ERROR_PROXY_INVALIDTICKET
	ERROR_PROXY_UNKNOWN
};
our %EXPORT_TAGS = (
	ERRORS => [qw{
		ERROR_PROXY_INVALIDRESPONSE
		ERROR_PROXY_INVALIDTICKET
		ERROR_PROXY_UNKNOWN
	}],
);

use HTTP::Request;
use HTTP::Request::Common ();
use HTTP::Status ();
use URI;
use URI::Escape qw{uri_escape};
use URI::QueryParam;
use XML::LibXML;
use XML::LibXML::XPathContext;

##LWP handlers

#cas login handler, detects a redirect to the cas login page, logs the user in and updates the initial redirect
my $casLoginHandler = sub {
	my ($response, $ua, $h) = @_;

	#prevent potential recursion caused by attempting to log the user in
	return if($h->{'running'} > 0);

	#check to see if this is a redirection to the login page
	my $uri = URI->new_abs($response->header('Location'), $response->request->uri)->canonical;
	my $loginUri = URI->new_abs('login', $h->{'casServer'})->canonical;
	if(
		$uri->scheme eq $loginUri->scheme &&
		$uri->authority eq $loginUri->authority &&
		$uri->path eq $loginUri->path
	) {
		#short-circuit if a service isn't specified
		my $service = URI->new(scalar $uri->query_param('service'));