###################################################################
# Copyright (C) 2006 RoyaltyShare, Inc.  All Rights Reserved
# $Id$
###################################################################

package Common::Cookie;

#
# Common::Cookie is a base class for creating HTTP cookies.  The
# store method requires mod_perl.  If required the cookie data
# can be encrypted by appending '-s' to the cookie name, otherwise
# cookie data will be clear text key value pairs uri escaped and
# delimited by '&'.
#
# This is a virtual class that must be overloaded.  You must
# overload the name, expires, and passphrase ( if encrypted )
# methods.
#
# SECURITY IMPROVEMENTS (2025):
# - Uses random IV per encryption (prevents pattern analysis)
# - Adds HttpOnly, Secure, and SameSite cookie flags
# - Reads old Blowfish cookies when possible (transparent upgrade); writes always in new AES format
#
# Usage:
#
# package Common::Cookie::MyCookie
#
# sub name       { "cookiename-s" }
# sub expires    { "+12M" }
# sub passphrase { "somePass" }
# sub secure     { 1 }  # Optional: force Secure flag
# sub samesite   { "Strict" }  # Optional: override SameSite
#
# my $cookie = new Common::Cookie::MyCookie();
# my $val = $cookie->get( "myKey" );
#
# $cookie->set( "someKey" => "ok" );
# $cookie->store();
#

use strict;
use warnings;
use Carp;
use Date::Format;
use Crypt::CBC;
use Digest::SHA qw(sha256);

use CGI::Cookie;
use URI::Escape;
use Data::Dumper;
use Apache2::RequestUtil;

# IV length for AES (16 bytes)
use constant IV_LENGTH => 16;
# Old Blowfish format (for backward-compatible read only)
use constant K_ENC_SALT => pack( "LL", 324, 11721 );

use lib '/app/tools/common/lib';
use Common::Assert;

sub name       { assert( 0, "Virtual Method" ); }
sub expires    { assert( 0, "Virtual Method" ); }
sub passphrase { assert( 0, "Virtual Method" ); }
sub domain     { $ENV{COOKIE_DOMAIN} || "royaltyshare.com" }
sub secure     { 0 }
sub samesite   { "Lax" }

sub new {
    my ( $class, %args ) = @_;
    my $self = bless {}, $class;

    return $self->_init(%args);
}

sub _init {
    my ( $self, %args ) = @_;

    $self->{_apache} = Apache2::RequestUtil->request();

    $self->{_cookie}      = $self->_fetch();
    $self->{_cookie_data} = $self->_thaw();

    unless ( $self->{_cookie} ) {
        $self->{_cookie} = new CGI::Cookie(
            -name    => $self->name,
            -value   => "",
            -domain  => $self->domain,
            -expires => $self->expires
        );
    }

    $self->{_cookie}->expires( $self->expires );

    # If we read old (Blowfish) format, re-encrypt and send cookie in new format this request
    if ( $self->{_reencrypt_to_new_format} && $self->{_cookie_data} && keys %{ $self->{_cookie_data} } ) {
        $self->store();
    }

    #Common::Log::Debug( "COOKIE: $self->{_cookie}" );
    return $self;
}

sub set {
    my $self  = shift;
    my $key   = shift;
    my $value = shift;

    assert($key);

    my $data = $self->{_cookie_data};

    $data->{$key} = $value;

    $self->{_cookie_data} = $data;
    return $value;
}

sub get {
    my $self = shift;
    my $key  = shift;

    assert($key);

    return $self->{_cookie_data}->{$key};
}

sub clear {
    my $self = shift;
    $self->{_cookie_data} = {};
    return $self;
}

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

    # Don't store cookies if there's no data (avoids storing encrypted empty strings)
    my $data = $self->{_cookie_data};
    return unless $data && keys %{$data};

    my $value = $self->_freeze() || "";
    my $cookie = $self->{_cookie};

    $cookie->domain( $self->domain );
    $cookie->value($value);

    $cookie->httponly(1) if $cookie->can('httponly');
    if ( $self->secure || ( $ENV{HTTPS} && $ENV{HTTPS} eq 'on' ) ) {
        $cookie->secure(1);
    }
    $cookie->samesite( $self->samesite || 'Lax' ) if $cookie->can('samesite');

    $self->{_apache}->headers_out->add( "Set-Cookie" => $cookie ) if $self->{_apache};
}

sub _fetch {
    my ($self) = @_;
    my %cookies = CGI::Cookie->fetch;
    return $cookies{ $self->name };
}

sub _freeze {
    my $self = shift;
    my ( $value, $key );
    my $data = $self->{_cookie_data};
    my $serialized;

    assert( $self->name );

    foreach $key ( keys %{$data} ) {
        $value = ${ $self->{_cookie_data} }{$key};
        $serialized .= "&" if ( defined($serialized) );
        $serialized .= sprintf( "%s=%s", uri_escape($key), uri_escape($value) );

        #Common::Log::Debug( "Serializing $key = $value to " .
        #uri_escape($key) . "=" . uri_escape($value) );
    }

    #
    #  If we need to encrypt the data
    #
    if ( $self->name =~ /-s$/ ) {
        $serialized = $self->_encrypt($serialized);
    }

    #Common::Log::Debug( sprintf "Serializing cookie data: %s", $serialized ? $serialized : "" );
    return $serialized;
}

