view release on metacpan or  search on metacpan

lib/Apache2/AuthCASpbh/Authn.pm  view on Meta::CPAN

package Apache2::AuthCASpbh::Authn;

use strict;
use warnings;

use APR::URI qw ();
use Apache2::Access qw();
use Apache2::AuthCASpbh qw(cfg_value open_session);
use Apache2::AuthCASpbh::Log qw ();
use Apache2::Const -compile => qw(OK DECLINED SERVER_ERROR
				  HTTP_MOVED_TEMPORARILY FORBIDDEN);
use Apache2::Log qw();
use Apache2::Module qw();
use Apache2::RequestRec qw();
use Apache2::RequestUtil qw();
use Apache2::ServerRec qw();
use Apache2::URI qw();
use Apache2::Util qw();
use CGI qw ();
use CGI::Cookie qw ();
use LWP::UserAgent qw ();
use Storable qw();
use XML::Simple qw();

our $VERSION = '0.30';

sub handler {
	my ($r) = shift;
	my $now = time();
	my $_log = new Apache2::AuthCASpbh::Log(__PACKAGE__, $r->log);
	my $dir_cfg = Apache2::Module::get_config('Apache2::AuthCASpbh',
						  $r->server, $r->per_dir_config);
	my $debug_level = cfg_value($dir_cfg, 'DebugLevel');
	$_log->l($debug_level, 'handler called for ' . $r->unparsed_uri);

	if (my $r_prev = ($r->prev || $r->main)) {
		if (defined $r_prev->user) {
			$_log->l($debug_level, "copying user $r_prev->user from previous request");
			$r->user($r_prev->user);
			return Apache2::Const::OK;
		}
	}

	if ($r->auth_type ne 'Apache2::AuthCASpbh') {
		$_log->l($debug_level, "$r->auth_type not our auth type, declining");
		return Apache2::Const::DECLINED;
	}
		
	$r->push_handlers(PerlCleanupHandler => \&cleanup);

	my $session_db = cfg_value($dir_cfg, 'SessionDBPath') . '/' .
				   cfg_value($dir_cfg, 'SessionDBName');
	$_log->l($debug_level, "using session db $session_db");

	my $cookie_name = cfg_value($dir_cfg, 'SessionCookieName');
	my %cookies = CGI::Cookie->fetch($r);

	if (exists($cookies{$cookie_name})) {
		$_log->l($debug_level, "found $cookie_name cookie " . $cookies{$cookie_name}->value());

		my $session = open_session($session_db, $cookies{$cookie_name}->value());

		if (ref($session)) {
			if (defined($session->{expiration}) && $session->{expiration} > $now) {
				$_log->l($debug_level, 'valid cookie for ' . $session->{user} .
					 ' expires ' . $session->{expiration});
				$r->user($session->{user});

				if (exists($session->{cas_attributes}) &&
				    keys %{$session->{cas_attributes}} > 0) {
					$_log->l($debug_level, 'session contains attributes');
					$r->pnotes(cas_attributes => Storable::dclone($session->{cas_attributes}));
				}

				if (exists($session->{cas_pgt})) {
					$_log->l($debug_level, 'session contains pgt ' .
						 $session->{cas_pgt});
					$r->pnotes(cas_pgt => $session->{cas_pgt});
				}

				if (exists($session->{cas_proxy})) {
					$_log->l($debug_level, 'session contains proxy chain ' .
						 join(',', @{$session->{cas_proxy}}));
					$r->pnotes(cas_proxy => $session->{cas_proxy});
				}

				$cookies{$cookie_name}->bake($r);

				$r->pnotes(cas_session => $session->{_session_id});
				untie(%{$session});

				return Apache2::Const::OK;
			}
			else {
				$_log->l($debug_level, 'cookie for ' . ($session->{user} // '<missing>') .
					 ' expired ' . ($session->{expiration} // '<missing>'));

				eval { tied(%{$session})->delete; };
				if ($@) {
		    			$_log->l('warn', "session delete failed - $@");
				}
			}
		}
		elsif ($session !~ /Object does not exist in the data store/) {
		    	$_log->l('error', "session tie failed - $session");
			return Apache2::Const::SERVER_ERROR;
		}
		else {
			$_log->l($debug_level, "session not found");
		}
	}
	else {
		$_log->l($debug_level, "$cookie_name cookie not found");
	}

	my $q = CGI->new($r, $r->args);

lib/Apache2/AuthCASpbh/Authn.pm  view on Meta::CPAN

						else {
					    		$_log->l('error', "session tie failed - $pgt_session");
						}
						return Apache2::Const::SERVER_ERROR;
					}

					if (exists($pgt_session->{pgtmap}{$pgt_iou})) {
						$pgt = $pgt_session->{pgtmap}{$pgt_iou}{pgt};
					    	$_log->l($debug_level, "found pgt $pgt");

						delete($pgt_session->{pgtmap}{$pgt_iou});
						$pgt_session->{update_count}++;
						untie(%{$pgt_session});

						$r->pnotes(cas_pgt => $pgt);
					}
					else {
				    		$_log->l('error', "pgt for $pgt_iou not found in session");
						return Apache2::Const::SERVER_ERROR;
					}
				}
				else {
			    		$_log->l($debug_level, 'no pgtiou found in response');
					return Apache2::Const::SERVER_ERROR;
				}
			}
		
			my $cas_attributes = {};
			if (exists($cas_success->{'cas:attributes'})) {

				foreach (keys %{$cas_success->{'cas:attributes'}}) {
					my $key = $_;
					$key =~ s/^cas://;

					$cas_attributes->{$key} =
						$cas_success->{'cas:attributes'}{$_};
				}

			   	$_log->l($debug_level, 'found attributes (' .
						       join(',', keys(%$cas_attributes)) . ')');
				$r->pnotes(cas_attributes => Storable::dclone($cas_attributes));
			}

			my $session = open_session($session_db, '');

			if (!ref($session)) {
				$_log->l('error', "session create failed - $session");
				return Apache2::Const::SERVER_ERROR;
			}

			$r->pnotes(cas_session => $session->{_session_id});
			
			$session->{user} = $user;
			$session->{expiration} = time() + cfg_value($dir_cfg, 'SessionTTL');
			$session->{cas_attributes} = $cas_attributes;
			$session->{cas_pgt} = $pgt if $pgt;
			$session->{cas_proxy} = $cas_proxy if $cas_proxy;
			$_log->l($debug_level, 'created session ' . $session->{_session_id} .
					       ' expiration ' . $session->{expiration});

			my $cookie = new CGI::Cookie(-name => $cookie_name,
						     -value => $session->{_session_id},
						     -secure => cfg_value($dir_cfg,
						     			  'SessionCookieSecure'),
						     -path => defined(cfg_value($dir_cfg,
						     				'SessionCookiePath')) ?
								      cfg_value($dir_cfg,
								      		'SessionCookiePath') : undef);
			$cookie->bake($r);

			untie(%{$session});

			if (cfg_value($dir_cfg, 'RemoveServiceTicket')) {
				$_log->l($debug_level, "removing ticket parameter from request args");

				# if $r->args is passed undef, it whines; but can't pass '' as that
				# sets args to empty string instead of undef 8-/
				no warnings 'uninitialized';
				$r->args($qs_nt ? "$qs_nt" : undef);
			}

			return Apache2::Const::OK;
		}
		else {
			if (exists($cas_data->{'cas:authenticationFailure'})) {
				$cas_data->{'cas:authenticationFailure'}{content} =~ s/^[\s\n]*//;
				$cas_data->{'cas:authenticationFailure'}{content} =~ s/[\s\n]*$//;

				$_log->l('error', 'ticket validation failed - ' .
						  $cas_data->{'cas:authenticationFailure'}{content} .
						  '(' . $cas_data->{'cas:authenticationFailure'}{code} . ')');
			}
			else {
				$_log->l('error', "ticket validation invalid response - " .
						  $response->content());
			}

			return Apache2::Const::SERVER_ERROR;
		}
	}

	$r->headers_out->{Location} = cfg_value($dir_cfg, 'ServerURL') .
				      cfg_value($dir_cfg, 'LoginPath') .
				      "?service=$service";

	$_log->l($debug_level, 'redirecting to ' . $r->headers_out->{Location});

	return Apache2::Const::HTTP_MOVED_TEMPORARILY;
}

sub cleanup {
	my ($r) = shift;
	my $now = time();
	my $_log = new Apache2::AuthCASpbh::Log(__PACKAGE__, $r->log);
	my $dir_cfg = Apache2::Module::get_config('Apache2::AuthCASpbh',
						  $r->server, $r->per_dir_config);
	my $debug_level = cfg_value($dir_cfg, 'DebugLevel');

	if (!$r->is_initial_req) {
		$_log->l($debug_level, "not initial request, skipping cleanup");
		return Apache2::Const::OK;
	}

	my $session_db = cfg_value($dir_cfg, 'SessionDBPath') . '/' .
			 cfg_value($dir_cfg, 'SessionDBName');
	$_log->l($debug_level, "cleanup using session db $session_db");

	$_log->l($debug_level, 'opening global state session ' .