view release on metacpan or  search on metacpan

lib/Apache2/AuthAny/Cookie.pm  view on Meta::CPAN

package Apache2::AuthAny::Cookie;

use strict;

use CGI::Cookie ();
use Apache2::Cookie ();
use Apache2::Request ();
use Digest::MD5 qw(md5_hex);

use Apache2::AuthAny::DB ();
use Apache2::AuthAny::AuthUtil ();
use Data::Dumper qw(Dumper);

use Apache2::Const -compile => qw(HTTP_UNAUTHORIZED REDIRECT OK);
our $aaDB;
our $VERSION = '0.201';

sub post_login {
    my $r = shift;
    my $uri = $r->uri;

    my ($authProvider) =  ($uri =~ m{/aa_auth/(.*?)/});
    $authProvider =~ s/_aa-key_.*//;

    my $get_params = Apache2::Request->new($r);
    my $location = $get_params->param('req');
    unless ($location) {
        $r->log->warn("Apache2::AuthAny::Cookie: missing req redirect after login with $authProvider");
        $location = "/";
    }

    $aaDB = Apache2::AuthAny::DB->new() unless $aaDB;
    unless ($aaDB) {
        my $msg = "Cannot connect to database.";
        $r->log->crit("AuthAny::Cookie: $msg");
        return Apache2::AuthAny::AuthUtil::goToGATE($r, 'tech', {msg => $msg});
    }

    my $authId = $ENV{REMOTE_USER} || $r->user;
    if ($authId) {
        my $map_file = "$ENV{AUTH_ANY_CONFIG_ROOT}/provider-mapping.pl";
        if (-f $map_file) {
            open(MAPPING, "<$map_file") || die "$map_file ?? $!";
            my @cts = <MAPPING>;
            my $contents = "@cts";
            close(MAPPING);
            my $mapping = eval $contents;
            if ($mapping->{$authProvider}) {
                my $orig = $authId;
                $authId =~ s/$mapping->{$authProvider}//;
                if ($authId eq $orig) {
                    $r->log->error("AuthAny::Cookie: mapping had no effect");
                }
            }
        }
    } else {
        my $msg = 'Please try another login method';
        $r->log->error("Cookie: Auth method at '$uri' did not set REMOTE_USER");
        return Apache2::AuthAny::AuthUtil::goToGATE($r, 'authen', {msg => $msg});
    }

    ######################################################################
    # Cookie
    ######################################################################

    my $pid = $r->pnotes('pid');
    my $sCookie = md5_hex(time . rand);
    if ($aaDB->loginPCookie($pid->{PID}, $sCookie, $authId, $authProvider)) {
        my $new_sid_cookie = CGI::Cookie->new(-name  => 'AA_SID',
                                              -value => $sCookie,
                                             );
        $r->err_headers_out->add('Set-Cookie' => $new_sid_cookie);