^sub \w+\( results from the CPAN

^sub \w+\(

Apache2-AuthCAS

view release on metacpan or search on metacpan

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

        "DbDriver"                => "Pg",
        "DbDataSource"            => "dbname=apache_cas;host=localhost;port=5432",
        "DbSessionTable"          => "cas_sessions",
        "DbUser"                  => "cas",
        "DbPass"                  => "cas",
);

# default to 0
$SESSION_CLEANUP_COUNTER = 0 if (!defined($SESSION_CLEANUP_COUNTER));

sub dbConnect($)
{
    my($self) = @_;

    my $dbh = DBI->connect(
        "dbi:" . $self->casConfig("DbDriver")
            . ":" . $self->casConfig("DbDataSource"),
        $self->casConfig("DbUser"), $self->casConfig("DbPass"),
        { AutoCommit => 1 }
    );
    if (!defined($dbh))
    {
        $self->logMsg("db connect error: $DBI::errstr");
        return undef;
    }

    return $dbh;
}

sub getApacheConfig($)
{
    my($self) = @_;
    $self->{'casConfig'} = Apache2::Module::get_config('Apache2::AuthCAS::Configuration'
        , $self->{'request'}->server
        , $self->{'request'}->per_dir_config);

    # Now add in our defaults
    foreach my $key (keys(%DEFAULTS))
    {
        $self->{'casConfig'}->{$key} = $DEFAULTS{$key}

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

    }

    $self->logMsg("Apache Config:", $LOG_DEBUG);
    foreach my $key (sort(keys(%{$self->{'casConfig'}})))
    {
        my $val = $self->casConfig($key) || 'undef';
        $self->logMsg("    $key => $val", $LOG_DEBUG);
    }
}

sub casConfig($$)
{
    my($self, $var) = @_;

    return $self->{'casConfig'}->{$var};
}

sub logMsg($$;$)
{
    my($self, $msg, $logLevel) = @_;

    $logLevel = $LOG_ERROR if (!$logLevel);

    if ($self->casConfig("LogLevel") >= $logLevel)
    {
        my $sub = (caller(1))[3];
        $sub =~ /(\w+)$/;
        $self->{'request'}->log->alert("CAS($$): $1: $msg");
    }
}

# used for underlying services that need proxy tickets (PTs)
sub authenticate($$)
{
    my($class, $r) = @_;

    # Only authenticate the first internal request
    return (Apache2::Const::OK) unless $r->is_initial_req;

    # Let's make this easy on ourselves and pass an object around
    # for reading config variables and the request object
    my $self = {};
    bless($self, ref $class || $class);

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

            return $self->redirect_without_ticket() if ($self->casConfig("RemoveTicket"));

            return (Apache2::Const::OK);
        }
    }

    # No valid session, no ticket.  Redirect to CAS login
    return $self->redirect_login();
}

sub check_session($$$)
{
    my($self, $sid) = @_;

    # we set up our own session here, so that we don't have to continually
    # go through this whole process!  we associate a session id with a PGTIOU

    # try to get a session record for the session id we received
    # session_data - session id, last accessed, netid, pgtiou
    if (my($last_accessed, $user, $pgt) = $self->get_session_data($sid))
    {

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

        }
    }
    else
    {
        $self->logMsg("session '$sid' is invalid", $LOG_DEBUG);
    }

    return undef;
}

sub cleanup()
{
    my($self) = @_;

    $SESSION_CLEANUP_COUNTER++;
    $self->logMsg("counter=$SESSION_CLEANUP_COUNTER", $LOG_DEBUG);

    # perform session cleanup
    if ($SESSION_CLEANUP_COUNTER == 1)
    {
        $self->delete_expired_sessions();
    }

    # reset counter if we have reached our threshold
    $SESSION_CLEANUP_COUNTER = 0
        if ($SESSION_CLEANUP_COUNTER >= $self->casConfig("SessionCleanupThreshold"));
}

sub add_basic_auth($$)
{
    my($self, $user) = @_;

    if ($self->casConfig("PretendBasicAuth"))
    {
        # setup this up for underlying authz modules that rely
        # on Basic auth having been performed
        $self->setHeader(1, 'Authorization'
            , "Basic " . encode_base64($user . ":DUMMYPASS"));
        $self->{'request'}->ap_auth_type("Basic");
        $self->{'request'}->user($user);
    }
}

sub redirect_without_ticket($)
{
    my($self) = @_;

    $self->logMsg("redirecting to remove service ticket from service string", $LOG_INFO);

    $self->setHeader(0, 'Location', $self->this_url());
    return (Apache2::Const::HTTP_MOVED_TEMPORARILY);
}

