view release on metacpan or  search on metacpan

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

=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.

This option is required when using proxy mode.

=item C<strict> => $bool

When this option is TRUE, C<Authen::CAS::UserAgent> will only allow
authentication for the URL of the request requiring authentication.

This option defaults to FALSE.

=item C<callback> => $cb

This option can be used to specify a custom callback to use when authenticating
with CAS. The callback is called as follows: $cb->($service, $ua, $handler) and
is expected to return a $ticket for the specified service on successful
authentication.

=back

=back

=cut

#method that will attach the cas server login handler
#	server            => the base CAS server uri to add a login handler for
#	username          => the username to use to login to the specified CAS server
#	password          => the password to use to login to the specified CAS server
#	pgt               => the pgt for a proxy login handler
#	proxy             => a boolean indicating this handler is a proxy login handler
#	restful           => a boolean indicating if the CAS server supports the RESTful API
#	callback          => a login callback to use for logging into CAS, it should return a ticket for the specified service
#	ticket_heuristics => an array of heuristic callbacks that are performed when searching for the service and ticket in a CAS response
#	strict            => only allow CAS login when the service is the same as the original url
sub attach_cas_handler($%) {
	my $self = shift;
	my (%opt) = @_;

	#short-circuit if required options aren't specified
	return if(!exists $opt{'server'});
	return if(!$opt{'proxy'} && !(exists $opt{'username'} && exists $opt{'password'}));
	return if($opt{'proxy'} && !$opt{'pgt'});

	#sanitize options
	$opt{'server'} = URI->new($opt{'server'} . ($opt{'server'} =~ /\/$/o ? '' : '/'))->canonical;
	my $callback =
		ref($opt{'callback'}) eq 'CODE' ? $opt{'callback'}    :
		$opt{'proxy'}                   ? $proxyLoginCallback :
		$opt{'restful'}                 ? $restLoginCallback  :
		$defaultLoginCallback;

	# process any default config values for bundled callbacks/heuristics, we do this here
	# instead of in the callbacks to make default values available to custom
	# callbacks
	$opt{'ticket_heuristics'} = [$opt{'ticket_heuristics'}] if(ref($opt{'ticket_heuristics'}) ne 'ARRAY');
	push @{$opt{'ticket_heuristics'}}, $defaultTicketHeuristic;
	@{$opt{'ticket_heuristics'}} = grep {ref($_) eq 'CODE'} @{$opt{'ticket_heuristics'}};

	$opt{'param_heuristics'} = [$opt{'param_heuristics'}] if(ref($opt{'param_heuristics'}) ne 'ARRAY');
	push @{$opt{'param_heuristics'}}, $defaultLoginParamsHeuristic;
	@{$opt{'param_heuristics'}} = grep {ref($_) eq 'CODE'} @{$opt{'param_heuristics'}};

	#remove any pre-existing login handler for the current CAS server
	$self->remove_cas_handlers($opt{'server'});

	#attach a new CAS login handler
	$self->set_my_handler('response_done', $casLoginHandler,
		'owner' => CASHANDLERNAME,
		'casServer' => $opt{'server'},
		'strict'    => $opt{'strict'},
		'loginCb'   => $callback,
		'username'  => $opt{'username'},
		'password'  => $opt{'password'},
		'pgt'       => $opt{'pgt'},
		'config'    => \%opt,
		'errors'    => [],
		'running'   => 0,
		'm_code' => [
			HTTP::Status::HTTP_MOVED_PERMANENTLY,
			HTTP::Status::HTTP_FOUND,
			HTTP::Status::HTTP_SEE_OTHER,
			HTTP::Status::HTTP_TEMPORARY_REDIRECT,
		],
	);

	return 1;
}

sub get_cas_handlers($;$) {
	my $self = shift;
	my ($server) = @_;

	$server = URI->new($server . ($server =~ /\/$/o ? '' : '/'))->canonical if(defined $server);
	return $self->get_my_handler('response_done',
		'owner' => CASHANDLERNAME,
		(defined $server ? ('casServer' => $server) : ()),
	);
}

# method that will retrieve a ticket for the specified service
sub get_cas_ticket($$;$) {
	my $self = shift;
	my ($service, $server) = @_;

	# resolve which handler to use
	my $h;
	if(ref($server) eq 'HASH' && defined $server->{'casServer'}) {
		$h = $server;
	}
	else {
		my @handlers = $self->get_cas_handlers($server);
		die 'too many CAS servers found, try specifying a specific CAS server' if(@handlers > 1);
		$h = $handlers[0];
	}