view release on metacpan or  search on metacpan

AuthCookieDBI.pm  view on Meta::CPAN

    my $hash =
      md5_hex( join ':', $secret_key,
        md5_hex( join ':', $public_part, $secret_key ) );

    # Now we add this hash to the end of the public part.
    my $session_key = "$public_part:$hash";

    # Now we encrypt this and return it.
    my $encrypted_session_key;
    if ( $c{DBI_encryptiontype} eq 'none' ) {
        $encrypted_session_key = $session_key;
    }
    elsif ( lc $c{DBI_encryptiontype} eq 'des' ) {
        $CIPHERS{"des:$auth_name"} ||= Crypt::CBC->new( $secret_key, 'DES' );
        $encrypted_session_key =
          $CIPHERS{"des:$auth_name"}->encrypt_hex($session_key);
    }
    elsif ( lc $c{DBI_encryptiontype} eq 'idea' ) {
        $CIPHERS{"idea:$auth_name"} ||= Crypt::CBC->new( $secret_key, 'IDEA' );
        $encrypted_session_key =
          $CIPHERS{"idea:$auth_name"}->encrypt_hex($session_key);
    }
    elsif ( lc $c{DBI_encryptiontype} eq 'blowfish' ) {
        $CIPHERS{"blowfish:$auth_name"} ||=
          Crypt::CBC->new( $secret_key, 'Blowfish' );
        $encrypted_session_key =
          $CIPHERS{"blowfish:$auth_name"}->encrypt_hex($session_key);
    }

    return $encrypted_session_key;
}

#-------------------------------------------------------------------------------
# Take a session key and check that it is still valid; if so, return the user.

sub authen_ses_key {
    my ( $self, $r, $encrypted_session_key ) = @_;

    my $auth_name = $r->auth_name;

    # Get the configuration information.
    my %c = _dbi_config_vars $r;

    # Get the secret key.
    my $secret_key = $SECRET_KEYS{$auth_name};
    unless ( defined $secret_key ) {
        $r->log_reason(
"Apache::AuthCookieDBI: didn't have the secret key from for auth realm $auth_name",
            $r->uri
        );
        return;
    }

    # Decrypt the session key.
    my $session_key;
    if ( $c{DBI_encryptiontype} eq 'none' ) {
        $session_key = $encrypted_session_key;
    }
    else {

        # Check that this looks like an encrypted hex-encoded string.
        unless ( $encrypted_session_key =~ /^[0-9a-fA-F]+$/ ) {
            $r->log_reason(
"Apache::AuthCookieDBI: encrypted session key $encrypted_session_key doesn't look like it's properly hex-encoded for auth realm $auth_name",
                $r->uri
            );
            return;
        }

        # Get the cipher from the cache, or create a new one if the
        # cached cipher hasn't been created, & decrypt the session key.
        my $cipher;
        if ( lc $c{DBI_encryptiontype} eq 'des' ) {
            $cipher = $CIPHERS{"des:$auth_name"} ||=
              Crypt::CBC->new( $secret_key, 'DES' );
        }
        elsif ( lc $c{DBI_encryptiontype} eq 'idea' ) {
            $cipher = $CIPHERS{"idea:$auth_name"} ||=
              Crypt::CBC->new( $secret_key, 'IDEA' );
        }
        elsif ( lc $c{DBI_encryptiontype} eq 'blowfish' ) {
            $cipher = $CIPHERS{"blowfish:$auth_name"} ||=
              Crypt::CBC->new( $secret_key, 'Blowfish' );
        }
        elsif ( lc $c{DBI_encryptiontype} eq 'blowfish_pp' ) {
            $cipher = $CIPHERS{"blowfish_pp:$auth_name"} ||=
              Crypt::CBC->new( $secret_key, 'Blowfish_PP' );
        }
        else {
            $r->log_reason(
"Apache::AuthCookieDBI: unknown encryption type $c{ DBI_encryptiontype } for auth realm $auth_name",
                $r->uri
            );
            return;
        }
        $session_key = $cipher->decrypt_hex($encrypted_session_key);
    }

    # Break up the session key.
    my ( $enc_user, $issue_time, $expire_time, @rest ) =
      ( split /:/, $session_key );
    my $supplied_hash = pop @rest;
    ( $enc_user, $issue_time, $expire_time, $supplied_hash ) =
      _defined_or_empty( $enc_user, $issue_time, $expire_time, $supplied_hash );

    # Let's check that we got passed sensible values in the cookie.
    unless ( $enc_user =~ /^[a-zA-Z0-9_\%]+$/ ) {
        $r->log_reason(
"Apache::AuthCookieDBI: bad percent-encoded user $enc_user recovered from session ticket for auth_realm $auth_name",
            $r->uri
        );
        return;
    }

    # decode the user
    my $user = _percent_decode($enc_user);
    unless ( $issue_time =~ /^\d{4}-\d{2}-\d{2}-\d{2}-\d{2}-\d{2}$/ ) {
        $r->log_reason(
"Apache::AuthCookieDBI: bad issue time $issue_time recovered from ticket for user $user for auth_realm $auth_name",
            $r->uri
        );