sub redirect_login($)
{
    my($self) = @_;

    $self->logMsg("start", $LOG_DEBUG);

    my $service = $self->this_url(1);
    $self->logMsg("redirecting to CAS for service: '$service'", $LOG_INFO);

    $service = uri_escape($service);
    $self->setHeader(0, 'Location', "https://"
        . $self->casConfig("Host") . ":" . $self->casConfig("Port")
        . $self->casConfig("LoginUri") . "?service=$service");
    return (Apache2::Const::HTTP_MOVED_TEMPORARILY);
}

sub redirect($;$$)
{
    my($self, $url, $errcode) = @_;

    if ($url)
    {
        my $service = $self->this_url(1);
        $self->logMsg("redirecting to url: '$url' service: '$service'", $LOG_INFO);

        $self->setHeader(0, 'CAS_FILTER_CAS_HOST',      $self->casConfig("Host"));
        $self->setHeader(0, 'CAS_FILTER_CAS_PORT',      $self->casConfig("Port"));

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

        return (Apache2::Const::HTTP_OK);
    }
}

# params
#     apache request object
#     ticket to be validated
# returns a hash with keys on success
#       'user', 'pgtiou'
# NULL on failure
sub validate_service_ticket($$$)
{
    my($self, $ticket) = @_;

    my $proxy = $self->casConfig("ProxyService") ? "1" : "0";

    my $service = $self->this_url(1);
    $self->logMsg("Validating service ticket '$ticket' for service '$service'", $LOG_DEBUG);

    my $url;
    if ($proxy)

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

    }
    else
    {
        $self->logMsg("invalid service response", $LOG_DEBUG);
        $errorMsg = $ERROR_CODES{"INVALID_RESPONSE"};
    }

    return ($errorMsg, $user, $pgtiou);
}

sub proxy_receptor($$$)
{
    my($self, $pgtiou, $pgt) = @_;

    # This is the proxy receptor.
    # We should only enter here when CAS sends us the PGTIOU and the PGT
    if ($pgtiou and $pgt)
    {
        $self->logMsg("proxy receptor invoked with '$pgtiou' => '$pgt'", $LOG_DEBUG);

        # save the pgtiou/pgt mapping

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

        return (Apache2::Const::OK);
    }
    else
    {
        $self->logMsg("invalid proxy receptor call - missing ticket information"
            , $LOG_DEBUG);
        return $self->redirect($self->casConfig("ErrorUrl") , $ERROR_CODES{"PGT_RECEPTOR"});
    }
}

sub send_proxysuccess($$)
{
    my($self) = @_;

    $self->logMsg("sending proxy success for CAS callback", $LOG_DEBUG);

    $self->{'request'}->content_type("text/html");
    $self->{'request'}->print("<casClient:proxySuccess xmlns:casClient=\"http://www.yale.edu/tp/casClient\"/>\n");
    $self->{'request'}->rflush();
    return (Apache2::Const::OK);
}

sub get_proxy_tickets($$;$$)
{
    my($self, $pgt, $target, $numTickets) = @_;

    return () if (!$target or !$numTickets);

    $self->logMsg("retrieving '$numTickets' PTs for PGT='$pgt', target='$target'", $LOG_DEBUG);

    my @tickets = ();

    # Net::SSLeay::trace options

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

        {
            $self->logMsg("invalid proxy ticket response", $LOG_DEBUG);
            return ();
        }
    }

    return @tickets;
}

# place data in the session
sub create_session($$$$)
{
    my($self, $uid, $pgtiou, $ticket) = @_;

    $self->logMsg("creating session for uid='$uid'"
        . ($pgtiou ? ", pgtiou='$pgtiou'" : ""), $LOG_DEBUG);

    my $sid = sprintf("%10d-", time());
    srand();
    for (my $i = 0; $i < 21; $i++)
    {

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

        $self->logMsg("error creating session ($DBI::errstr)", $LOG_DEBUG);
        undef($sid);
    }

    $dbh->disconnect();

    return $sid;
}

# "touch" the session
sub touch_session($$)
{
    my($self, $sid) = @_;

    $self->logMsg("touching session '$sid'", $LOG_DEBUG);

    my $dbh = $self->dbConnect() or return 0;

    $dbh->do("UPDATE " . $self->casConfig("DbSessionTable")
        . " SET last_accessed = ? WHERE id = ?"
        , undef, time(), $sid

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

        $self->logMsg("error touching session ($DBI::errstr)", $LOG_DEBUG);
        $rc = 0;
    }

    $dbh->disconnect();

    return $rc;
}

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

    $self->logMsg("retrieving session data for sid='$sid'", $LOG_DEBUG);

    # retrieve a session object for this session id
    my $dbh = $self->dbConnect() or return ();

    my($last_accessed, $uid, $pgt) = $dbh->selectrow_array(
        "SELECT last_accessed, user_id, pgt FROM "

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

            . " last_accessed='$last_accessed' uid='$uid'"
            . ($pgt ? "pgt='$pgt'" : ""), $LOG_DEBUG);
        return ($last_accessed, $uid, $pgt);
    }

    $self->logMsg("couldn't get session data for sid='$sid'", $LOG_DEBUG);
    return ();
}

