# --
# Copyright (C) 2021 Znuny GmbH, https://znuny.org/
# --
# This software comes with ABSOLUTELY NO WARRANTY. For details, see
# the enclosed file COPYING for license information (AGPL). If you
# did not receive this file, see http://www.gnu.org/licenses/agpl.txt.
# --
## nofilter(TidyAll::Plugin::Znuny::Perl::LayoutObject)
## nofilter(TidyAll::Plugin::Znuny::Perl::UUID)

package Kernel::System::Util;

use strict;
use warnings;
use utf8;

use MIME::Base64;
use Data::UUID;
use File::stat;

use Kernel::System::VariableCheck qw(:all);

our @ObjectDependencies = (
    'Kernel::Config',
    'Kernel::Output::HTML::Layout',
    'Kernel::System::JSON',
    'Kernel::System::Main',
);

=head1 NAME

Kernel::System::Util

=head1 DESCRIPTION

All Util functions.

=head1 PUBLIC INTERFACE

=head2 new()

Create an object. Do not use it directly, instead use:

    use Kernel::System::ObjectManager;
    local $Kernel::OM = Kernel::System::ObjectManager->new();
    my $UtilObject = $Kernel::OM->Get('Kernel::System::Util');

=cut

sub new {
    my ( $Type, %Param ) = @_;

    my $Self = \%Param;
    bless( $Self, $Type );

    return $Self;
}

=head2 IsITSMInstalled()

Checks if ITSM is installed.

    my $IsITSMInstalled = $UtilObject->IsITSMInstalled();

    Returns 1 if ITSM is installed and 0 otherwise.

=cut

sub IsITSMInstalled {
    my ( $Self, %Param ) = @_;

    # Use cached result because it won't change within the process.
    return $Self->{ITSMInstalled} if defined $Self->{ITSMInstalled};

    my $ConfigObject = $Kernel::OM->Get('Kernel::Config');

    # Just use some arbitrary ITSM::Core SysConfig option to check if ITSM is present.
    $Self->{ITSMInstalled} = $ConfigObject->Get('Frontend::Module')->{AdminITSMCIPAllocate} ? 1 : 0;

    return $Self->{ITSMInstalled};
}

=head2 IsITSMIncidentProblemManagementInstalled()

Checks if ITSMIncidentProblemManagement is installed.

    my $IsITSMIncidentProblemManagementInstalled = $UtilObject->IsITSMIncidentProblemManagementInstalled();

    Returns 1 if ITSMIncidentProblemManagement is installed and 0 otherwise.

=cut

sub IsITSMIncidentProblemManagementInstalled {
    my ( $Self, %Param ) = @_;

    # Use cached result because it won't change within the process.
    return $Self->{ITSMIncidentProblemManagementInstalled} if defined $Self->{ITSMIncidentProblemManagementInstalled};

    my $ConfigObject = $Kernel::OM->Get('Kernel::Config');

    # Just use some arbitrary SysConfig option to check if IncidentProblemManagement is present.
    $Self->{ITSMIncidentProblemManagementInstalled}
        = $ConfigObject->Get('Frontend::Module')->{AgentITSMIncidentProblemManagement} ? 1 : 0;

    return $Self->{ITSMIncidentProblemManagementInstalled};
}

=head2 IsFrontendContext()

Checks if current code is being executed in frontend context, e.g. agent frontend.

    my $IsFrontendContext = $UtilObject->IsFrontendContext();

    Returns 1 if current code is being executed in frontend context.
    Returns 0 if otherwise (e.g. console command context).

=cut

sub IsFrontendContext {
    my ( $Self, %Param ) = @_;

    # Note that "exists" is required. Otherwise Perl will create the key
    # with an undefined value which causes crashes since the object manager
    # won't work properly anymore.
    return if !exists $Kernel::OM->{Objects}->{'Kernel::Output::HTML::Layout'};

    my $LayoutObject = $Kernel::OM->Get('Kernel::Output::HTML::Layout');
    return if !$LayoutObject->{Action};

    return 1;
}

=head2 ApplicationUserGet()

Determines the local application user.

    my $ApplicationUser = $UtilObject->ApplicationUserGet();

=cut

sub ApplicationUserGet {
    my ( $Self, %Param ) = @_;

    my $DefaultApplicationUser = 'znuny';

    my $Home = $Kernel::OM->Get('Kernel::Config')->Get('Home');
    return $DefaultApplicationUser if !$Home;

    my $HomeStat = File::stat::stat($Home);
    return $DefaultApplicationUser if !$HomeStat;

    my $HomeOwner = getpwuid( $HomeStat->uid() );

    return $HomeOwner || $DefaultApplicationUser;
}

