view release on metacpan or  search on metacpan

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

		'service' => $service,
		'username' => $h->{'username'},
		'password' => $h->{'password'},
	);

	# find any additional required login params (i.e. lt, execution, and _eventId)
	if(@{$h->{'config'}->{'param_heuristics'}}) {
		# retrieve the login form that will be parsed by configured param_heuristics
		my $formUri = $loginUri->clone();
		$formUri->query_param('service', $service);
		my $response = $ua->simple_request(HTTP::Request::Common::GET($formUri));

		# process all configured param heuristics
		foreach (@{$h->{'config'}->{'param_heuristics'}}) {
			# skip invalid heuristics
			next if(ref($_) ne 'CODE');

			# process this heuristic
			@params = $_->($service, $response, $ua, $h, @params);
		}
	}

	# issue the login request
	my $response = $ua->simple_request(HTTP::Request::Common::POST($loginUri, \@params));

	#short-circuit if there is no response from CAS for some reason
	return if(!$response);

	#process all the ticket heuristics until a ticket is found
	foreach (@{$h->{'config'}->{'ticket_heuristics'}}) {
		#skip invalid heuristics
		next if(ref($_) ne 'CODE');

		#process the current heuristic
		my $ticket = eval {$_->($response, $service)};

		#quit processing if a ticket is found
		return $ticket if(defined $ticket);
	}

	#return undefined if no ticket was found
	return;
};

# Login callback when the specified server is in proxy mode
my $proxyLoginCallback = sub {
	my ($service, $ua, $h) = @_;

	#clear any previous error
	delete $h->{'error'};

	#create the request uri
	my $ptUri = URI->new_abs('proxy', $h->{'casServer'});
	$ptUri->query_form(
		'pgt'           => $h->{'pgt'},
		'targetService' => $service,
	);

	# fetch proxy ticket and parse response xml
	my $response = $ua->simple_request(HTTP::Request::Common::GET($ptUri));
	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 . ' ' .