# delete session
sub delete_session_data($$)
{
    my($self, $sid) = @_;

    $self->logMsg("deleting session mapping for sid='$sid'", $LOG_DEBUG);

    # retrieve a session object for this session id
    my $dbh = $self->dbConnect() or return 0;

    $dbh->do("DELETE FROM " . $self->casConfig("DbSessionTable") . " WHERE id = ?"
        , undef, $sid

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

        $self->logMsg("error deleting session mapping for sid='$sid' ($DBI::errstr)", $LOG_DEBUG);
        $rc = 0;
    }

    $dbh->disconnect();

    return $rc;
}

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

    my $oldestValidTime = time() - $self->casConfig("SessionTimeout");
    $self->logMsg("deleting sessions older than '$oldestValidTime'", $LOG_DEBUG);

    # retrieve a session object for this session id
    my $dbh = $self->dbConnect() or return 0;

    $dbh->do("DELETE FROM " . $self->casConfig("DbSessionTable")

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

        $self->logMsg("error deleting expired sessions ($DBI::errstr)", $LOG_ERROR);
        $rc = 0;
    }

    $dbh->disconnect();

    return $rc;
}

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

    $self->logMsg("adding map for pgtiou='$pgtiou' pgt='$pgt'", $LOG_DEBUG);

    my $dbh = $self->dbConnect() or return 0;

    $dbh->do(
        "UPDATE " . $self->casConfig("DbSessionTable") . "
        SET pgt = ?

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

    {
        $self->logMsg("error adding map ($DBI::errstr)", $LOG_ERROR);
        $rc = 0;
    }

    $dbh->disconnect();

    return $rc;
}

sub do_proxy($$$$$$)
{
    my($self, $sid, $pgt, $user, $removeTicket) = @_;

    $self->logMsg("proxying request, sid='$sid'", $LOG_DEBUG);
    $self->logMsg("pgt='$pgt'", $LOG_DEBUG) if ($pgt);

    if (!$pgt)
    {
        my(@sessionData) = $self->get_session_data($sid);
        $pgt = $sessionData[2];

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

        return (Apache2::Const::OK);
    }
    else
    {
        $self->delete_session_data($sid);
        return $self->redirect($self->casConfig("ErrorUrl")
            , $ERROR_CODES{"INVALID_PGT"});
    }
}

sub setHeader($$$$)
{
    my($self, $in, $header, $value) = @_;

    $self->logMsg("Setting header: $header = $value", $LOG_DEBUG);

    if ($in)
    {
        $self->{'request'}->headers_in->{$header} = $value;
    }
    else
    {
        $self->{'request'}->headers_out->{$header} = $value;
    }
}

# strips the ticket from the query and returns the full service URL
sub this_url($$;$)
{
    my($self, $serviceOverride) = @_;

    if ($serviceOverride and my $service = $self->casConfig("Service"))
    {
        return $service;
    }

    my $url = $self->{'request'}->construct_url();
    my $uri = $self->{'request'}->parsed_uri;

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

        $url .= "?$query" if ($query ne "");
    }
    elsif ($self->{'request'}->unparsed_uri =~ /\?$/)
    {
        $url .= "?";
    }

    return $url;
}

sub parse_query_parameters($$)
{
    my($self, $query) = @_;

    return () if (!$query);

    my %params = ();
    foreach my $param (split(/&/, $query))
    {
        my($key, $value) = split(/=/, $param);

lib/Apache2/AuthCAS/Configuration.pm view on Meta::CPAN

            Apache2::ServerUtil->server->log->debug("merge: $key => $b");
            Apache2::ServerUtil->server->log->debug("       $key => $a");
        }
        $merged{$key} = $base->{$key} if exists($base->{$key});
        $merged{$key} = $add->{$key}  if exists($add->{$key});
    }

    return bless(\%merged, ref($base));
}

sub CASConfig($$$)
{
    my ($self, $parms, $data) = @_;

    my $which = $parms->info();

    Apache2::ServerUtil->server->log->debug("    Setting $which to $data");
    if ($which eq "LogLevel")
    {
        # Validate the argument is a valid log level
        unless ($data >= 0 and $data <= 4)

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