diff --git a/SOURCES/perl-5.16.3-Destroy-GDBM-NDBM-ODBM-SDBM-_File-objects-only-from-.patch b/SOURCES/perl-5.16.3-Destroy-GDBM-NDBM-ODBM-SDBM-_File-objects-only-from-.patch new file mode 100644 index 0000000..3fdae3e --- /dev/null +++ b/SOURCES/perl-5.16.3-Destroy-GDBM-NDBM-ODBM-SDBM-_File-objects-only-from-.patch @@ -0,0 +1,233 @@ +From d309a2f4f975429871da44c33b83e651be0dc83e Mon Sep 17 00:00:00 2001 +From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= +Date: Fri, 6 Jun 2014 14:31:59 +0200 +Subject: [PATCH] Destroy {GDBM,NDBM,ODBM,SDBM}_File objects only from original + thread context +MIME-Version: 1.0 +Content-Type: text/plain; charset=UTF-8 +Content-Transfer-Encoding: 8bit + +This patch fixes a crash when destroing a hash tied to a *_File +database after spawning a thread: + +use Fcntl; +use SDBM_File; +use threads; +tie(my %dbtest, 'SDBM_File', "test.db", O_RDWR|O_CREAT, 0666); +threads->new(sub {})->join; + +This crashed or paniced depending on how perl was configured. + +Closes RT#61912. + +Signed-off-by: Petr Písař +--- + ext/GDBM_File/GDBM_File.xs | 16 ++++++++++------ + ext/NDBM_File/NDBM_File.xs | 16 ++++++++++------ + ext/ODBM_File/ODBM_File.xs | 18 +++++++++++------- + ext/SDBM_File/SDBM_File.xs | 4 +++- + t/lib/dbmt_common.pl | 35 +++++++++++++++++++++++++++++++++++ + 5 files changed, 69 insertions(+), 20 deletions(-) + +diff --git a/ext/GDBM_File/GDBM_File.xs b/ext/GDBM_File/GDBM_File.xs +index afb361c..e7a3808 100644 +--- a/ext/GDBM_File/GDBM_File.xs ++++ b/ext/GDBM_File/GDBM_File.xs +@@ -13,6 +13,7 @@ + #define store_value 3 + + typedef struct { ++ tTHX owner; + GDBM_FILE dbp ; + SV * filter[4]; + int filtering ; +@@ -78,6 +79,7 @@ gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func = (FATALFUNC)croak) + RETVAL = NULL ; + if ((dbp = gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode, fatal_func))) { + RETVAL = (GDBM_File)safecalloc(1, sizeof(GDBM_File_type)) ; ++ RETVAL->owner = aTHX; + RETVAL->dbp = dbp ; + } + +@@ -98,12 +100,14 @@ gdbm_DESTROY(db) + PREINIT: + int i = store_value; + CODE: +- gdbm_close(db); +- do { +- if (db->filter[i]) +- SvREFCNT_dec(db->filter[i]); +- } while (i-- > 0); +- safefree(db); ++ if (db && db->owner == aTHX) { ++ gdbm_close(db); ++ do { ++ if (db->filter[i]) ++ SvREFCNT_dec(db->filter[i]); ++ } while (i-- > 0); ++ safefree(db); ++ } + + #define gdbm_FETCH(db,key) gdbm_fetch(db->dbp,key) + datum_value +diff --git a/ext/NDBM_File/NDBM_File.xs b/ext/NDBM_File/NDBM_File.xs +index 52e60fc..af223e5 100644 +--- a/ext/NDBM_File/NDBM_File.xs ++++ b/ext/NDBM_File/NDBM_File.xs +@@ -33,6 +33,7 @@ END_EXTERN_C + #define store_value 3 + + typedef struct { ++ tTHX owner; + DBM * dbp ; + SV * filter[4]; + int filtering ; +@@ -71,6 +72,7 @@ ndbm_TIEHASH(dbtype, filename, flags, mode) + RETVAL = NULL ; + if ((dbp = dbm_open(filename, flags, mode))) { + RETVAL = (NDBM_File)safecalloc(1, sizeof(NDBM_File_type)); ++ RETVAL->owner = aTHX; + RETVAL->dbp = dbp ; + } + +@@ -84,12 +86,14 @@ ndbm_DESTROY(db) + PREINIT: + int i = store_value; + CODE: +- dbm_close(db->dbp); +- do { +- if (db->filter[i]) +- SvREFCNT_dec(db->filter[i]); +- } while (i-- > 0); +- safefree(db); ++ if (db && db->owner == aTHX) { ++ dbm_close(db->dbp); ++ do { ++ if (db->filter[i]) ++ SvREFCNT_dec(db->filter[i]); ++ } while (i-- > 0); ++ safefree(db); ++ } + + #define ndbm_FETCH(db,key) dbm_fetch(db->dbp,key) + datum_value +diff --git a/ext/ODBM_File/ODBM_File.xs b/ext/ODBM_File/ODBM_File.xs +index d1ece7f..f7e00a0 100644 +--- a/ext/ODBM_File/ODBM_File.xs ++++ b/ext/ODBM_File/ODBM_File.xs +@@ -45,6 +45,7 @@ datum nextkey(datum key); + #define store_value 3 + + typedef struct { ++ tTHX owner; + void * dbp ; + SV * filter[4]; + int filtering ; +@@ -112,6 +113,7 @@ odbm_TIEHASH(dbtype, filename, flags, mode) + } + dbp = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0); + RETVAL = (ODBM_File)safecalloc(1, sizeof(ODBM_File_type)); ++ RETVAL->owner = aTHX; + RETVAL->dbp = dbp ; + } + OUTPUT: +@@ -124,13 +126,15 @@ DESTROY(db) + dMY_CXT; + int i = store_value; + CODE: +- dbmrefcnt--; +- dbmclose(); +- do { +- if (db->filter[i]) +- SvREFCNT_dec(db->filter[i]); +- } while (i-- > 0); +- safefree(db); ++ if (db && db->owner == aTHX) { ++ dbmrefcnt--; ++ dbmclose(); ++ do { ++ if (db->filter[i]) ++ SvREFCNT_dec(db->filter[i]); ++ } while (i-- > 0); ++ safefree(db); ++ } + + datum_value + odbm_FETCH(db, key) +diff --git a/ext/SDBM_File/SDBM_File.xs b/ext/SDBM_File/SDBM_File.xs +index 291e41b..0bdae9a 100644 +--- a/ext/SDBM_File/SDBM_File.xs ++++ b/ext/SDBM_File/SDBM_File.xs +@@ -10,6 +10,7 @@ + #define store_value 3 + + typedef struct { ++ tTHX owner; + DBM * dbp ; + SV * filter[4]; + int filtering ; +@@ -43,6 +44,7 @@ sdbm_TIEHASH(dbtype, filename, flags, mode) + RETVAL = NULL ; + if ((dbp = sdbm_open(filename,flags,mode))) { + RETVAL = (SDBM_File)safecalloc(1, sizeof(SDBM_File_type)); ++ RETVAL->owner = aTHX; + RETVAL->dbp = dbp ; + } + +@@ -54,7 +56,7 @@ void + sdbm_DESTROY(db) + SDBM_File db + CODE: +- if (db) { ++ if (db && db->owner == aTHX) { + int i = store_value; + sdbm_close(db->dbp); + do { +diff --git a/t/lib/dbmt_common.pl b/t/lib/dbmt_common.pl +index 5d4098c..a0a4d52 100644 +--- a/t/lib/dbmt_common.pl ++++ b/t/lib/dbmt_common.pl +@@ -511,5 +511,40 @@ unlink , $Dfile; + unlink ; + } + ++{ ++ # Check DBM back-ends do not destroy objects from then-spawned threads. ++ # RT#61912. ++ SKIP: { ++ my $threads_count = 2; ++ skip 'Threads are disabled', 3 + 2 * $threads_count ++ unless $Config{usethreads}; ++ use_ok('threads'); ++ ++ my %h; ++ unlink ; ++ ++ my $db = tie %h, $DBM_Class, 'Op1_dbmx', $create, 0640; ++ isa_ok($db, $DBM_Class); ++ ++ for (1 .. 2) { ++ ok(threads->create( ++ sub { ++ $SIG{'__WARN__'} = sub { fail(shift) }; # debugging perl panics ++ # report it by spurious TAP line ++ 1; ++ }), "Thread $_ created"); ++ } ++ for (threads->list) { ++ is($_->join, 1, "A thread exited successfully"); ++ } ++ ++ pass("Tied object survived exiting threads"); ++ ++ undef $db; ++ untie %h; ++ unlink ; ++ } ++} ++ + done_testing(); + 1; +-- +1.9.3 + diff --git a/SOURCES/perl-5.16.3-t-op-taint.t-Perform-SHA-256-algorithm-by-crypt-if-d.patch b/SOURCES/perl-5.16.3-t-op-taint.t-Perform-SHA-256-algorithm-by-crypt-if-d.patch new file mode 100644 index 0000000..2948fc3 --- /dev/null +++ b/SOURCES/perl-5.16.3-t-op-taint.t-Perform-SHA-256-algorithm-by-crypt-if-d.patch @@ -0,0 +1,51 @@ +From 5984f005f7a08feca52509658cff1c56d768e057 Mon Sep 17 00:00:00 2001 +From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= +Date: Mon, 1 Dec 2014 15:28:36 +0100 +Subject: [PATCH] t/op/taint.t: Perform SHA-256 algorithm by crypt() if default + one is disabled +MIME-Version: 1.0 +Content-Type: text/plain; charset=UTF-8 +Content-Transfer-Encoding: 8bit + +The crypt(3) call may return NULL. This is the case on FIPS-enabled +platforms. Then "tainted crypt" test would fail. + +See RT#121591 for similar fix in t/op/crypt.t. + +Signed-off-by: Petr Písař + +Petr Pisar: Ported to 5.16.3. + +Signed-off-by: Petr Písař +--- + t/op/taint.t | 14 +++++++++++++- + 1 file changed, 13 insertions(+), 1 deletion(-) + +diff --git a/t/op/taint.t b/t/op/taint.t +index 9cea740..478e574 100644 +--- a/t/op/taint.t ++++ b/t/op/taint.t +@@ -1868,7 +1868,19 @@ foreach my $ord (78, 163, 256) { + + { + # 59998 +- sub cr { my $x = crypt($_[0], $_[1]); $x } ++ sub cr { ++ # On platforms implementing FIPS mode, using a weak algorithm ++ # (including the default triple-DES algorithm) causes crypt(3) to ++ # return a null pointer, which Perl converts into undef. We assume ++ # for now that all such platforms support glibc-style selection of ++ # a different hashing algorithm. ++ my $alg = ''; # Use default algorithm ++ if ( !defined(crypt("ab", "cd")) ) { ++ $alg = '$5$'; # Use SHA-256 ++ } ++ my $x = crypt($_[0], $alg . $_[1]); ++ $x ++ } + sub co { my $x = ~$_[0]; $x } + my ($a, $b); + $a = cr('hello', 'foo' . $TAINT); +-- +1.9.3 + diff --git a/SOURCES/perl-5.18.2-t-op-crypt.t-Perform-SHA-256-algorithm-if-default-on.patch b/SOURCES/perl-5.18.2-t-op-crypt.t-Perform-SHA-256-algorithm-if-default-on.patch new file mode 100644 index 0000000..c6480ee --- /dev/null +++ b/SOURCES/perl-5.18.2-t-op-crypt.t-Perform-SHA-256-algorithm-if-default-on.patch @@ -0,0 +1,54 @@ +From 8de0fd45cde4826951842f80b6ce109988d47f4f Mon Sep 17 00:00:00 2001 +From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= +Date: Mon, 7 Apr 2014 12:31:28 +0200 +Subject: [PATCH] t/op/crypt.t: Perform SHA-256 algorithm if default one is + disabled +MIME-Version: 1.0 +Content-Type: text/plain; charset=UTF-8 +Content-Transfer-Encoding: 8bit + +The crypt(3) call may return NULL. This is the case of FIPS-enabled +platforms. Then "salt makes a difference" test would fail. + +Signed-off-by: Petr Písař +--- + t/op/crypt.t | 14 ++++++++++---- + 1 file changed, 10 insertions(+), 4 deletions(-) + +diff --git a/t/op/crypt.t b/t/op/crypt.t +index 27c878f..6c43992 100644 +--- a/t/op/crypt.t ++++ b/t/op/crypt.t +@@ -28,19 +28,25 @@ BEGIN { + # bets, given alternative encryption/hashing schemes like MD5, + # C2 (or higher) security schemes, and non-UNIX platforms. + ++# Platforms implementing FIPS mode return undef on weak crypto algorithms. ++my $alg = ''; # Use default algorithm ++if ( !defined(crypt("ab", "cd")) ) { ++ $alg = '$5$'; # Use SHA-256 ++} ++ + SKIP: { + skip ("VOS crypt ignores salt.", 1) if ($^O eq 'vos'); +- ok(substr(crypt("ab", "cd"), 2) ne substr(crypt("ab", "ce"), 2), "salt makes a difference"); ++ ok(substr(crypt("ab", $alg . "cd"), 2) ne substr(crypt("ab", $alg. "ce"), 2), "salt makes a difference"); + } + + $a = "a\xFF\x{100}"; + +-eval {$b = crypt($a, "cd")}; ++eval {$b = crypt($a, $alg . "cd")}; + like($@, qr/Wide character in crypt/, "wide characters ungood"); + + chop $a; # throw away the wide character + +-eval {$b = crypt($a, "cd")}; ++eval {$b = crypt($a, $alg . "cd")}; + is($@, '', "downgrade to eight bit characters"); +-is($b, crypt("a\xFF", "cd"), "downgrade results agree"); ++is($b, crypt("a\xFF", $alg . "cd"), "downgrade results agree"); + +-- +1.9.0 + diff --git a/SPECS/perl.spec b/SPECS/perl.spec index f60cecb..9b0b5e4 100644 --- a/SPECS/perl.spec +++ b/SPECS/perl.spec @@ -3,7 +3,7 @@ %global perl_arch_stem -thread-multi %global perl_archname %{_arch}-%{_os}%{perl_arch_stem} -%global multilib_64_archs aarch64 ppc64 s390x sparc64 x86_64 +%global multilib_64_archs aarch64 %{power64} s390x sparc64 x86_64 %global parallel_tests 1 %global tapsetdir %{_datadir}/systemtap/tapset @@ -31,7 +31,7 @@ Name: perl Version: %{perl_version} # release number must be even higher, because dual-lived modules will be broken otherwise -Release: 283%{?dist} +Release: 285%{?dist} Epoch: %{perl_epoch} Summary: Practical Extraction and Report Language Group: Development/Languages @@ -136,6 +136,16 @@ Patch28: perl-5.16.3-Synchronize-pod2html-usage-output-and-its-POD-text.p # CPAN RT#85015 Patch29: perl-5.18.1-Document-Math-BigInt-CalcEmu-requires-Math-BigInt.patch +# Use stronger algorithm needed for FIPS in t/op/crypt.t, bug #1084796, +# RT#121591 +Patch30: perl-5.18.2-t-op-crypt.t-Perform-SHA-256-algorithm-if-default-on.patch + +# Make *DBM_File desctructors thread-safe, bug #1107542, RT#61912 +Patch31: perl-5.16.3-Destroy-GDBM-NDBM-ODBM-SDBM-_File-objects-only-from-.patch + +# Use stronger algorithm needed for FIPS in t/op/taint.t, bug #1084796, +# RT#123338 +Patch32: perl-5.16.3-t-op-taint.t-Perform-SHA-256-algorithm-by-crypt-if-d.patch # Update some of the bundled modules # see http://fedoraproject.org/wiki/Perl/perl.spec for instructions @@ -209,6 +219,8 @@ Provides: perl(validate.pl) Obsoletes: perl-suidperl <= 4:5.12.2 Requires: perl-libs = %{perl_epoch}:%{perl_version}-%{release} +# Time::HiRes needed by Net::Ping, bug #1122368 +Requires: perl(Time::HiRes) # We need this to break the dependency loop, and ensure that perl-libs # gets installed before perl. @@ -484,6 +496,8 @@ Version: 1.9800 Requires: perl(Data::Dumper) # CPAN encourages Digest::SHA strongly because of integrity checks Requires: perl(Digest::SHA) +# local::lib recommended by CPAN::FirstTime default choice, bug #1122368 +Requires: perl(local::lib) Requires: %perl_compat Provides: cpan = %{version} BuildArch: noarch @@ -1945,6 +1959,9 @@ tarball from perl.org. %patch27 -p1 %patch28 -p1 %patch29 -p1 +%patch30 -p1 +%patch31 -p1 +%patch32 -p1 %if !%{defined perl_bootstrap} # Local patch tracking @@ -1976,6 +1993,9 @@ perl -x patchlevel.h \ 'Fedora Patch27: Update h2ph(1) documentation (RT#117647)' \ 'Fedora Patch28: Update pod2html(1) documentation (RT#117623)' \ 'Fedora Patch29: Document Math::BigInt::CalcEmu requires Math::BigInt (CPAN RT#85015)' \ + 'RHEL Patch30: Use stronger algorithm needed for FIPS in t/op/crypt.t (RT#121591)' \ + 'RHEL Patch31: Make *DBM_File desctructors thread-safe (RT#61912)' \ + 'RHEL Patch32: Use stronger algorithm needed for FIPS in t/op/taint.t (RT#123338)' \ %{nil} %endif @@ -3658,6 +3678,15 @@ sed \ # Old changelog entries are preserved in CVS. %changelog +* Mon Dec 01 2014 Petr Pisar - 4:5.16.3-285 +- Use stronger algorithm needed for FIPS in t/op/taint.t (bug #1084796) + +* Fri Aug 08 2014 Petr Pisar - 4:5.16.3-284 +- Use a macro to cover all 64-bit PowerPC architectures (bug #1061792) +- Declare dependencies for cpan tool (bug #1122368) +- Use stronger algorithm needed for FIPS in t/op/crypt.t (bug #1084796) +- Make *DBM_File desctructors thread-safe (bug #1107542) + * Fri Jan 24 2014 Daniel Mach - 4:5.16.3-283 - Mass rebuild 2014-01-24