diff --git a/meta-oe/recipes-devtools/perl/libdbi-perl/CVE-2026-78030.patch b/meta-oe/recipes-devtools/perl/libdbi-perl/CVE-2026-78030.patch new file mode 100644 index 0000000000..5a2fbf9a4b --- /dev/null +++ b/meta-oe/recipes-devtools/perl/libdbi-perl/CVE-2026-78030.patch @@ -0,0 +1,268 @@ +From 315c6ce703b8b3cbe9188062d9ec80730293554a Mon Sep 17 00:00:00 2001 +From: Robert Rothenberg +Date: Sat, 22 Aug 2026 01:37:15 +0100 +Subject: [PATCH] Load serializer class using Module::Load (CVE-2026-78030) + +This replaces calls to require with Module::Load, and adds specific +checks that arguments are module names instead of filenames. + +Instead of using our own regex matcher, we attempt to use the +Params::Util _CLASS function. The style of trying to import it or adding +our own is based on similar code in DBD::File. (This uses SPDX +annotations to indicate where the code comes from.) + +This also adds a suggestion for Params::Util in Makefile.PL. + +Note that code of the form + + $INC{"$tie_type.pm"} or require "$tie_type.pm" + +is redundant, since require checks %INC. + +See also the similar vulnerability to the DBI::Profile vulnerability +CVE-2026-14380 in commit b73d5d9901767fc1d16b6661ef08fbed4532e259. + +CVE: CVE-2026-78030 +Upstream-Status: Backport [https://github.com/perl5-dbi/dbi/commit/315c6ce703b8b3cbe9188062d9ec80730293554a] + +Assisted-By: Claude Opus 5 (1M context) + +Signed-off-by: Robert Rothenberg +Signed-off-by: Darsh Kelaiya +--- + MANIFEST | 1 + + Makefile.PL | 1 + + lib/DBD/DBM.pm | 34 ++++++++++--- + t/53dbm_module_name.t | 115 ++++++++++++++++++++++++++++++++++++++++++ + 4 files changed, 144 insertions(+), 7 deletions(-) + create mode 100644 t/53dbm_module_name.t + +diff --git a/MANIFEST b/MANIFEST +index 23858dc..d7f8e4e 100644 +--- a/MANIFEST ++++ b/MANIFEST +@@ -107,6 +107,7 @@ t/49dbd_file.t DBD::File API and very basic tests + t/50dbm_simple.t simple DBD::DBM tests + t/51dbm_file.t extended DBD::File tests (through DBD::DBM) + t/52dbm_complex.t Complex DBD::DBM tests with SQL::Statement ++t/53dbm_module_name.t dbm_type / dbm_mldbm must name a module, not a path + t/53sqlengine_adv.t + t/54_dbd_mem.t + t/60preparse.t +diff --git a/Makefile.PL b/Makefile.PL +index 3bba048..2ad475a 100644 +--- a/Makefile.PL ++++ b/Makefile.PL +@@ -76,6 +76,7 @@ my %opts = ( + suggests => { + "RPC::PlServer" => 0.2020, + "Net::Daemon" => 0, ++ "Params::Util" => '1.100', + "SQL::Statement" => 1.414, + "Clone" => 0.47, + "MLDBM" => 0, +diff --git a/lib/DBD/DBM.pm b/lib/DBD/DBM.pm +index f77e98a..26b1497 100644 +--- a/lib/DBD/DBM.pm ++++ b/lib/DBD/DBM.pm +@@ -59,6 +59,21 @@ sub CLONE + undef $drh; + } + ++if (eval { require Params::Util; }) { ++ Params::Util->import ("_CLASS"); ++} else { ++ # SPDX-SnippetBegin ++ # SPDX-SnippetCopyrightText: 2005-2012 Adam Kennedy. 2020 Jens Rehsack. ++ # SPDX-License-Identifier: Artistic-1.0-Perl ++ # SPDX-PackageName: pkg:cpan/Params-Util@1.102 ++ # SPDX-Description: taken from Params::Util::PP 1.102 ++ *_CLASS = sub { ++ my $arg = $_[0]; ++ return (defined $arg and not ref $arg and $arg =~ m/^[^\W\d]\w*(?:::\w+)*\z/s) ? $arg : undef; ++ }; ++ # SPDX-SnippetEnd ++} ++ + ##################### + package DBD::DBM::dr; + ##################### +@@ -77,7 +92,8 @@ package DBD::DBM::db; + our $imp_data_size = 0; + our @ISA = qw(DBD::File::db); + +-use Carp qw/carp/; ++use Carp; ++use Module::Load (); + + sub validate_STORE_attr + { +@@ -189,10 +205,9 @@ sub get_dbm_versions + }; + eval { + my $ser_class = "MLDBM::Serializer::" . $meta->{dbm_mldbm}; +- my $ser_mod = $ser_class; +- $ser_mod =~ s|::|/|g; +- $ser_mod .= ".pm"; +- require $ser_mod; ++ DBD::DBM::_CLASS($ser_class) ++ or croak "Invalid dbm_mldbm '$ser_class': expected a module name"; ++ Module::Load::load $ser_class; + $dver = $ser_class->VERSION(); + $dtype .= ' + ' . $ser_class; # (*) + $dver and $dtype .= " ($dver)"; # (*) +@@ -253,6 +268,7 @@ package DBD::DBM::Table; + ######################## + use Carp; + use Fcntl; ++use Module::Load (); + + our @ISA = qw(DBD::File::Table); + +@@ -318,12 +334,14 @@ sub init_table_meta + unless ( defined( $meta->{dbm_tietype} ) ) + { + my $tie_type = $meta->{dbm_type}; +- $INC{"$tie_type.pm"} or require "$tie_type.pm"; ++ DBD::DBM::_CLASS($tie_type) ++ or croak "Invalid dbm_type '$tie_type': expected a module name"; ++ Module::Load::load $tie_type; + $tie_type eq 'BerkeleyDB' and $tie_type = 'BerkeleyDB::Hash'; + + if ( $meta->{dbm_mldbm} ) + { +- $INC{"MLDBM.pm"} or require "MLDBM.pm"; ++ Module::Load::load "MLDBM"; + $meta->{dbm_usedb} = $tie_type; + $tie_type = 'MLDBM'; + } +@@ -389,6 +407,8 @@ sub open_data + { + $MLDBM::UseDB = $meta->{dbm_usedb}; + $MLDBM::Serializer = $meta->{dbm_mldbm}; ++ DBD::DBM::_CLASS($MLDBM::Serializer) ++ or croak "Invalid dbm_mldbm '${MLDBM::Serializer}': expected a module name"; + } + + $meta->{hash} = {}; +diff --git a/t/53dbm_module_name.t b/t/53dbm_module_name.t +new file mode 100644 +index 0000000..e331fa4 +--- /dev/null ++++ b/t/53dbm_module_name.t +@@ -0,0 +1,115 @@ ++#!perl -w ++# dbm_type and dbm_mldbm name a Perl module, never a file path. ++# ++# Both attributes reach require(). require() treats a path-shaped string as a ++# literal file and never consults @INC, so without a grammar check a caller ++# who influences either attribute can make the process load -- and therefore ++# execute -- a .pm from anywhere on the filesystem. ++# ++# The two "rejected" cases below fail on an unvalidated DBD::DBM: the planted ++# module gets loaded and sets the flag. The two "still works" cases pin the ++# behaviour the check must not break. ++ ++use strict; ++use warnings; ++ ++require DBD::DBM; ++ ++use DBI; ++use File::Path qw(mkpath); ++use File::Spec; ++use File::Temp qw(tempdir); ++use Test::More; ++ ++my $dir = tempdir( CLEANUP => 1 ); ++my $dbdir = File::Spec->catdir( $dir, 'db' ); ++mkpath($dbdir); ++ ++# A module planted outside @INC. Loading it is observable and can happen for ++# exactly one reason: something required this path. ++my $plant = File::Spec->catfile( $dir, 'DbmPlant.pm' ); ++open( my $fh, '>', $plant ) or plan skip_all => "cannot write $plant: $!"; ++print {$fh} "\$::DBM_PLANT_LOADED = 1;\n1;\n"; ++close($fh); ++ ++( my $plant_noext = $plant ) =~ s/\.pm\z//; ++ ++my $have_mldbm = eval { require 'MLDBM.pm'; 1 }; ++ ++# --- dbm_type must not name a path -------------------------------------- ++{ ++ local $::DBM_PLANT_LOADED = 0; ++ my $dbh = DBI->connect( "dbi:DBM:f_dir=$dbdir", undef, undef, ++ { RaiseError => 0, PrintError => 0 } ); ++ $dbh->{dbm_type} = $plant_noext; ++ eval { $dbh->do("CREATE TABLE t_reject (id INT, v CHAR(8))"); 1 }; ++ ok( !$::DBM_PLANT_LOADED, ++ "a path-shaped dbm_type does not load the file it names" ); ++ $dbh->disconnect; ++} ++ ++# The same path with its ".pm" suffix left on. This is the case a loader ++# swap alone does not cover: Module::Load treats anything outside [\w:'] as a ++# filename and requires it verbatim, so "/path/Evil" fails only because no ++# such file exists -- "/path/Evil.pm" loads. ++{ ++ local $::DBM_PLANT_LOADED = 0; ++ my $dbh = DBI->connect( "dbi:DBM:f_dir=$dbdir", undef, undef, ++ { RaiseError => 0, PrintError => 0 } ); ++ $dbh->{dbm_type} = $plant; ++ eval { $dbh->do("CREATE TABLE t_reject_pm (id INT, v CHAR(8))"); 1 }; ++ ok( !$::DBM_PLANT_LOADED, ++ "a dbm_type naming a .pm file directly does not load it" ); ++ $dbh->disconnect; ++} ++ ++# --- dbm_type still accepts a real DBM implementation ------------------- ++{ ++ my $dbh = DBI->connect( "dbi:DBM:f_dir=$dbdir;dbm_type=SDBM_File", undef, undef, ++ { RaiseError => 1, PrintError => 0 } ); ++ $dbh->do("CREATE TABLE t_ok (id INT, v CHAR(8))"); ++ $dbh->do("INSERT INTO t_ok VALUES (1, 'hello')"); ++ my ($v) = $dbh->selectrow_array("SELECT v FROM t_ok WHERE id = 1"); ++ is( $v, 'hello', "dbm_type=SDBM_File still round-trips a row" ); ++ $dbh->disconnect; ++} ++ ++# --- dbm_mldbm must not escape the MLDBM::Serializer:: prefix ------------ ++SKIP: { ++ skip "MLDBM not installed", 1 unless $have_mldbm; ++ ++ # "MLDBM::Serializer::" only looks like containment. s|::|/|g rewrites ++ # "::" and leaves a literal "/" alone, and MLDBM ships MLDBM/Serializer/ ++ # into @INC, so every component of a traversal out of it exists. ++ my ($inc) = grep { -d File::Spec->catdir( $_, 'MLDBM', 'Serializer' ) } @INC; ++ skip "no \@INC entry holds MLDBM/Serializer/", 1 unless defined $inc; ++ ++ my @up = File::Spec->splitdir( File::Spec->canonpath($inc) ); ++ shift(@up) while ( @up && $up[0] eq '' ); ++ my $escape = ( '../' x ( scalar(@up) + 2 ) ) . substr( $plant_noext, 1 ); ++ ++ local $::DBM_PLANT_LOADED = 0; ++ my $dbh = DBI->connect( "dbi:DBM:f_dir=$dbdir;dbm_type=SDBM_File", undef, undef, ++ { RaiseError => 0, PrintError => 0, ++ dbm_mldbm => $escape } ); ++ eval { ++ $dbh->do("CREATE TABLE t_ser (id INT, v CHAR(8))"); ++ $dbh->func( 't_ser', 'dbm_versions' ); ++ 1; ++ }; ++ ok( !$::DBM_PLANT_LOADED, ++ "a dbm_mldbm that traverses out of MLDBM::Serializer:: does not load the file it names" ); ++ $dbh->disconnect; ++} ++ ++# --- dbm_mldbm still accepts a real serializer name --------------------- ++{ ++ my $dbh = DBI->connect( "dbi:DBM:f_dir=$dbdir;dbm_type=SDBM_File", undef, undef, ++ { RaiseError => 0, PrintError => 0 } ); ++ my $versions = eval { $dbh->func( 'dbm_versions' ) }; ++ ok( defined $versions && length $versions, ++ "dbm_versions() still reports for an unmodified handle" ); ++ $dbh->disconnect; ++} ++ ++done_testing; diff --git a/meta-oe/recipes-devtools/perl/libdbi-perl_1.647.bb b/meta-oe/recipes-devtools/perl/libdbi-perl_1.647.bb index 03be7eabea..e2760d84d5 100644 --- a/meta-oe/recipes-devtools/perl/libdbi-perl_1.647.bb +++ b/meta-oe/recipes-devtools/perl/libdbi-perl_1.647.bb @@ -20,6 +20,7 @@ SRC_URI = "${CPAN_MIRROR}/authors/id/H/HM/HMBRAND/DBI-${PV}.tgz \ file://CVE-2026-73194_p3.patch \ file://CVE-2026-73193_p1.patch \ file://CVE-2026-73193_p2.patch \ + file://CVE-2026-78030.patch \ " SRC_URI[sha256sum] = "0df16af8e5b3225a68b7b592ab531004ddb35a9682b50300ce50174ad867d9aa"