Apache-AuthCAS

 view release on metacpan or  search on metacpan

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

	# default to not initialized
	$INITIALIZED = 0;
}
if (!defined($SESSION_CLEANUP_COUNTER)) {
	# default to 0
	$SESSION_CLEANUP_COUNTER = 0;
}

my $tmp;

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

	# get all of our settings from the server config

	# logging
	if ($tmp = $r->dir_config("CASLogLevel")) {
		$LOG_LEVEL = $tmp;
	} else {
		# default

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

	} else {
		# default
		$REMOVE_TICKET = $DEFAULT_REMOVE_TICKET;
	}

	# specify that we have been successfully initialized
	$INITIALIZED = 1;
}

# used for underlying services that need proxy tickets (PTs)
sub authenticate($$) {
	my $self = shift;
	my $r = shift;
	my $tmp;

	# Only authenticate the first internal request
	return (MP2 ? Apache::OK : Apache::Constants::OK) unless $r->is_initial_req;

	# get our configuration, unless we already have and we are running static
	unless ($STATIC_INITIALIZATION and $INITIALIZED) {
		$self->initialize($r);

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


			Apache->warn("$$: CAS: authenticate(): not trying to remove service ticket from URI") unless ($LOG_LEVEL < $LOG_DEBUG);
			return (MP2 ? Apache::OK : Apache::Constants::OK);
		}
	}

	# failed if we got this far, but shouldn't
	return (MP2 ? Apache::FORBIDDEN : Apache::Constants::FORBIDDEN);
}

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

	$SESSION_CLEANUP_COUNTER++;
	Apache->warn("$$: CAS: cleanup(): counter=$SESSION_CLEANUP_COUNTER") unless ($LOG_LEVEL < $LOG_DEBUG);

	# perform session cleanup
	if ($SESSION_CLEANUP_COUNTER == 1) {
		Apache->warn("$$: CAS: initialize(): performing session cleanup");
		$self->delete_expired_sessions();

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

		$self->delete_expired_pgts();
	} 

	# reset counter if we have reached our threshold
	if ($SESSION_CLEANUP_COUNTER >= $SESSION_CLEANUP_THRESHOLD) {
		# reset counter
		$SESSION_CLEANUP_COUNTER = 0;
	}
}

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

	Apache->warn("$$: CAS: redirect_without_ticket(): redirecting to remove service ticket from service string") unless ($LOG_LEVEL < $LOG_INFO);

	# this_url() strips the service ticket
	my $url = $self->this_url($r);
	$r->header_out("Location" => $url);
	return (MP2 ? Apache::HTTP_MOVED_TEMPORARILY : Apache::Constants::HTTP_MOVED_TEMPORARILY);
}

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

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

	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: redirect_login(): redirecting to CAS for service: '$service'") unless ($LOG_LEVEL < $LOG_INFO);
	my $redirect_url = "https://$CAS_HOST:$CAS_PORT$CAS_LOGIN_URI?service=$service";
	$r->header_out("Location" => $redirect_url);
	return (MP2 ? Apache::HTTP_MOVED_TEMPORARILY : Apache::Constants::HTTP_MOVED_TEMPORARILY);
}

sub redirect($$) {
	my $self = shift;
	my $r = shift;
	my $url = shift || "";
	my $errcode = shift || "";

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

	if ($url) {
		my $service;
		if ($SERVICE eq "") {

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

	}
}

# 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 "") {

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

		}
	} 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++) {

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

	}

	if (@tickets) {
		return @tickets;
	} else {
		return qw();
	}
}

# place data in the session
sub set_session_data($$) {
	my $self = shift;
	my $sid = shift;
	my $last_accessed = shift;
	my $uid = shift;
	my $pgtiou = shift || "";

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

	my $dbh = DBI->connect("dbi:$DB_DRIVER:dbname=$DB_NAME;host=$DB_HOST;port=$DB_PORT", $DB_USER, $DB_PASS, { AutoCommit => 1 });
	if (!defined($dbh)) {

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

		}
	}

	$sth->finish();
	$dbh->disconnect();

	return 1;
}

