From d0b5d43d81f0826ca371e69bbdac8fce55741d58 Mon Sep 17 00:00:00 2001 From: bernhard Date: Tue, 15 Aug 2023 12:43:37 +0200 Subject: [PATCH 1/3] Issue #2464: require YAML::XS 0.62 Because this was the current version when Perl 5.24 was released --- bin/otobo.CheckModules.pl | 9 +++++---- cpanfile | 4 ++-- cpanfile.docker | 4 ++-- 3 files changed, 9 insertions(+), 8 deletions(-) diff --git a/bin/otobo.CheckModules.pl b/bin/otobo.CheckModules.pl index a6fe6f2f4f..0f044375d3 100755 --- a/bin/otobo.CheckModules.pl +++ b/bin/otobo.CheckModules.pl @@ -586,10 +586,11 @@ =head1 DESCRIPTION }, }, { - Module => 'YAML::XS', - Required => 1, - Comment => 'Required for fast YAML processing.', - InstTypes => { + Module => 'YAML::XS', + Required => 1, + VersionRequired => '0.62', + Comment => 'Required for fast and correct YAML processing.', + InstTypes => { aptget => 'libyaml-libyaml-perl', emerge => 'dev-perl/YAML-LibYAML', zypper => 'perl-YAML-LibYAML', diff --git a/cpanfile b/cpanfile index f527cc62ca..168fa2377f 100644 --- a/cpanfile +++ b/cpanfile @@ -71,8 +71,8 @@ requires 'URI'; # Required for XML processing. requires 'XML::LibXML'; -# Required for fast YAML processing. -requires 'YAML::XS'; +# Required for fast and correct YAML processing. +requires 'YAML::XS', ">= 0.62"; # For internationalised sorting requires 'Unicode::Collate'; diff --git a/cpanfile.docker b/cpanfile.docker index c226006913..e2afc74ddb 100644 --- a/cpanfile.docker +++ b/cpanfile.docker @@ -71,8 +71,8 @@ requires 'URI'; # Required for XML processing. requires 'XML::LibXML'; -# Required for fast YAML processing. -requires 'YAML::XS'; +# Required for fast and correct YAML processing. +requires 'YAML::XS', ">= 0.62"; # For internationalised sorting requires 'Unicode::Collate'; From 76adabc5a7ad66aa2a326c2b5f12d431ba6ca536 Mon Sep 17 00:00:00 2001 From: bernhard Date: Tue, 15 Aug 2023 15:42:02 +0200 Subject: [PATCH 2/3] Issue #2464: use only YAML::XS for loading Thus eliminate usage of YAML::Any and the fallback to YAML.pm. Thus some code for special support of YAML.pm can be eliminated too. --- Kernel/System/YAML.pm | 101 +++++---------------------------------- scripts/test/YAML/YAML.t | 54 +++++++++------------ 2 files changed, 35 insertions(+), 120 deletions(-) diff --git a/Kernel/System/YAML.pm b/Kernel/System/YAML.pm index 7bba46ec2b..fb3086607b 100644 --- a/Kernel/System/YAML.pm +++ b/Kernel/System/YAML.pm @@ -19,9 +19,11 @@ package Kernel::System::YAML; use strict; use warnings; +# core modules use Encode qw(); -use YAML::Any qw(); -use YAML qw(); + +# CPAN modules +use YAML::XS qw(); our @ObjectDependencies = ( 'Kernel::System::Log', @@ -48,10 +50,7 @@ sub new { my ( $Type, %Param ) = @_; # allocate new hash for object - my $Self = {}; - bless( $Self, $Type ); - - return $Self; + return bless {}, $Type; } =head2 Dump() @@ -73,15 +72,16 @@ sub Dump { Priority => 'error', Message => 'Need Data!', ); + return; } - my $Result = YAML::Any::Dump( $Param{Data} ) || "--- ''\n"; + my $String = YAML::XS::Dump( $Param{Data} ) || "--- ''\n"; # Make sure the resulting string has the UTF-8 flag. Encode::_utf8_on($Result); - return $Result; + return $String; } =head2 Load() @@ -99,7 +99,7 @@ sub Load { my ( $Self, %Param ) = @_; # check for needed data - return if !defined $Param{Data}; + return unless defined $Param{Data}; if ( Encode::is_utf8( $Param{Data} ) ) { Encode::_utf8_off( $Param{Data} ); @@ -117,11 +117,7 @@ sub Load { } my $Result; - - # get used YAML implementation - my $YAMLImplementation = YAML::Any->implementation(); - - if ( !eval { $Result = YAML::Any::Load( $Param{Data} ) } ) { + if ( !eval { $Result = YAML::XS::Load( $Param{Data} ) } ) { $Kernel::OM->Get('Kernel::System::Log')->Log( Priority => 'error', Message => 'Loading the YAML string failed: ' . $@, @@ -132,84 +128,13 @@ sub Load { } $Kernel::OM->Get('Kernel::System::Log')->Log( Priority => 'error', - Message => 'YAML data was: "' . $DumpString . '"', - ); - - # if used implementation is pure perl YAML there is nothing to do, but exit with error - return if $YAMLImplementation eq 'YAML'; - - # otherwise use pure-perl YAML as fallback if YAML::XS or other can't parse the data - # structure correctly - if ( !eval { $Result = YAML::Load( $Param{Data} ) } ) { - $Kernel::OM->Get('Kernel::System::Log')->Log( - Priority => 'error', - Message => 'YAML data was not readable even by pure-perl YAML module', - ); - return; - } - $Kernel::OM->Get('Kernel::System::Log')->Log( - Priority => 'error', - Message => 'Data was only readable pure-perl YAML module, please contact the' - . ' System Administrator to update this record, as the stored data is still in a' - . ' wrong format!', + Message => qq{YAML data was: "$DumpString"}, ); } - # YAML does not set the UTF8 flag on strings that need it, do that manually now. - if ( $YAMLImplementation eq 'YAML' && defined $Result ) { - _AddUTF8Flag( \$Result ); - } - + # The resulting data structure may contain strings + # that are internally encoded in latin1. return $Result; } -=begin Internal: - -=head2 _AddUTF8Flag() - -adds the UTF8 flag to all elements in a complex data structure. - -=cut - -sub _AddUTF8Flag { - my ($Data) = @_; - - if ( !ref ${$Data} ) { - Encode::_utf8_on( ${$Data} ); - return; - } - - if ( ref ${$Data} eq 'SCALAR' ) { - return _AddUTF8Flag( ${$Data} ); - } - - if ( ref ${$Data} eq 'HASH' ) { - KEY: - for my $Key ( sort keys %{ ${$Data} } ) { - next KEY if !defined ${$Data}->{$Key}; - _AddUTF8Flag( \${$Data}->{$Key} ); - } - return; - } - - if ( ref ${$Data} eq 'ARRAY' ) { - KEY: - for my $Key ( 0 .. $#{ ${$Data} } ) { - next KEY if !defined ${$Data}->[$Key]; - _AddUTF8Flag( \${$Data}->[$Key] ); - } - return; - } - - if ( ref ${$Data} eq 'REF' ) { - return _AddUTF8Flag( ${$Data} ); - } - - return; -} - -=end Internal: - -=cut - 1; diff --git a/scripts/test/YAML/YAML.t b/scripts/test/YAML/YAML.t index d42f834f79..5847b9a24c 100644 --- a/scripts/test/YAML/YAML.t +++ b/scripts/test/YAML/YAML.t @@ -18,13 +18,14 @@ use strict; use warnings; use utf8; -# Set up the test driver $Self when we are running as a standalone script. -use Kernel::System::UnitTest::RegisterDriver; +# core modules -our $Self; +# CPAN modules +use Test2::V0; +use YAML::XS qw(); -# get YAML object -my $YAMLObject = $Kernel::OM->Get('Kernel::System::YAML'); +# OTOBO modules +use Kernel::System::UnitTest::RegisterOM; # set up $Kernel::OM my @Tests = ( { @@ -79,7 +80,6 @@ my @Tests = ( { Name => 'Very long string', # see https://bugzilla.redhat.com/show_bug.cgi?id=192400 Data => ' äø<>"\'' x 40_000, - SkipEngine => 'YAML', # This test does not run with plain YAML, see the bug above SuccessDecode => 1, }, { @@ -183,34 +183,24 @@ my @Tests = ( }, ); -ENGINE: -for my $Engine (qw(YAML::XS YAML)) { +for my $Test (@Tests) { - # locally override the internal engine of YAML::Any to force testing - local @YAML::Any::_TEST_ORDER = ($Engine); + my $YAMLString = $Test->{YAMLString} || YAML::XS::Dump( Data => $Test->{Data} ); + my $YAMLData = YAML::XS::Load( Data => $YAMLString ); - TEST: - for my $Test (@Tests) { - - next TEST if defined $Test->{SkipEngine} && $Engine eq $Test->{SkipEngine}; - - my $YAMLString = $Test->{YAMLString} || $YAMLObject->Dump( Data => $Test->{Data} ); - my $YAMLData = $YAMLObject->Load( Data => $YAMLString ); - - if ( $Test->{SuccessDecode} ) { - $Self->IsDeeply( - $YAMLData, - $Test->{Data}, - "Engine $Engine - $Test->{Name}", - ); - } - else { - $Self->False( - $YAMLData, - "Engine $Engine - $Test->{Name}", - ); - } + if ( $Test->{SuccessDecode} ) { + is( + $YAMLData, + $Test->{Data}, + "$Test->{Name} - got expected result", + ); + } + else { + ok( + !$YAMLData, + "$Test->{Name} - failure reported", + ); } } -$Self->DoneTesting(); +done_testing; From 4b53b0ab10dc8b4ea82839effaf21875ad827be9 Mon Sep 17 00:00:00 2001 From: bernhard Date: Tue, 15 Aug 2023 15:43:50 +0200 Subject: [PATCH 3/3] Issue #2464: Avoid using private method Encode::_utf8_on() The better semantics are decoding the string and then upgrading it. --- Kernel/System/YAML.pm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/Kernel/System/YAML.pm b/Kernel/System/YAML.pm index fb3086607b..e4ea918d5d 100644 --- a/Kernel/System/YAML.pm +++ b/Kernel/System/YAML.pm @@ -78,8 +78,10 @@ sub Dump { my $String = YAML::XS::Dump( $Param{Data} ) || "--- ''\n"; - # Make sure the resulting string has the UTF-8 flag. - Encode::_utf8_on($Result); + # Tell Perl that the dumped octetts are a UTF-8 encoded string and + # that we want the internal representation to be UTF-8. + utf8::decode($String); + utf8::upgrade($String); return $String; }