=head2 Base64DeepEncode()

    Base64 encodes elements of given data for given keys.
    If data is an array, all of its child elements will be checked for given keys whose elements
    will be encoded recursively.

    my $Base64EncodedData = $UtilObject->Base64DeepEncode(
        # Data can be a scalar, hash or array
        Data => {
            Article => {
                # ...
            },
            # ...
        },
        HashKeys => [
            # All 'Body' elements of array $Hash->{Articles} will be Base64 encoded.
            # Also can mean: $Hash->{Articles}->{Body}, if 'Articles' is a hash.
            # Will encode nothing if last key ('Body') cannot be reached or is not a scalar/string.
            'Articles->Body',

            'QueueData->Comment',
            # ...
        ],
    );

=cut

sub Base64DeepEncode {
    my ( $Self, %Param ) = @_;

    if ( !ref $Param{Data} ) {
        return encode_base64( $Param{Data} // '' );
    }
    elsif ( ref $Param{Data} eq 'ARRAY' ) {
        for my $Element ( @{ $Param{Data} } ) {
            $Element = $Self->Base64DeepEncode(
                Data     => $Element,
                HashKeys => $Param{HashKeys},
            );
        }
    }
    elsif ( ref $Param{Data} eq 'HASH' ) {
        return $Param{Data} if !IsArrayRefWithData( $Param{HashKeys} );

        NESTEDHASHKEYS:
        for my $NestedHashKeys ( @{ $Param{HashKeys} } ) {
            my @HashKeys = split '->', $NestedHashKeys;
            while (@HashKeys) {
                my $HashKey = shift @HashKeys;

                next NESTEDHASHKEYS if !exists $Param{Data}->{$HashKey};

                $Param{Data}->{$HashKey} = $Self->Base64DeepEncode(
                    Data     => $Param{Data}->{$HashKey},
                    HashKeys => [
                        ( join '->', @HashKeys ),
                    ],
                );
            }
        }
    }

    return $Param{Data};
}

=head2 DataStructureRemoveElements()

    Removes elements of given data for given keys.
    If data is an array, all of its child elements will be checked for given keys whose elements
    will be removed recursively.

    my $Data = $UtilObject->DataStructureRemoveElements(
        # Data can be a scalar, hash or array
        Data => {
            Article => {
                # ...
            },
            # ...
        },
        HashKeys => [
            # All 'Body' elements of array $Hash->{Articles} will be removed.
            # Also can mean: $Hash->{Articles}->{Body}, if 'Articles' is a hash.
            # Will remove nothing if last key ('Body') cannot be reached or is not a scalar/string.
            'Articles->Body',

            'QueueData->Comment',
            # ...
        ],
    );

=cut

sub DataStructureRemoveElements {
    my ( $Self, %Param ) = @_;

    if ( ref $Param{Data} eq 'ARRAY' ) {
        for my $Element ( @{ $Param{Data} } ) {
            $Element = $Self->DataStructureRemoveElements(
                Data     => $Element,
                HashKeys => $Param{HashKeys},
            );
        }
    }
    elsif ( ref $Param{Data} eq 'HASH' ) {
        return $Param{Data} if !IsArrayRefWithData( $Param{HashKeys} );

        NESTEDHASHKEYS:
        for my $NestedHashKeys ( @{ $Param{HashKeys} } ) {
            my @HashKeys = split '->', $NestedHashKeys;
            while (@HashKeys) {
                my $HashKey = shift @HashKeys;

                next NESTEDHASHKEYS if !exists $Param{Data}->{$HashKey};

                # If last key, remove entire element.
                if ( !@HashKeys ) {
                    delete $Param{Data}->{$HashKey};
                    next NESTEDHASHKEYS;
                }

                $Param{Data}->{$HashKey} = $Self->DataStructureRemoveElements(
                    Data     => $Param{Data}->{$HashKey},
                    HashKeys => [
                        ( join '->', @HashKeys ),
                    ],
                );
            }
        }
    }

    return $Param{Data};
}

=head2 GetInstalledDBCRUDObjects()

    Returns installed DBCRUD objects.

    my $DBCRUDObjects = $UtilObject->GetInstalledDBCRUDObjects();

    Returns:
    my $DBCRUDObjects = [
        # DBCRUD objects as returned by $Kernel::OM->Get('Kernel::System::...')
    ];

=cut

sub GetInstalledDBCRUDObjects {
    my ( $Self, %Param ) = @_;

    my $ConfigObject = $Kernel::OM->Get('Kernel::Config');
    my $MainObject   = $Kernel::OM->Get('Kernel::System::Main');

    my $KernelSystemPath = $ConfigObject->Get('Home') . '/Kernel/System';

    my @FilePaths = $MainObject->DirectoryRead(
        Directory => $KernelSystemPath,
        Filter    => '*.pm',
        Recursive => 1,
    );

    my @DBCRUDObjects;

    FILEPATH:
    for my $FilePath (@FilePaths) {
        my $FileContentRef = $MainObject->FileRead(
            Location => $FilePath,
        );
        next FILEPATH if ref $FileContentRef ne 'SCALAR';
        next FILEPATH if ${$FileContentRef} !~ m{^use parent\b.*?\bKernel::System::DBCRUD\b}m;

        next FILEPATH if ${$FileContentRef} !~ m{^package (.*?);$}m;
        my $DBCRUDPackage = $1;
        next FILEPATH if $DBCRUDPackage eq 'Kernel::System::DBCRUD';
        next FILEPATH if $DBCRUDPackage eq 'Kernel::System::UnitTest::DBCRUD';

        my $DBCRUDObject = $Kernel::OM->Get($DBCRUDPackage);
        next FILEPATH if !$DBCRUDObject;

        push @DBCRUDObjects, $DBCRUDObject;
    }

    return \@DBCRUDObjects;
}

=head2 XSSSanitizeValue()

Takes a value which may be a reference to an array or hash, or a string that
may be JSON, and tries to remove any contents suspicious of Cross Site
Scripting.

If the string looks like plain text, a bunch of regexen (see _SanitizeScalar)
is applied to it; otherwise if the string starts with "[" or "{", we try to
JSON-decode it and apply the sanitization recursively before reencoding it.

    my $Value = $UtilObject->XSSSanitizeValue( $SuspiciousValue );

=cut

sub XSSSanitizeValue {
    my ( $Self, $Value ) = @_;
    my $JSONObject = $Kernel::OM->Get('Kernel::System::JSON');

    return if !defined $Value;

    # If we have a has- or arrayref, sanitize it recursively.
    if ( ( ref($Value) eq 'HASH' ) || ( ref($Value) eq 'ARRAY' ) ) {
        return $Self->_SanitizeStructure($Value);
    }

    # If the value looks like JSON, decode, sanitize and reencode it.
    if ( $Value =~ qr{ ^ \s* [\[\{] }x ) {
        my $Structure = $JSONObject->Decode(
            Data => $Value,
        );
        if ( defined $Structure ) {
            my $SanitizedStructure = $Self->_SanitizeStructure($Structure);
            return $JSONObject->Encode(
                Data     => $SanitizedStructure,
                SortKeys => 1,
            );
        }
    }

    # Just sanitize a simple string
    return $Self->_SanitizeScalar($Value);
}

sub _SanitizeStructure {
    my ( $Self, $Structure ) = @_;
    my $Type = ref $Structure;

    if ( $Type eq 'HASH' ) {
        my %Sanitized;
        for my $Key ( sort keys %$Structure ) {
            my $SanitizedKey = $Self->_SanitizeScalar($Key);
            if ( ref $Structure->{$Key} ) {
                $Sanitized{$SanitizedKey} = $Self->_SanitizeStructure( $Structure->{$Key} );
            }
            else {
                $Sanitized{$SanitizedKey} = $Self->_SanitizeScalar( $Structure->{$Key} );
            }
        }
        return \%Sanitized;
    }

    if ( $Type eq 'ARRAY' ) {
        my @Sanitized;
        for my $Value (@$Structure) {
            if ( ref $Value ) {
                push @Sanitized, $Self->_SanitizeStructure($Value);
            }
            else {
                push @Sanitized, $Self->_SanitizeScalar($Value);
            }
        }
        return \@Sanitized;
    }

    return $Self->_SanitizeScalar($Structure);
}

sub _SanitizeScalar {
    my ( $Self, $Value ) = @_;

    return        if !defined $Value;
    return $Value if index( $Value, '<' ) == -1;

    $Value =~ s{
        (?:
            <script[^>]*> .*? </script> |
            \s*on\w+\s*=\s*[^\s>]+      |
            javascript:                 |
            (?: eval|document\.(?: cookie | write | domain ))
        )
    }{}xmsgi;

    return $Value;
}

=head2 CreateUUIDString()

Returns a new UUID in text form, or undef if there was an error. Any arguments
are passed through to Data::UUID::create_str(). Unlike Data::UUID, hex digits
are lowercased to conform to RFC4122.

=cut

sub CreateUUIDString {
    my ( $Self, @Param ) = @_;

    # Create a Data::UUID object on demand and cache it for performance reasons.
    # Init of Data::UUID takes a long time.
    $Self->{DataUUID} //= Data::UUID->new();
    return if !$Self->{DataUUID};

    return lc $Self->{DataUUID}->create_str(@Param);
}

1;
