<commit_before>package Authen::CAS::UserAgent;

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

our $VERSION = v2.12.0;

use constant CASHANDLERNAME => 'CasLoginHandler';

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

##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'));
		return if($service eq '');

		#short-circuit if in strict mode and the service is different than the original uri
		return if($h->{'strict'} && $response->request->uri ne $service);

		#get a ticket for the specified service
		my $ticket = $ua->getSt($service, $h);

		#short-circuit if a ticket wasn't found
		return if(!defined $ticket);

		#update the Location header
		$response->header('Location', $service . ($service =~ /\?/o ? '&' : '?') . 'ticket=' . uri_escape($ticket));

		#attach a local response_redirect handler that will issue the redirect if necessary
		push(@{$response->{'handlers'}->{'response_redirect'}},
			{
				%$h,
				'callback' => sub {
					my ($response, $ua, $h) = @_;

					#delete this response_redirect handler from the response object
					delete $response->{'handlers'}->{'response_redirect'};
					delete $response->{'handlers'} unless(%{$response->{'handlers'}});

					#determine the new uri
					my $newUri = URI->new_abs(scalar $response->header('Location'), $response->request->uri);

					#check to see if the target uri is the same as the original uri (ignoring the ticket)
					my $uri = $response->request->uri;
					my $targetUri = $newUri->clone;
					if($targetUri =~ s/[\&\?]ticket=[^\&\?]*$//sog) {
						if($uri eq $targetUri) {
							#clone the original request, update the request uri, and return the new request
							my $request = $response->request->clone;
							$request->uri($newUri);
							return $request
						}
					}

					return;
				},
			},
		);
	}

	return;
};

#default heuristic for detecting the service and ticket in the login response
my $defaultHeuristic = sub {
	my ($response, $service) = @_;

	#attempt using the Location header on a redirect response
	if($response->is_redirect) {
		my $uri = $response->header('Location');
		if($uri =~ /[\?\&]ticket=([^&]*)$/o) {
			return $1;
		}
	}

	#check for a javascript window.location.href redirect
	if($response->decoded_content =~ /window\.location\.href=\"[^\"]*ticket=([^&\"]*?)\"/sog) {
		return $1;
	}

	return;
};

#default callback to log the user into CAS and return a ticket for the specified service
my $defaultLoginCallback = sub {
	my ($service, $ua, $h) = @_;

	#issue the login request
	my $loginUri = URI->new_abs('login', $h->{'casServer'});
	my $response = $ua->simple_request(HTTP::Request::Common::POST($loginUri, [
		'service' => $service,
		'username' => $h->{'username'},
		'password' => $h->{'password'},
	]));

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

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

		#process the current heuristic
		$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) = @_;

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

	#fetch proxy ticket and return it if successful
	my $response = $ua->simple_request(HTTP::Request::Common::GET($ptUri));
	if($response->content =~ /<cas:proxyTicket>(.*?)<\/cas:proxyTicket>/o) {
		return $1;
	}

	return;
};

#Login callback for CAS servers that implement the RESTful API
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;
};<commit_msg>capture any errors encountered when fetching a proxy ticket<commit_after>package Authen::CAS::UserAgent;

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

our $VERSION = v2.12.0;

use constant CASHANDLERNAME => 'CasLoginHandler';
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'));
		return if($service eq '');

		#short-circuit if in strict mode and the service is different than the original uri
		return if($h->{'strict'} && $response->request->uri ne $service);

		#get a ticket for the specified service
		my $ticket = $ua->getSt($service, $h);

		#short-circuit if a ticket wasn't found
		return if(!defined $ticket);

		#update the Location header
		$response->header('Location', $service . ($service =~ /\?/o ? '&' : '?') . 'ticket=' . uri_escape($ticket));

		#attach a local response_redirect handler that will issue the redirect if necessary
		push(@{$response->{'handlers'}->{'response_redirect'}},
			{
				%$h,
				'callback' => sub {
					my ($response, $ua, $h) = @_;

					#delete this response_redirect handler from the response object
					delete $response->{'handlers'}->{'response_redirect'};
					delete $response->{'handlers'} unless(%{$response->{'handlers'}});

					#determine the new uri
					my $newUri = URI->new_abs(scalar $response->header('Location'), $response->request->uri);

					#check to see if the target uri is the same as the original uri (ignoring the ticket)
					my $uri = $response->request->uri;
					my $targetUri = $newUri->clone;
					if($targetUri =~ s/[\&\?]ticket=[^\&\?]*$//sog) {
						if($uri eq $targetUri) {
							#clone the original request, update the request uri, and return the new request
							my $request = $response->request->clone;
							$request->uri($newUri);
							return $request
						}
					}

					return;
				},
			},
		);
	}

	return;
};

#default heuristic for detecting the service and ticket in the login response
my $defaultHeuristic = sub {
	my ($response, $service) = @_;

	#attempt using the Location header on a redirect response
	if($response->is_redirect) {
		my $uri = $response->header('Location');
		if($uri =~ /[\?\&]ticket=([^&]*)$/o) {
			return $1;
		}
	}

	#check for a javascript window.location.href redirect
	if($response->decoded_content =~ /window\.location\.href=\"[^\"]*ticket=([^&\"]*?)\"/sog) {
		return $1;
	}

	return;
};

#default callback to log the user into CAS and return a ticket for the specified service
my $defaultLoginCallback = sub {
	my ($service, $ua, $h) = @_;

	#issue the login request
	my $loginUri = URI->new_abs('login', $h->{'casServer'});
	my $response = $ua->simple_request(HTTP::Request::Common::POST($loginUri, [
		'service' => $service,
		'username' => $h->{'username'},
		'password' => $h->{'password'},
	]));

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

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

		#process the current heuristic
		$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
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' => $<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;
};
{'fraction_non_alphanumeric': 0.1742613920881322, 'fraction_numerical': 0.003087965281255216, 'mean_word_length': 4.323411816970236, 'pattern_counts': {'":': 0, '<': 6, '<?xml version=': 0, '>': 182, 'https://': 0, 'lorem ipsum': 0, 'www.': 1, 'xml': 1}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2855602', 'n_tokens_mistral': 4374, 'n_tokens_neox': 3932, 'n_words': 1111}