# takes a session id and returns an array
sub get_session_data($$) {
	my $self = shift;
	my $sid = shift;

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

	# retrieve a session object for this session id
	my $dbh = DBI->connect("dbi:$DB_DRIVER:dbname=$DB_NAME;host=$DB_HOST;port=$DB_PORT", $DB_USER, $DB_PASS, { AutoCommit => 1 });
	if (!defined($dbh)) {
		Apache->warn("$$: CAS: get_session_data(): db connect error: $DBI::errstr") unless ($LOG_LEVEL < $LOG_ERROR);
		return ();

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


	if ($result) {
		Apache->warn("$$: CAS: get_session_data(): got session data for sid='$sid': last_accessed='$last_accessed' uid='$uid' pgtiou='$pgtiou'") unless ($LOG_LEVEL < $LOG_DEBUG);
		return ($sid, $last_accessed, $uid, $pgtiou);
	}
	Apache->warn("$$: CAS: get_session_data(): couldn't get session data for sid='$sid'") unless ($LOG_LEVEL < $LOG_DEBUG);
	return ();
}

# delete session
sub delete_session_data($$) {
	my $self = shift;
	my $sid = shift;

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

	# retrieve a session object for this session id
	my $dbh = DBI->connect("dbi:$DB_DRIVER:dbname=$DB_NAME;host=$DB_HOST;port=$DB_PORT", $DB_USER, $DB_PASS, { AutoCommit => 1 });
	if (!defined($dbh)) {
		Apache->warn("$$: CAS: delete_session_data(): db connect error: $DBI::errstr") unless ($LOG_LEVEL < $LOG_ERROR);
		return "";

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

	}
	Apache->warn("$$: CAS: delete_session_data(): deleted '$count' session mappings for sid='$sid'") unless ($LOG_LEVEL < $LOG_DEBUG);

	$sth->finish();
	$dbh->disconnect();

	return 1;
}

# delete expired sessions
sub delete_expired_sessions($$) {
	my $self = shift;

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

	my $oldest_valid_time = time() - $SESSION_TIMEOUT;
	Apache->warn("$$: CAS: delete_expired_sessions(): deleting sessions older than '$oldest_valid_time'") unless ($LOG_LEVEL < $LOG_DEBUG);

	# retrieve a session object for this session id
	my $dbh = DBI->connect("dbi:$DB_DRIVER:dbname=$DB_NAME;host=$DB_HOST;port=$DB_PORT", $DB_USER, $DB_PASS, { AutoCommit => 1 });
	if (!defined($dbh)) {

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

	}
	Apache->warn("$$: CAS: delete_expired_sessions(): deleted '$count' session mappings") unless ($LOG_LEVEL < $LOG_DEBUG);

	$sth->finish();
	$dbh->disconnect();

	return 1;
}

# place the pgt mapping in the database
sub set_pgt($$) {
	my $self = shift;
	my $pgtiou = shift;
	my $pgt = shift;

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

	my $dbh = DBI->connect("dbi:$DB_DRIVER:dbname=$DB_NAME;host=$DB_HOST;port=$DB_PORT", $DB_USER, $DB_PASS, { AutoCommit => 1 });
	if (!defined($dbh)) {
		Apache->warn("$$: CAS: set_pgt(): db connect error: $DBI::errstr") unless ($LOG_LEVEL < $LOG_ERROR);
		return "";

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

	
	Apache->warn("$$: CAS: set_pgt(): updated '$count' pgtiou/pgt map") unless ($LOG_LEVEL < $LOG_DEBUG);

	$sth->finish();
	$dbh->disconnect();

	return 1;
}

# takes a pgtiou and returns a pgt
sub get_pgt($$) {
	my $self = shift;
	my $pgtiou = shift;
	my $sid = shift || "";

	Apache->warn("$$: CAS: get_pgt(): getting pgtiou/pgt map for pgtiou='$pgtiou'") unless ($LOG_LEVEL < $LOG_DEBUG);

	# retrieve a pgt for this pgtiou
	my $dbh = DBI->connect("dbi:$DB_DRIVER:dbname=$DB_NAME;host=$DB_HOST;port=$DB_PORT", $DB_USER, $DB_PASS, { AutoCommit => 1 });
	if (!defined($dbh)) {
		Apache->warn("$$: CAS: get_pgt(): db connect error: $DBI::errstr") unless ($LOG_LEVEL < $LOG_ERROR);

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


	if ($result) {
		Apache->warn("$$: CAS: get_pgt(): got pgtiou/pgt map pgtiou='$pgtiou' pgt='$pgt'") unless ($LOG_LEVEL < $LOG_DEBUG);
		return $pgt;
	}
	Apache->warn("$$: CAS: get_pgt(): coudln't get pgtiou/pgt map pgtiou='$pgtiou'") unless ($LOG_LEVEL < $LOG_DEBUG);
	return "";
}

# deletes a pgt/pgtiou mapping
sub delete_pgt($$) {
	my $self = shift;
	my $pgtiou = shift;

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

	# retrieve a session object for this session id
	my $dbh = DBI->connect("dbi:$DB_DRIVER:dbname=$DB_NAME;host=$DB_HOST;port=$DB_PORT", $DB_USER, $DB_PASS, { AutoCommit => 1 });
	if (!defined($dbh)) {
		Apache->warn("$$: CAS: delete_pgt(): db connect error: $DBI::errstr") unless ($LOG_LEVEL < $LOG_ERROR);
		return "";

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

	}
	Apache->warn("$$: CAS: delete_pgt(): deleted '$count' pgtiou/pgt mappings for pgtiou='$pgtiou'") unless ($LOG_LEVEL < $LOG_DEBUG);

	$sth->finish();
	$dbh->disconnect();

	return 1;
}

# delete pgts that have no session associated with 'em and are old
sub delete_expired_pgts($$) {
	my $self = shift;

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

	# retrieve a session object for this session id
	my $dbh = DBI->connect("dbi:$DB_DRIVER:dbname=$DB_NAME;host=$DB_HOST;port=$DB_PORT", $DB_USER, $DB_PASS, { AutoCommit => 1 });
	if (!defined($dbh)) {
		Apache->warn("$$: CAS: delete_expired_pgts(): db connect error: $DBI::errstr") unless ($LOG_LEVEL < $LOG_ERROR);
		return "";
	}

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

		return "";
	}
	Apache->warn("$$: CAS: delete_expired_pgts(): deleted '$count' pgtiou/pgt mappings") unless ($LOG_LEVEL < $LOG_DEBUG);

	$sth->finish();
	$dbh->disconnect();

	return 1;
}

sub do_proxy($$) {
	my $self = shift;
	my $r = shift;
	my $sid = shift;
	my $pgtiou = shift;
	my $user = shift;
	my $ticket_redirect = shift; # enable ticket removal redirect?
	
	my $pgt;

	Apache->warn("$$: CAS: do_proxy(): looking up PGTIOU='$pgtiou' in cache") unless ($LOG_LEVEL < $LOG_DEBUG);

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

		# deleting this session for this user
		Apache->warn("$$: CAS: do_proxy(): deleting session data for sid='$sid'") unless ($LOG_LEVEL < $LOG_DEBUG);
		$self->delete_session_data($sid);

		Apache->warn("$$: CAS: do_proxy(): redirecting to CAS error page") unless ($LOG_LEVEL < $LOG_DEBUG);
		return $self->redirect($r, $ERROR_URL, $INVALID_PGT_ERROR_CODE);
	}
}

# generate a new session id
sub create_session_id() {
	my $sid = "";
	srand();
	for (my $i=0; $i < 32; $i++) {
		$sid .= ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64];
	}

	return $sid;
}

sub urlEncode {



( run in 0.573 second using v1.01-cache-2.11-cpan-65fba6d93b7 )