view release on metacpan or  search on metacpan

AutoLogin.pm  view on Meta::CPAN

    
    # Else write the credentials within the cookie into the http header
    else {
        # But only if there IS something in the cookie!
        if ($decrypted_string ne '' and $c_user ne '' and $c_password ne '')    {
            my $credentials=MIME::Base64::encode(join(":",$c_user,$c_password));
            $r->headers_in->set(Authorization => "Basic $credentials");
        }
    }
    
    # Return DECLINED
    return DECLINED;
}

## sets the cookie
sub setCookie {
    
    my ($r,$user,$password,$client_identifier,$cookie_lifetime,$encryption_key)=@_;
    my $auth_name=$r->dir_config('AutoLoginAuthName');
    my $log=$r->server->log;

    my $auth_cookie = Apache::Cookie->new ($r,
                                       -name => $auth_name,
                                       -value => {Basic => encode_base64(encrypt_aes(join (":",$user,$password,$client_identifier,(time()+60*60*24*$cookie_lifetime)),$encryption_key))},
                                       -path => "/",
                                       -expires => "+".$cookie_lifetime."d"
                                      );
    $auth_cookie->bake;
       
}

sub encrypt_aes {

    my ($string, $key)=@_;
    
    # keysize() is 32, but 24 and 16 are also possible
    # blocksize() is 16
    # So we fill the string with some random data to the next 16 byte boundary.
    # Like this we have a valid block size AND oracle attacks get very difficult.
    
    my $fillup=16-(length($string) % 16);
    
    if ($fillup==0)
    {
        $fillup=16;
    }
    
    # The : is the boundary of the random data.
    $string=$string . ":";
    --$fillup;
    
    while ($fillup>0)
    {
        $string.=int(rand(10));
        --$fillup;
    }
    
    ## a a md5_hex checksum to the string.
    $string.=md5_hex($string);
    
    my $cipher = new Crypt::Rijndael $key, Crypt::Rijndael::MODE_CBC;
    
    # encrypt the string.
    $string=$cipher->encrypt($string);
   
    return $string;
}

sub decrypt_aes {

    my ($string, $key)=@_;
    
    # keysize() is 32, but 24 and 16 are also possible
    # blocksize() is 16
    ## The string must have 16 bytes blocks.
    if (length($string) % 16 !=0)
    {
        return "";
    }
    
    my $cipher = new Crypt::Rijndael $key, Crypt::Rijndael::MODE_CBC;
    # decrypt it
    my $decrypted=$cipher->decrypt($string);
    
    
    # Chop of the last 32 bytes (this is the md5 checksum)
    # and calculate checksum
    
    ## Check if the string is longer than 32 bytes
    if (length ($decrypted)<32)
    {
        return "";
    }
    
    ## Alter the string (chop of the last 32 bytes
    my $checksum=substr($decrypted,-32);
    $decrypted=substr($decrypted,0,(length($decrypted)-32));
    
    ## If the checksum is invalid return this
    if ($checksum ne md5_hex($decrypted))
    {
        return "";
    }
    ## chop of the random data
    my $char=" ";
    while($char ne ':' and $char ne '')
    {
        $char=chop($decrypted);
    }
    
    ## If char is eq to '' then there were no credentials, etc. in the string...
    if ($char eq '')
    {
        return '';
    }
    
     
    return $decrypted;

}

1;
__END__
# Below is stub documentation for your module. You better edit it!

=head1 NAME

Apache::AutoLogin - Automatic login module based on encrypted cookies for sites using basic authentication.

=head1 SYNOPSIS

  # In httpd.conf or .htaccess put it just
  # before your basic authentication module
  
  # It has the be invoked as a PerlAccessHandler,
  # because this is just the phase
  # before authentication!
  
  <Location />
        PerlModule Apache::AutoLogin
        PerlAccessHandler Apache::AutoLogin