sub _thaw {
    my $self = shift;
    my %result;
    my @pairs;
    my ( $key, $value );

    return unless ( $self->{_cookie} );
    my $data = $self->{_cookie}->value;

    #
    # If we need to decrypt the cookie value
    #
    if ( $self->name =~ /-s$/ ) {
        $data = $self->_decrypt($data);
    }

    #unless( defined($data) ) {
    #Common::Log::Debug( "Unserializing Data: No cookie data to unserialize" );
    #}
    #else {
    #Common::Log::Debug( "Unserializing Data: $data" );

    @pairs = split( /&/, $data );

    foreach my $record (@pairs) {
        ( $key, $value ) = split( /=/, $record );
        $key          = uri_unescape($key);
        $value        = uri_unescape($value);
        $result{$key} = $value;
    }

    #}

    return \%result;
}

sub _encrypt {
    my ( $self, $unencrypted ) = @_;

    assert( $self->passphrase, "passphrase required" );

    my $key = sha256( $self->passphrase );

    # Generate random IV for each encryption (prevents pattern analysis)
    my $iv;
    if ( eval { require Crypt::Random; 1 } ) {
        $iv = Crypt::Random::makerandom_octet( Length => IV_LENGTH );
    } elsif ( -r '/dev/urandom' ) {
        eval {
            open( my $fh, '<', '/dev/urandom' ) || die;
            read( $fh, $iv, IV_LENGTH ) == IV_LENGTH || die;
            close($fh);
        };
        # If eval failed or IV is invalid, $iv is undef and we fall through
    }

    # Fallback to other methods if previous attempts failed
    unless ( $iv && length($iv) == IV_LENGTH ) {
        if ( eval { require Math::Random::Secure; 1 } ) {
            $iv = Math::Random::Secure::random_bytes(IV_LENGTH);
        } else {
            my $seed = time() . $$ . rand();
            $iv = pack( "H*", substr( sha256($seed), 0, IV_LENGTH * 2 ) );
        }
    }

    my $cipher = Crypt::CBC->new(
        -key         => $key,
        -cipher      => 'Crypt::Cipher::AES',
        -header      => 'none',
        -iv          => $iv,
        -literal_key => 1
    );

    my $cipherdata = $cipher->encrypt($unencrypted);

    # Prepend IV to ciphertext: format is IV_HEX:ciphertext_HEX
    my $iv_hex = unpack( "H*", $iv );
    my $ciphertext_hex = unpack( "H*", $cipherdata );
    return $iv_hex . ":" . $ciphertext_hex;
}

sub _decrypt {
    my ( $self, $encrypted ) = @_;

    assert( $self->passphrase, "passphrase required" );

    # New format: IV_HEX:ciphertext_HEX (AES)
    if ( $encrypted =~ /^([0-9a-fA-F]{32}):(.+)$/ ) {
        my $iv_hex         = $1;
        my $ciphertext_hex = $2;
        my $iv             = pack( "H*", $iv_hex );

        return "" unless ( length($iv) == IV_LENGTH );

        my $key = sha256( $self->passphrase );

        return "" unless ( $ciphertext_hex =~ /^[0-9a-fA-F]+$/ && length($ciphertext_hex) % 2 == 0 );

        my $pack = pack( "H*", $ciphertext_hex );

        return "" unless ( length($pack) % 16 == 0 );

        my $cipher = Crypt::CBC->new(
            -key         => $key,
            -cipher      => 'Crypt::Cipher::AES',
            -header      => 'none',
            -iv          => $iv,
            -literal_key => 1
        );

        my $decoded;
        eval { $decoded = $cipher->decrypt($pack) };
        return $@ ? "" : $decoded;
    }

    # Old format: hex only (Blowfish, same env as before upgrade) – transparent read
    return "" if $encrypted =~ /:/;
    return "" unless ( $encrypted =~ /^[0-9a-fA-F]+\z/ && length($encrypted) % 2 == 0 );

    my $pack = pack( "H*", $encrypted );
    return "" if length($pack) < 8;

    my $cipher = Crypt::CBC->new(
        -key    => $self->passphrase,
        -cipher => 'Blowfish',
        -header => 'none',
        -iv     => K_ENC_SALT
    );

    my $decoded;
    eval { $decoded = $cipher->decrypt($pack) };
    return "" if $@;

    # Only accept if result looks like key=value&... (avoid binary from wrong env)
    return "" if $decoded =~ /[^\x20-\x7e%&=\s]/;
    return "" unless $decoded =~ /&/ || $decoded =~ /=/;

    $self->{_reencrypt_to_new_format} = 1;    # so we write back in new format this request
    return $decoded;
}

1;