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 {