view release on metacpan or  search on metacpan

AutoLogin.pm  view on Meta::CPAN

    
    # Check if the client has furnished any valid information
    
    if ($decrypted_string ne '')
    {
        $log->info("Data from cookie $c_user, $c_date, $c_client_ip");
        
        ## Some checks on the validity of the cookie
        
        # Check if the cookie hasn't expired
        
        if (time()>$c_date)
        {
            $log->info("Cookie has expired");
            setCookie($r,$user,$password,$client_identifier,$cookie_lifetime,$encryption_key);
            return DECLINED;
        }
        
        # Check if the cookie comes from the host it was issued to
        
        if ($client_identifier ne $c_client_ip)
        {
            $log->info("Cookie for $c_user has not been set for $client_identifier but for $c_client_ip");
            setCookie($r,$user,$password,$client_identifier,$cookie_lifetime,$encryption_key);
            return DECLINED;
        }
    }
    else
    {
        $log->info("Client $client_identifier has furnished an invalid cookie.");
    }
    
    # If the client sent any http authentication credentials lets write them to a cookie
    
    if ($user ne '' && $password ne '') {
        setCookie($r,$user,$password,$client_identifier,$cookie_lifetime,$encryption_key);
    }
    
    # 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);