Fix Term::ReadLine not to create spurious &STDERR files

2018-01-09 13:31:50 +01:00 · 2018-01-09 13:31:50 +01:00 · bc8f6a5d83
commit bc8f6a5d83
parent 88dd9e56b3
4 changed files with 266 additions and 0 deletions
--- a/perl-5.27.3-Term-ReadLine-generates-empty-STDERR-files.patch
+++ b/perl-5.27.3-Term-ReadLine-generates-empty-STDERR-files.patch
@ -0,0 +1,152 @@
+From d8b61909479178ddb668ad385988877d26f202f2 Mon Sep 17 00:00:00 2001
+From: James E Keenan <jkeenan@cpan.org>
+Date: Thu, 31 Aug 2017 22:57:06 -0400
+Subject: [PATCH] Term::ReadLine generates empty &STDERR files
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+Revert to 2-arg open in one case.
+
+If /dev/tty is inaccessible, redirecting file handles to STDERR:
+
+       open (my $fh, ">&STDERR))
+
+... cannot be done as a 3 arg open or it'll actually try to write to that
+file.
+
+Bump $Term::ReadLine::VERSION.
+Add unit test for RT #132008
+
+For: RT #132008
+(cherry picked from commit e4dc68d725b19f46c6fca9423e6e7a0eaeff47f4)
+Signed-off-by: Nicolas R <atoomic@cpan.org>
+
+xx
+
+Signed-off-by: Petr Písař <ppisar@redhat.com>
+---
+ MANIFEST                                |  1 +
+ dist/Term-ReadLine/lib/Term/ReadLine.pm | 17 +++++++++-----
+ dist/Term-ReadLine/t/ReadLine-STDERR.t  | 41 +++++++++++++++++++++++++++++++++
+ 3 files changed, 53 insertions(+), 6 deletions(-)
+ create mode 100644 dist/Term-ReadLine/t/ReadLine-STDERR.t
+
+diff --git a/MANIFEST b/MANIFEST
+index ad24a2d28b..180fd4f543 100644
+--- a/MANIFEST
+++ b/MANIFEST
+@@ -3669,6 +3669,7 @@ dist/Term-ReadLine/lib/Term/ReadLine.pm		Stub readline library
+ dist/Term-ReadLine/t/AE.t			See if Term::ReadLine works
+ dist/Term-ReadLine/t/AETk.t			See if Term::ReadLine works
+ dist/Term-ReadLine/t/ReadLine.t			See if Term::ReadLine works
+dist/Term-ReadLine/t/ReadLine-STDERR.t		See if Term::ReadLine works
+ dist/Term-ReadLine/t/Tk.t			See if Term::ReadLine works
+ dist/Test/lib/Test.pm		A simple framework for writing test scripts
+ dist/Test/t/05_about_verbose.t	See if Test works
+diff --git a/dist/Term-ReadLine/lib/Term/ReadLine.pm b/dist/Term-ReadLine/lib/Term/ReadLine.pm
+index 88d5a75877..e00fb376cd 100644
+--- a/dist/Term-ReadLine/lib/Term/ReadLine.pm
+++ b/dist/Term-ReadLine/lib/Term/ReadLine.pm
+@@ -229,12 +229,17 @@ sub readline {
+ }
+ sub addhistory {}
+ 
+# used for testing purpose
+sub devtty { return '/dev/tty' }
+
+ sub findConsole {
+     my $console;
+     my $consoleOUT;
+ 
+-    if ($^O ne 'MSWin32' and -e "/dev/tty") {
+-	$console = "/dev/tty";
+    my $devtty = devtty();
+
+    if ($^O ne 'MSWin32' and -e $devtty) {
+	$console = $devtty;
+     } elsif ($^O eq 'MSWin32' or $^O eq 'msys' or -e "con") {
+        $console = 'CONIN$';
+        $consoleOUT = 'CONOUT$';
+@@ -248,7 +253,7 @@ sub findConsole {
+ 
+     $consoleOUT = $console unless defined $consoleOUT;
+     $console = "&STDIN" unless defined $console;
+-    if ($console eq "/dev/tty" && !open(my $fh, "<", $console)) {
+    if ($console eq $devtty && !open(my $fh, "<", $console)) {
+       $console = "&STDIN";
+       undef($consoleOUT);
+     }
+@@ -266,11 +271,11 @@ sub new {
+   if (@_==2) {
+     my($console, $consoleOUT) = $_[0]->findConsole;
+ 
+-
+     # the Windows CONIN$ needs GENERIC_WRITE mode to allow
+     # a SetConsoleMode() if we end up using Term::ReadKey
+     open FIN, (( $^O eq 'MSWin32' && $console eq 'CONIN$' ) ? '+<' : '<' ), $console;
+-    open FOUT,'>', $consoleOUT;
+    # RT #132008:  Still need 2-arg open here
+    open FOUT,">$consoleOUT";
+ 
+     #OUT->autoflush(1);		# Conflicts with debugger?
+     my $sel = select(FOUT);
+@@ -319,7 +324,7 @@ sub Features { \%features }
+ 
+ package Term::ReadLine;		# So late to allow the above code be defined?
+ 
+-our $VERSION = '1.16';
+our $VERSION = '1.17';
+ 
+ my ($which) = exists $ENV{PERL_RL} ? split /\s+/, $ENV{PERL_RL} : undef;
+ if ($which) {
+diff --git a/dist/Term-ReadLine/t/ReadLine-STDERR.t b/dist/Term-ReadLine/t/ReadLine-STDERR.t
+new file mode 100644
+index 0000000000..f7aa2df925
+--- /dev/null
+++ b/dist/Term-ReadLine/t/ReadLine-STDERR.t
+@@ -0,0 +1,41 @@
+#!./perl -w
+use strict;
+
+use Test::More;
+
+## unit test for RT 132008 - https://rt.perl.org/Ticket/Display.html?id=132008
+
+if ( $^O eq 'MSWin32' || !-e q{/dev/tty} ) {
+    plan skip_all => "Test not tested on windows or when /dev/tty do not exists";
+}
+else {
+    plan tests => 9;
+}
+
+if ( -e q[&STDERR] ) {
+    note q[Removing existing file &STDERR];
+    unlink q[&STDERR] or die q{Cannot remove existing file &STDERR [probably created from a previous run]};
+}
+
+use_ok('Term::ReadLine');
+can_ok( 'Term::ReadLine::Stub', qw{new devtty findConsole} );
+
+is( Term::ReadLine->devtty(), q{/dev/tty} );
+my @out = Term::ReadLine::Stub::findConsole();
+is_deeply \@out, [ q{/dev/tty}, q{/dev/tty} ], "findConsole is using /dev/tty";
+
+{
+    no warnings 'redefine';
+    my $donotexist = q[/this/should/not/exist/hopefully];
+
+    ok !-e $donotexist, "File $donotexist does not exist";
+    local *Term::ReadLine::Stub::devtty = sub { $donotexist };
+    is( Term::ReadLine->devtty(), $donotexist, "devtty mocked" );
+
+    my @out = Term::ReadLine::Stub::findConsole();
+    is_deeply \@out, [ q{&STDIN}, q{&STDERR} ], "findConsole is using /dev/tty" or diag explain \@out;
+
+    ok !-e q[&STDERR], 'file &STDERR do not exist before Term::ReadLine call';
+    my $tr = Term::ReadLine->new('whatever');
+    ok !-e q[&STDERR], 'file &STDERR was not created by mistake';
+}
+-- 
+2.13.6
+
--- a/perl-5.27.3-perl-132008-make-sure-the-test-behaves-without-a-tty.patch
+++ b/perl-5.27.3-perl-132008-make-sure-the-test-behaves-without-a-tty.patch
@ -0,0 +1,73 @@
+From 1d217c696857b2bf41d87a7e927c43d20cc556e5 Mon Sep 17 00:00:00 2001
+From: Tony Cook <tony@develop-help.com>
+Date: Tue, 19 Sep 2017 17:40:52 +1000
+Subject: [PATCH] (perl #132008) make sure the test behaves without a tty
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+The test is intended to test how Term::ReadLine behaves without a tty
+and mocks up an invalid tty.
+
+Unfortunately some of the checks it does fail if the test starts without
+a tty.
+
+Modified the test to handle the lack of a tty.
+
+Signed-off-by: Petr Písař <ppisar@redhat.com>
+---
+ dist/Term-ReadLine/t/ReadLine-STDERR.t | 22 +++++++++++++++-------
+ 1 file changed, 15 insertions(+), 7 deletions(-)
+
+diff --git a/dist/Term-ReadLine/t/ReadLine-STDERR.t b/dist/Term-ReadLine/t/ReadLine-STDERR.t
+index f7aa2df925..2bdf799f42 100644
+--- a/dist/Term-ReadLine/t/ReadLine-STDERR.t
+++ b/dist/Term-ReadLine/t/ReadLine-STDERR.t
+@@ -6,7 +6,7 @@ use Test::More;
+ ## unit test for RT 132008 - https://rt.perl.org/Ticket/Display.html?id=132008
+ 
+ if ( $^O eq 'MSWin32' || !-e q{/dev/tty} ) {
+-    plan skip_all => "Test not tested on windows or when /dev/tty do not exists";
+    plan skip_all => "Not tested on windows or when /dev/tty does not exist";
+ }
+ else {
+     plan tests => 9;
+@@ -19,21 +19,29 @@ if ( -e q[&STDERR] ) {
+ 
+ use_ok('Term::ReadLine');
+ can_ok( 'Term::ReadLine::Stub', qw{new devtty findConsole} );
+-
+-is( Term::ReadLine->devtty(), q{/dev/tty} );
+-my @out = Term::ReadLine::Stub::findConsole();
+-is_deeply \@out, [ q{/dev/tty}, q{/dev/tty} ], "findConsole is using /dev/tty";
+is( Term::ReadLine->devtty(), q{/dev/tty}, "check sub devtty" );
+SKIP:
+{
+    open my $tty, "<",  Term::ReadLine->devtty()
+      or skip "Cannot open tty", 1;
+    -t $tty
+      or skip "No tty found, so findConsole() won't return /dev/tty", 1;
+    my @out = Term::ReadLine::Stub::findConsole();
+    is_deeply \@out, [ q{/dev/tty}, q{/dev/tty} ], "findConsole is using /dev/tty";
+}
+ 
+ {
+     no warnings 'redefine';
+     my $donotexist = q[/this/should/not/exist/hopefully];
+ 
+     ok !-e $donotexist, "File $donotexist does not exist";
+-    local *Term::ReadLine::Stub::devtty = sub { $donotexist };
+    # double mention to prevent warning
+    local *Term::ReadLine::Stub::devtty =
+      *Term::ReadLine::Stub::devtty = sub { $donotexist };
+     is( Term::ReadLine->devtty(), $donotexist, "devtty mocked" );
+ 
+     my @out = Term::ReadLine::Stub::findConsole();
+-    is_deeply \@out, [ q{&STDIN}, q{&STDERR} ], "findConsole is using /dev/tty" or diag explain \@out;
+    is_deeply \@out, [ q{&STDIN}, q{&STDERR} ], "findConsole isn't using /dev/tty" or diag explain \@out;
+ 
+     ok !-e q[&STDERR], 'file &STDERR do not exist before Term::ReadLine call';
+     my $tr = Term::ReadLine->new('whatever');
+-- 
+2.13.6
+
--- a/perl-5.27.3-perl-132008-try-to-prevent-the-similar-mistakes-in-t.patch
+++ b/perl-5.27.3-perl-132008-try-to-prevent-the-similar-mistakes-in-t.patch
@ -0,0 +1,30 @@
+From 4369267db9ca4982c1a9bd1ef680bc4350decc3a Mon Sep 17 00:00:00 2001
+From: Tony Cook <tony@develop-help.com>
+Date: Mon, 18 Sep 2017 15:07:21 +1000
+Subject: [PATCH] (perl #132008) try to prevent the similar mistakes in the
+ future
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+Signed-off-by: Petr Písař <ppisar@redhat.com>
+---
+ dist/Term-ReadLine/lib/Term/ReadLine.pm | 2 ++
+ 1 file changed, 2 insertions(+)
+
+diff --git a/dist/Term-ReadLine/lib/Term/ReadLine.pm b/dist/Term-ReadLine/lib/Term/ReadLine.pm
+index e00fb376cd..78c1ebf5b6 100644
+--- a/dist/Term-ReadLine/lib/Term/ReadLine.pm
+++ b/dist/Term-ReadLine/lib/Term/ReadLine.pm
+@@ -75,6 +75,8 @@ history. Returns the old value.
+ returns an array with two strings that give most appropriate names for
+ files for input and output using conventions C<"E<lt>$in">, C<"E<gt>out">.
+ 
+The strings returned may not be useful for 3-argument open().
+
+ =item Attribs
+ 
+ returns a reference to a hash which describes internal configuration
+-- 
+2.13.6
+
--- a/perl.spec
+++ b/perl.spec
@ -201,6 +201,12 @@ Patch58:        perl-5.26.0-Time-HiRes-Fix-unreliable-t-usleep.t-and-t-utime.t.p
 # in upstream after 5.27.2
 Patch59:        perl-5.27.2-perl-131793-sanely-handle-PL_linestart-PL_bufptr.patch

+# Fix Term::ReadLine not to create spurious &STDERR files, RT#132008,
+# in upstream after 5.27.3
+Patch60:        perl-5.27.3-Term-ReadLine-generates-empty-STDERR-files.patch
+Patch61:        perl-5.27.3-perl-132008-try-to-prevent-the-similar-mistakes-in-t.patch
+Patch62:        perl-5.27.3-perl-132008-make-sure-the-test-behaves-without-a-tty.patch
+
 # Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048
 Patch200:       perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch

@ -2775,6 +2781,9 @@ Perl extension for Version Objects
 %patch56 -p1
 %patch58 -p1
 %patch59 -p1
+%patch60 -p1
+%patch61 -p1
+%patch62 -p1
 %patch200 -p1
 %patch201 -p1

@ -2810,6 +2819,7 @@ perl -x patchlevel.h \
    'Fedora Patch56: Fix compiler warnings in code generated by ExtUtils::Constant (CPAN RT#101487)' \
    'Fedora Patch58: Fix unreliable Time-HiRes tests (CPAN RT#122819)' \
    'Fedora Patch59: Fix an overflow in the lexer when reading a new line (RT#131793)' \
+    'Fedora Patch60: Fix Term::ReadLine not to create spurious &STDERR files (RT#132008)' \
    'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on Linux' \
    'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \
    %{nil}
@ -5096,6 +5106,7 @@ popd
 * Tue Jan 09 2018 Petr Pisar <ppisar@redhat.com> - 4:5.26.1-402
 - Remove invalid macro definitions from macros.perl (bug #1532539)
 - Fix an overflow in the lexer when reading a new line (RT#131793)
+- Fix Term::ReadLine not to create spurious &STDERR files (RT#132008)

 * Mon Sep 25 2017 Jitka Plesnikova <jplesnik@redhat.com> - 4:5.26.1-401
 - Update perl(:MODULE_COMPAT)