Apache-AuthCAS

 view release on metacpan or  search on metacpan

lib/Apache/AuthCAS.pm  view on Meta::CPAN

		$r->rflush;
		return (MP2 ? Apache::HTTP_OK : Apache::Constants::HTTP_OK);
	}
}

# params
#     apache request object
#     ticket to be validated
#     1 or 0, whether we need proxy tickets
# returns a hash with keys on success
# 	  'user', 'pgtiou'
# NULL on failure
sub validate_service_ticket($$) {
	my $self = shift;
	my $r = shift;
	my $ticket = shift;
	my $proxy = shift;

	Apache->warn("$$: CAS: validate_service_ticket(): validating service ticket '$ticket' through CAS") unless ($LOG_LEVEL < $LOG_DEBUG);
	my %properties;

	my $service;
	if ($SERVICE eq "") {
		# use the current URL as the service
		$service = $self->this_url_encoded($r);
	} else {
		# use the static entry point into this service
		$service = $self->urlEncode($SERVICE);
	}

	Apache->warn("$$: CAS: validate_service_ticket(): requesting validation for service: '$service'") unless ($LOG_LEVEL < $LOG_DEBUG);
	my $tmp;
	# FIXME - diff urls for proxy vs. none?
	if ($proxy) {
		$tmp = $CAS_PROXY_VALIDATE_URI . "?service=$service&ticket=$ticket&pgtUrl=$service";
	} else {
		$tmp = $CAS_SERVICE_VALIDATE_URI . "?service=$service&ticket=$ticket";
	}

	Apache->warn("$$: CAS: validate_service_ticket(): request URL: '$tmp'") unless ($LOG_LEVEL < $LOG_DEBUG);

	if ($LOG_LEVEL >= $LOG_INSANE) {
		$Net::SSLeay::trace = 3;  # 0=no debugging, 1=ciphers, 2=trace, 3=dump data
	} else {
		$Net::SSLeay::trace = 0;  # 0=no debugging, 1=ciphers, 2=trace, 3=dump data
	}
	#$Net::SSLeay::linux_debug = 1;

	my ($page, $response, %reply_headers) = Net::SSLeay::get_https($CAS_HOST, $CAS_PORT, $tmp);

	# if we had some type of connection problem
	if (!defined($page)) {
		Apache->warn("$$: CAS: validate_service_ticket(): error validating service");
		$properties{'error'} = $CAS_CONNECT_ERROR_CODE;
		return %properties;
	}

	Apache->warn("$$: CAS: validate_service_ticket(): page: $page") unless ($LOG_LEVEL < $LOG_INSANE);
	Apache->warn("$$: CAS: validate_service_ticket(): response: $response") unless ($LOG_LEVEL < $LOG_INSANE);

	# FIXME - add a check for a 404 error/other errors
	if ($page =~ /<cas:user>([^<]+)<\/cas:user>/) {
		my $user = $1;
		chomp $user;
		Apache->warn("$$: CAS: validate_service_ticket(): valid service ticket, user '$user' authenticated") unless ($LOG_LEVEL < $LOG_DEBUG);
		$properties{'user'} = $user;
	
		# only try to get PGTIOU if we are doing proxy stuff
		if ($proxy) {
			if ($page =~ /<cas:proxyGrantingTicket>([^<]+)<\/cas:proxyGrantingTicket>/) {
				Apache->warn("$$: CAS: validate_service_ticket(): got pgt='$1' for user='$user'") unless ($LOG_LEVEL < $LOG_DEBUG);
				if ($1 ne "") {
					$properties{'pgtiou'} = $1;
				} else {
					Apache->warn("$$: CAS: validate_service_ticket(): empty PGT in response from CAS") unless ($LOG_LEVEL < $LOG_ERROR);
				}
			} else {
				Apache->warn("$$: CAS: validate_service_ticket(): no PGT in response from CAS") unless ($LOG_LEVEL < $LOG_ERROR);
				$properties{'error'} = $PGT_ERROR_CODE;
				return %properties;
			}
		}
	} else {
		Apache->warn("$$: CAS: validate_service_ticket(): invalid service ticket, user denied access") unless ($LOG_LEVEL < $LOG_DEBUG);
		$properties{'error'} = $INVALID_ST_ERROR_CODE;
		return %properties;
	}

	return %properties;
}

sub send_proxysuccess($$) {
	my $self = shift;
	my $r = shift;

	Apache->warn("$$: CAS: send_proxysuccess(): sending proxy success for CAS callback") unless ($LOG_LEVEL < $LOG_DEBUG);

	$r->content_type("text/html");
	$r->print("<casClient:proxySuccess xmlns:casClient=\"http://www.yale.edu/tp/casClient\"/>\n");
	$r->rflush();
	return (MP2 ? Apache::OK : Apache::Constants::OK);
}

sub get_proxy_tickets($$) {
	my $self = shift;
	my $pgt = shift;
	my $target = shift;
	my $num_tickets = shift;

	Apache->warn("$$: CAS: get_proxy_tickets()") unless ($LOG_LEVEL < $LOG_DEBUG);

	my @tickets;
	
	for (my $i=0; $i < $num_tickets; $i++) {
		my $uri = "$CAS_PROXY_URI?pgt=$pgt&targetService=$target";
		Apache->warn("$$: CAS: get_proxy_tickets(): using PGT to obtain PT: calling URL '$uri'") unless ($LOG_LEVEL < $LOG_DEBUG);

		if ($LOG_LEVEL >= $LOG_INSANE) {
			$Net::SSLeay::trace = 3;  # 0=no debugging, 1=ciphers, 2=trace, 3=dump data
		} else {
			$Net::SSLeay::trace = 0;  # 0=no debugging, 1=ciphers, 2=trace, 3=dump data



( run in 1.814 second using v1.01-cache-2.11-cpan-39bf76dae61 )