Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

refcnt: fd -1 < 0 with MIME::Lite #13929

Closed
p5pRT opened this issue Jun 16, 2014 · 34 comments
Closed

refcnt: fd -1 < 0 with MIME::Lite #13929

p5pRT opened this issue Jun 16, 2014 · 34 comments
Labels

Comments

@p5pRT
Copy link
Collaborator

@p5pRT p5pRT commented Jun 16, 2014

Migrated from rt.perl.org#122112 (status was 'pending release')

Searchable as RT122112$

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 16, 2014

From efimov@reg.ru

the following code

use strict;
use warnings;
{
  package MyFile;
  sub print {
  my $self = shift;
  print {$$self} @​_;
  }

}

$SIG{ALRM}=sub{die};
alarm 1;
my $pid = open FILE, "|-";
bless \*FILE, 'MyFile';
defined($pid) or die "open of pipe failed​: $!\n";
if ( !$pid ) { ### child
  exec("sleep", "3");
} else { ### parent
  print FILE "test\n123\n\121";
  close FILE || die;
}

dies with

====
Died at 55.pl line 12.
refcnt​: fd -1 < 0

same happening in MIME​::Lite if sendmail works too slow​:

===
use strict;
use warnings;
use MIME​::Lite;
$SIG{ALRM}=sub{die};
alarm 1;
my $mailer = bless( {
  'SubAttrs' => {
  'content-type' => {
  'charset' => 'windows-1251'
  }
  },
  'Parts' => [],
  'Attrs' => {
  'content-disposition' => 'inline',
  'content-type' => 'text/plain',
  'mime-version' => '1.0',
  'content-length' => undef,
  'content-transfer-encoding' => '8bit'
  },
  'Data' => 'zzzzz',
  'Header' => [
  ['x-mailer','MIME​::Lite 3.029 (F2.82;
T2.04; A2.12; B3.14; Q3.13)'],
  ['date','Mon, 16 Jun 2014 14​:15​:54 +0400'],
  ['from','test <noreply@​example.com>'],
  ['to','test@​example.com'],
  ['subject','test'],
  ['reply-to','test <noreply@​example.com>'],
  ['bcc','outbox']
  ]
  }, 'MIME​::Lite' );
$mailer->send('sendmail', 'sleep 3');

"refcnt​: fd -1 < 0" - seems a perl bug (an assertion in C code)

reproducible in 5.14, 5.18, 5.20

==========
Summary of my perl5 (revision 5 version 20 subversion 0) configuration​:

  Platform​:
  osname=linux, osvers=3.8.0-39-generic, archname=x86_64-linux-thread-multi-ld
  uname='linux green-u 3.8.0-39-generic #58~precise1-ubuntu smp fri
may 2 21​:33​:40 utc 2014 x86_64 x86_64 x86_64 gnulinux '
  config_args='-de
-Dprefix=/home/perlbrew/perls/perl-5.20.0-thread-multi-ld -Dusethreads
-Duselongdouble -Dusemultiplicity
-Aeval​:scriptdir=/home/perlbrew/perls/perl-5.20.0-thread-multi-ld/bin'
  hint=recommended, useposix=true, d_sigaction=define
  useithreads=define, usemultiplicity=define
  use64bitint=define, use64bitall=define, uselongdouble=define
  usemymalloc=n, bincompat5005=undef
  Compiler​:
  cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -fwrapv
-fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include
-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
  optimize='-O2',
  cppflags='-D_REENTRANT -D_GNU_SOURCE -fwrapv -fno-strict-aliasing
-pipe -fstack-protector -I/usr/local/include'
  ccversion='', gccversion='4.6.3', gccosandvers=''
  intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678
  d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
  ivtype='long', ivsize=8, nvtype='long double', nvsize=16,
Off_t='off_t', lseeksize=8
  alignbytes=16, prototype=define
  Linker and Libraries​:
  ld='cc', ldflags =' -fstack-protector -L/usr/local/lib'
  libpth=/usr/local/lib
/usr/lib/gcc/x86_64-linux-gnu/4.6/include-fixed
/usr/include/x86_64-linux-gnu /usr/lib /lib/x86_64-linux-gnu
/lib/../lib /usr/lib/x86_64-linux-gnu /usr/lib/../lib /lib
  libs=-lnsl -lgdbm -ldl -lm -lcrypt -lutil -lpthread -lc -lgdbm_compat
  perllibs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
  libc=, so=so, useshrplib=false, libperl=libperl.a
  gnulibc_version='2.15'
  Dynamic Linking​:
  dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
  cccdlflags='-fPIC', lddlflags='-shared -O2 -L/usr/local/lib
-fstack-protector'

Characteristics of this binary (from libperl)​:
  Compile-time options​: HAS_TIMES MULTIPLICITY PERLIO_LAYERS
  PERL_DONT_CREATE_GVSV
  PERL_HASH_FUNC_ONE_AT_A_TIME_HARD
  PERL_IMPLICIT_CONTEXT PERL_MALLOC_WRAP
  PERL_NEW_COPY_ON_WRITE PERL_PRESERVE_IVUV
  USE_64_BIT_ALL USE_64_BIT_INT USE_ITHREADS
  USE_LARGE_FILES USE_LOCALE USE_LOCALE_COLLATE
  USE_LOCALE_CTYPE USE_LOCALE_NUMERIC USE_LONG_DOUBLE
  USE_PERLIO USE_PERL_ATOF USE_REENTRANT_API
  Built under linux
  Compiled at May 30 2014 06​:30​:13
  %ENV​:
  PERL5LIB=""
  PERLBREW_BASHRC_VERSION="0.67"
  PERLBREW_HOME="/home/vse/.perlbrew"
  PERLBREW_MANPATH="/home/perlbrew/perls/perl-5.20.0-thread-multi-ld/man"
  PERLBREW_PATH="/home/perlbrew/bin​:/home/perlbrew/perls/perl-5.20.0-thread-multi-ld/bin"
  PERLBREW_PERL="perl-5.20.0-thread-multi-ld"
  PERLBREW_ROOT="/home/perlbrew"
  PERLBREW_VERSION="0.67"
  @​INC​:
  /home/perlbrew/perls/perl-5.20.0-thread-multi-ld/lib/site_perl/5.20.0/x86_64-linux-thread-multi-ld
  /home/perlbrew/perls/perl-5.20.0-thread-multi-ld/lib/site_perl/5.20.0
  /home/perlbrew/perls/perl-5.20.0-thread-multi-ld/lib/5.20.0/x86_64-linux-thread-multi-ld
  /home/perlbrew/perls/perl-5.20.0-thread-multi-ld/lib/5.20.0
  .

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 16, 2014

From victor@vsespb.ru

Another way to reproduce (without blessing a filehandle)

use strict;
use warnings;
use Carp; # mandatory
$SIG{ALRM}=sub{die};
alarm 1;
my $cmd = 'sleep 3';
my $pid = open FH, "|$cmd" or die "$!\n";
close FH;

__END__

Died at 57.pl line 4.
refcnt​: fd -1 < 0

(strange that does not work without 'use Carp' or 'use something_not_not_anything_else')

On Mon Jun 16 05​:29​:13 2014, efimov@​reg.ru wrote​:

the following code

use strict;
use warnings;
{
package MyFile;
sub print {
my $self = shift;
print {$$self} @​_;
}

}

$SIG{ALRM}=sub{die};
alarm 1;
my $pid = open FILE, "|-";
bless \*FILE, 'MyFile';
defined($pid) or die "open of pipe failed​: $!\n";
if ( !$pid ) { ### child
exec("sleep", "3");
} else { ### parent
print FILE "test\n123\n\121";
close FILE || die;
}

dies with

====
Died at 55.pl line 12.
refcnt​: fd -1 < 0

same happening in MIME​::Lite if sendmail works too slow​:

===
use strict;
use warnings;
use MIME​::Lite;
$SIG{ALRM}=sub{die};
alarm 1;
my $mailer = bless( {
'SubAttrs' => {
'content-type' => {
'charset' =>
'windows-1251'
}
},
'Parts' => [],
'Attrs' => {
'content-disposition' => 'inline',
'content-type' => 'text/plain',
'mime-version' => '1.0',
'content-length' => undef,
'content-transfer-encoding' => '8bit'
},
'Data' => 'zzzzz',
'Header' => [
['x-mailer','MIME​::Lite 3.029 (F2.82;
T2.04; A2.12; B3.14; Q3.13)'],
['date','Mon, 16 Jun 2014 14​:15​:54
+0400'],
['from','test <noreply@​example.com>'],
['to','test@​example.com'],
['subject','test'],
['reply-to','test
<noreply@​example.com>'],
['bcc','outbox']
]
}, 'MIME​::Lite' );
$mailer->send('sendmail', 'sleep 3');

"refcnt​: fd -1 < 0" - seems a perl bug (an assertion in C code)

reproducible in 5.14, 5.18, 5.20

==========
Summary of my perl5 (revision 5 version 20 subversion 0)
configuration​:

Platform​:
osname=linux, osvers=3.8.0-39-generic, archname=x86_64-linux-thread-
multi-ld
uname='linux green-u 3.8.0-39-generic #58~precise1-ubuntu smp fri
may 2 21​:33​:40 utc 2014 x86_64 x86_64 x86_64 gnulinux '
config_args='-de
-Dprefix=/home/perlbrew/perls/perl-5.20.0-thread-multi-ld -Dusethreads
-Duselongdouble -Dusemultiplicity
-Aeval​:scriptdir=/home/perlbrew/perls/perl-5.20.0-thread-multi-ld/bin'
hint=recommended, useposix=true, d_sigaction=define
useithreads=define, usemultiplicity=define
use64bitint=define, use64bitall=define, uselongdouble=define
usemymalloc=n, bincompat5005=undef
Compiler​:
cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -fwrapv
-fno-strict-aliasing -pipe -fstack-protector -I/usr/local/include
-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
optimize='-O2',
cppflags='-D_REENTRANT -D_GNU_SOURCE -fwrapv -fno-strict-aliasing
-pipe -fstack-protector -I/usr/local/include'
ccversion='', gccversion='4.6.3', gccosandvers=''
intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
ivtype='long', ivsize=8, nvtype='long double', nvsize=16,
Off_t='off_t', lseeksize=8
alignbytes=16, prototype=define
Linker and Libraries​:
ld='cc', ldflags =' -fstack-protector -L/usr/local/lib'
libpth=/usr/local/lib
/usr/lib/gcc/x86_64-linux-gnu/4.6/include-fixed
/usr/include/x86_64-linux-gnu /usr/lib /lib/x86_64-linux-gnu
/lib/../lib /usr/lib/x86_64-linux-gnu /usr/lib/../lib /lib
libs=-lnsl -lgdbm -ldl -lm -lcrypt -lutil -lpthread -lc
-lgdbm_compat
perllibs=-lnsl -ldl -lm -lcrypt -lutil -lpthread -lc
libc=, so=so, useshrplib=false, libperl=libperl.a
gnulibc_version='2.15'
Dynamic Linking​:
dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
cccdlflags='-fPIC', lddlflags='-shared -O2 -L/usr/local/lib
-fstack-protector'

Characteristics of this binary (from libperl)​:
Compile-time options​: HAS_TIMES MULTIPLICITY PERLIO_LAYERS
PERL_DONT_CREATE_GVSV
PERL_HASH_FUNC_ONE_AT_A_TIME_HARD
PERL_IMPLICIT_CONTEXT PERL_MALLOC_WRAP
PERL_NEW_COPY_ON_WRITE PERL_PRESERVE_IVUV
USE_64_BIT_ALL USE_64_BIT_INT USE_ITHREADS
USE_LARGE_FILES USE_LOCALE USE_LOCALE_COLLATE
USE_LOCALE_CTYPE USE_LOCALE_NUMERIC
USE_LONG_DOUBLE
USE_PERLIO USE_PERL_ATOF USE_REENTRANT_API
Built under linux
Compiled at May 30 2014 06​:30​:13
%ENV​:
PERL5LIB=""
PERLBREW_BASHRC_VERSION="0.67"
PERLBREW_HOME="/home/vse/.perlbrew"
PERLBREW_MANPATH="/home/perlbrew/perls/perl-5.20.0-thread-multi-
ld/man"
PERLBREW_PATH="/home/perlbrew/bin​:/home/perlbrew/perls/perl-
5.20.0-thread-multi-ld/bin"
PERLBREW_PERL="perl-5.20.0-thread-multi-ld"
PERLBREW_ROOT="/home/perlbrew"
PERLBREW_VERSION="0.67"
@​INC​:
/home/perlbrew/perls/perl-5.20.0-thread-multi-
ld/lib/site_perl/5.20.0/x86_64-linux-thread-multi-ld
/home/perlbrew/perls/perl-5.20.0-thread-multi-
ld/lib/site_perl/5.20.0
/home/perlbrew/perls/perl-5.20.0-thread-multi-
ld/lib/5.20.0/x86_64-linux-thread-multi-ld
/home/perlbrew/perls/perl-5.20.0-thread-multi-ld/lib/5.20.0
.

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 16, 2014

The RT System itself - Status changed from 'new' to 'open'

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 7, 2014

From @tonycoz

On Mon Jun 16 06​:14​:37 2014, vsespb wrote​:

Another way to reproduce (without blessing a filehandle)

use strict;
use warnings;
use Carp; # mandatory
$SIG{ALRM}=sub{die};
alarm 1;
my $cmd = 'sleep 3';
my $pid = open FH, "|$cmd" or die "$!\n";
close FH;

This croaked for me without the use Carp​:

  tony@​mars​:.../git/perl2$ ./perl -Ilib fdlesszero.pl
  Died at fdlesszero.pl line 1.
  refcnt​: fd -1 < 0
  tony@​mars​:.../git/perl2$ cat fdlesszero.pl
  $SIG{ALRM}=sub{die};
  alarm 1;
  my $cmd = 'sleep 3';
  my $pid = open FH, "|$cmd" or die "$!\n";
  close FH;

What appears to be happening is, the explicit close executes, and ends up calling into my_pclose().

This function basically does two things,

a) calls PerlIO_close(), which closes the fd and sets the handle's fd to -1

b) loops on wait4pid(), waiting for the child process to complete

wait4pid() uses waitpid() or wait4() to wait for the child, if it's interruptted as in this case, it calls PERL_ASYNC_CHECK() which delivers any pending signals.

That dies, which tries to destroy FH again, and since fd is now -1, we get the croak above.

I can prevent the croak() by adding​:

  if (fd < 0) {
  /* the handle has already been closed */
  return -1;
  }

to the top of Perl_my_pclose().

It doesn't matter in this particular case, since the parent process immediately exits, but in a more complex case where the perl process keeps running this will result in zombie processes.

Tony

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 7, 2014

From victor@vsespb.ru

I think it should behave like this (when there is wait() called from destructor).

$ perl 1.pl
main pid 32071
Died at 1.pl line 9.
destruct exit 32072 -1
destruct exit 32071 65280

$ cat 1.pl
use strict;
use warnings;
print "main pid $$\n";
unless (fork()){
sleep 3;
exit;
}
END{ wait; print "destruct exit $$ $?\n"; };
$SIG{ALRM}=sub{die};
alarm 1;
wait;
print "main exit $$ $?\n";

So instead

  if (fd < 0) {
  /* the handle has already been closed */
  return -1;
  }

Perl_my_pclose should continue and run wait4pid loop, but PerlIO_close should be skipped.

Also, "if (fd < 0) {" can be improved like
"if we are in signal handler which is called from Perl_my_pclose for same filehandle".
(disclaimer​: totally not sure how it's possible to implement in terms of perl internals)

On Mon Jul 07 00​:22​:57 2014, tonyc wrote​:

On Mon Jun 16 06​:14​:37 2014, vsespb wrote​:

Another way to reproduce (without blessing a filehandle)

use strict;
use warnings;
use Carp; # mandatory
$SIG{ALRM}=sub{die};
alarm 1;
my $cmd = 'sleep 3';
my $pid = open FH, "|$cmd" or die "$!\n";
close FH;

This croaked for me without the use Carp​:

tony@​mars​:.../git/perl2$ ./perl -Ilib fdlesszero.pl
Died at fdlesszero.pl line 1.
refcnt​: fd -1 < 0
tony@​mars​:.../git/perl2$ cat fdlesszero.pl
$SIG{ALRM}=sub{die};
alarm 1;
my $cmd = 'sleep 3';
my $pid = open FH, "|$cmd" or die "$!\n";
close FH;

What appears to be happening is, the explicit close executes, and ends
up calling into my_pclose().

This function basically does two things,

a) calls PerlIO_close(), which closes the fd and sets the handle's fd
to -1

b) loops on wait4pid(), waiting for the child process to complete

wait4pid() uses waitpid() or wait4() to wait for the child, if it's
interruptted as in this case, it calls PERL_ASYNC_CHECK() which
delivers any pending signals.

That dies, which tries to destroy FH again, and since fd is now -1, we
get the croak above.

I can prevent the croak() by adding​:

if (fd < 0) {
/* the handle has already been closed */
return -1;
}

to the top of Perl_my_pclose().

It doesn't matter in this particular case, since the parent process
immediately exits, but in a more complex case where the perl process
keeps running this will result in zombie processes.

Tony

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 7, 2014

From @tonycoz

On Mon Jul 07 12​:48​:51 2014, vsespb wrote​:

So instead

if (fd < 0) {
/* the handle has already been closed */
return -1;
}

Perl_my_pclose should continue and run wait4pid loop, but PerlIO_close
should be skipped.

Without the original fd we can't look up the pid to wait on.

We can't re-order the close/wait to wait/close, since if we're writing to the child, it may be waiting for EOF (eg. a filter) before exiting.

Tony

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 8, 2014

From victor@vsespb.ru

On Mon Jul 07 16​:35​:06 2014, tonyc wrote​:

On Mon Jul 07 12​:48​:51 2014, vsespb wrote​:

So instead

if (fd < 0) {
/* the handle has already been closed */
return -1;
}

Perl_my_pclose should continue and run wait4pid loop, but
PerlIO_close
should be skipped.

Without the original fd we can't look up the pid to wait on.

We need make function re-entrant. Can save PID for later user in global varibale.

We can't re-order the close/wait to wait/close, since if we're writing
to the child, it may be waiting for EOF (eg. a filter) before exiting.

yes, right.

Here is prototype. All tests pass and original problem fixed.

====
+bool inside_my_pclose = FALSE;
+Pid_t inside_my_pclose_pid;
+
  /* VMS' my_pclose() is in VMS.c; same with OS/2 */
#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(__LIBCATAMOUNT__)
I32
Perl_my_pclose(pTHX_ PerlIO *ptr)
{
  int status;
  SV **svp;
  Pid_t pid;
  Pid_t pid2 = 0;
  bool close_failed;
  dSAVEDERRNO;
  const int fd = PerlIO_fileno(ptr);
  bool should_wait;

  svp = av_fetch(PL_fdpid,fd,TRUE);
  pid = (SvTYPE(*svp) == SVt_IV) ? SvIVX(*svp) : -1;
  SvREFCNT_dec(*svp);
  *svp = NULL;

+ if (fd < 0 && inside_my_pclose) {
+ /* the handle has already been closed */
+ close_failed = FALSE;
+ pid = inside_my_pclose_pid;
+ should_wait = TRUE;
+ }
+ else {
+
#if defined(USE_PERLIO)
  /* Find out whether the refcount is low enough for us to wait for the
  child proc without blocking. */
  should_wait = PerlIOUnix_refcnt(fd) == 1 && pid > 0;
#else
  should_wait = pid > 0;
#endif

#ifdef OS2
  if (pid == -1) { /* Opened by popen. */
  return my_syspclose(ptr);
  }
#endif
+
  close_failed = (PerlIO_close(ptr) == EOF);
+ }
+
+ inside_my_pclose = TRUE;
+ inside_my_pclose_pid = pid;
  SAVE_ERRNO;
  if (should_wait) do {
  pid2 = wait4pid(pid, &status, 0);
  } while (pid2 == -1 && errno == EINTR);
+ inside_my_pclose = FALSE;
+
  if (close_failed) {
  RESTORE_ERRNO;
  return -1;
  }
  return(
  should_wait
  ? pid2 < 0 ? pid2 : status == 0 ? 0 : (errno = 0, status)
  : 0
  );
}

but real patch should also keep relation between PID and FH and work even if my_close(FILE1) called but then my_close(FILE2) called from inside signal handler.

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jul 17, 2014

From @tonycoz

On Tue Jul 08 03​:02​:17 2014, vsespb wrote​:

On Mon Jul 07 16​:35​:06 2014, tonyc wrote​:

On Mon Jul 07 12​:48​:51 2014, vsespb wrote​:

So instead

if (fd < 0) {
/* the handle has already been closed */
return -1;
}

Perl_my_pclose should continue and run wait4pid loop, but
PerlIO_close
should be skipped.

Without the original fd we can't look up the pid to wait on.

We need make function re-entrant. Can save PID for later user in
global varibale.

We can't re-order the close/wait to wait/close, since if we're
writing
to the child, it may be waiting for EOF (eg. a filter) before
exiting.

yes, right.

Here is prototype. All tests pass and original problem fixed.

...

but real patch should also keep relation between PID and FH and work
even if my_close(FILE1) called but then my_close(FILE2) called from
inside signal handler.

Another problem I can see with the current my_pclose() code - the second time we enter my_pclose() for our sample code, the PerlIO object has already been freed by PerlIO_close(), so we're accessing a freed object. Because of the way PerlIO allocates memory, this isn't picked up by valgrind.

I can think of a few different possibilities to fix the problem​:

a) implement a half-close operation for PerlIO that closes the handle but doesn't release the PerlIO object. my_pclose() would half-close the object, perform the wait, then do the full close which releases the PerlIO object. I'm not sure how much work this is.

b) keep a linked list (or other structure, but hopefully we don't have a lot of them) of closing-in-progress pipe PerlIO handles, my_pclose() checks if the handle is on the list. If it is, it bypasses the PerlIO_close(), if not, call PerlIO_close() and add an entry to the list with the PerlIO object pointer[1] and pid. After the wait() loop is complete remove the entry from the list. I think this might be the correct solution. Locking may need to be an issue as the linked list needs to be visible cross-thread as some handles are visible cross-thread. This is the multi-handle version of your solution.

c) implement something close to the vms/vms.c implementation of my_popen()/my_pclose() which keeps a fairly complex data structure for each pipe. Overkill here I think.

Tony

[1] this is undefined behaviour, but less so than following the pointer, I expect

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Apr 11, 2018

From e.lepikhin@corp.mail.ru

Created by johnlepikhin@gmail.com

This is a bug report for perl from johnlepikhin@​gmail.com,
generated with the help of perlbug 1.40 running under perl 5.24.1.

-----------------------------------------------------------------
Perl crashes with error message "refcnt​: fd -1 < 0" when exception
is thrown in SigALRM handler while waiting for child process to be
closed. How to reproduce​:

$ perl -e 'alarm(1); $SIG{ALRM} = sub { die "" }; open($fh, "-|",
"sleep 2"); eval { close($fh); } '
refcnt​: fd -1 < 0

Perl Info

Flags:
    category=core
    severity=high

Site configuration information for perl 5.24.1:

Configured by Debian Project at Tue Sep 12 16:37:26 UTC 2017.

Summary of my perl5 (revision 5 version 24 subversion 1) 
configuration:
   
  Platform:
    osname=linux, osvers=3.16.0, 
    archname=x86_64-linux-gnu-thread-multi
    uname='linux localhost 3.16.0 #1 smp debian 3.16.0 x86_64 
    gnulinux '
    config_args='-Dusethreads -Duselargefiles 
    -Dcc=x86_64-linux-gnu-gcc -Dcpp=x86_64-linux-gnu-cpp 
    -Dld=x86_64-linux-gnu-gcc -Dccflags=-DDEBIAN -Wdate-time 
    -D_FORTIFY_SOURCE=2 -g -O2 
    -fdebug-prefix-map=/build/perl-Gg9XxY/perl-5.24.1=. -fstack-protector-strong 
    -Wformat -Werror=format-security -Dldflags= -Wl,-z,relro 
    -Dlddlflags=-shared -Wl,-z,relro -Dcccdlflags=-fPIC 
    -Darchname=x86_64-linux-gnu -Dprefix=/usr 
    -Dprivlib=/usr/share/perl/5.24 
    -Darchlib=/usr/lib/x86_64-linux-gnu/perl/5.24 
    -Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5 
    -Dvendorarch=/usr/lib/x86_64-linux-gnu/perl5/5.24 
    -Dsiteprefix=/usr/local -Dsitelib=/usr/local/share/perl/5.24.1 
    -Dsitearch=/usr/local/lib/x86_64-linux-gnu/perl/5.24.1 
    -Dman1dir=/usr/share/man/man1 -Dman3dir=/usr/share/man/man3 
    -Dsiteman1dir=/usr/local/man/man1 
    -Dsiteman3dir=/usr/local/man/man3 -Dusesitecustomize 
    -Duse64bitint -Dman1ext=1 -Dman3ext=3perl 
    -Dpager=/usr/bin/sensible-pager -Uafs -Ud_csh -Ud_ualarm 
    -Uusesfio -Uusenm -Ui_libutil -Uversiononly -DDEBUGGING=-g 
    -Doptimize=-O2 -dEs -Duseshrplib -Dlibperl=libperl.so.5.24.1'
    hint=recommended, useposix=true, d_sigaction=define
    useithreads=define, usemultiplicity=define
    use64bitint=define, use64bitall=define, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='x86_64-linux-gnu-gcc', ccflags ='-D_REENTRANT 
    -D_GNU_SOURCE -DDEBIAN -fwrapv -fno-strict-aliasing -pipe 
    -I/usr/local/include -D_LARGEFILE_SOURCE 
    -D_FILE_OFFSET_BITS=64',
    optimize='-O2 -g',
    cppflags='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fwrapv 
    -fno-strict-aliasing -pipe -I/usr/local/include'
    ccversion='', gccversion='6.3.0 20170516', gccosandvers=''
    intsize=4, longsize=8, ptrsize=8, doublesize=8, 
    byteorder=12345678, doublekind=3
    d_longlong=define, longlongsize=8, d_longdbl=define, 
    longdblsize=16, longdblkind=3
    ivtype='long', ivsize=8, nvtype='double', nvsize=8, 
    Off_t='off_t', lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='x86_64-linux-gnu-gcc', ldflags =' -fstack-protector-strong 
    -L/usr/local/lib'
    libpth=/usr/local/lib 
    /usr/lib/gcc/x86_64-linux-gnu/6/include-fixed 
    /usr/include/x86_64-linux-gnu /usr/lib /lib/x86_64-linux-gnu 
    /lib/../lib /usr/lib/x86_64-linux-gnu /usr/lib/../lib /lib
    libs=-lgdbm -lgdbm_compat -ldb -ldl -lm -lpthread -lc -lcrypt
    perllibs=-ldl -lm -lpthread -lc -lcrypt
    libc=libc-2.24.so, so=so, useshrplib=true, 
    libperl=libperl.so.5.24
    gnulibc_version='2.24'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, 
    ccdlflags='-Wl,-E'
    cccdlflags='-fPIC', lddlflags='-shared -L/usr/local/lib 
    -fstack-protector-strong'

Locally applied patches:
    DEBPKG:debian/cpan_definstalldirs - Provide a sensible 
    INSTALLDIRS default for modules installed from CPAN.
    DEBPKG:debian/db_file_ver - https://bugs.debian.org/340047 
    Remove overly restrictive DB_File version check.
    DEBPKG:debian/doc_info - Replace generic man(1) instructions 
    with Debian-specific information.
    DEBPKG:debian/enc2xs_inc - https://bugs.debian.org/290336 
    Tweak enc2xs to follow symlinks and ignore missing @INC 
    directories.
    DEBPKG:debian/errno_ver - https://bugs.debian.org/343351 
    Remove Errno version check due to upgrade problems with 
    long-running processes.
    DEBPKG:debian/libperl_embed_doc - 
    https://bugs.debian.org/186778 Note that libperl-dev package 
    is required for embedded linking
    DEBPKG:fixes/respect_umask - Respect umask during installation
    DEBPKG:debian/writable_site_dirs - Set umask approproately for 
    site install directories
    DEBPKG:debian/extutils_set_libperl_path - EU:MM: set location 
    of libperl.a under /usr/lib
    DEBPKG:debian/no_packlist_perllocal - Don't install .packlist 
    or perllocal.pod for perl or vendor
    DEBPKG:debian/fakeroot - Postpone LD_LIBRARY_PATH evaluation 
    to the binary targets.
    DEBPKG:debian/instmodsh_doc - Debian policy doesn't install 
    .packlist files for core or vendor.
    DEBPKG:debian/ld_run_path - Remove standard libs from 
    LD_RUN_PATH as per Debian 
-- 
QA automation engineer at Mail.ru. Telegram: johnlepikhin

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented May 23, 2018

From @tonycoz

On Wed, 11 Apr 2018 05​:53​:26 -0700, e.lepikhin@​corp.mail.ru wrote​:

Perl crashes with error message "refcnt​: fd -1 < 0" when exception
is thrown in SigALRM handler while waiting for child process to be
closed. How to reproduce​:

$ perl -e 'alarm(1); $SIG{ALRM} = sub { die "" }; open($fh, "-|",
"sleep 2"); eval { close($fh); } '
refcnt​: fd -1 < 0

This looks like a duplicate for 122112.

Tony

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented May 23, 2018

The RT System itself - Status changed from 'new' to 'open'

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented May 30, 2018

From @tonycoz

On Mon, 07 Jul 2014 12​:48​:51 -0700, vsespb wrote​:

Perl_my_pclose should continue and run wait4pid loop, but PerlIO_close
should be skipped.

Also, "if (fd < 0) {" can be improved like
"if we are in signal handler which is called from Perl_my_pclose for
same filehandle".
(disclaimer​: totally not sure how it's possible to implement in terms
of perl internals)

The attached fixes this specific problem.

It does leave the PerlIO handle in the IO SV IFP slot, so if someone attempts to use the handle after an interruptted pipe close they might still have problems.

Tony

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented May 30, 2018

From @tonycoz

0001-perl-122112-test-for-signal-handler-death-in-pclose.patch
From 8d15119dfcdaaf499a5e551b78da9212e639df9e Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 30 May 2018 14:03:04 +1000
Subject: (perl #122112) test for signal handler death in pclose

---
 t/io/pipe.t | 25 ++++++++++++++++++++++++-
 1 file changed, 24 insertions(+), 1 deletion(-)

diff --git a/t/io/pipe.t b/t/io/pipe.t
index f9ee65afe8..8196f05393 100644
--- a/t/io/pipe.t
+++ b/t/io/pipe.t
@@ -10,7 +10,7 @@ if (!$Config{'d_fork'}) {
     skip_all("fork required to pipe");
 }
 else {
-    plan(tests => 25);
+    plan(tests => 27);
 }
 
 my $Perl = which_perl();
@@ -241,3 +241,26 @@ SKIP: {
 
   is($child, -1, 'child reaped if piped program cannot be executed');
 }
+
+SKIP: {
+    # this is probably more restrictive than necessary
+    skip "Might not be using perl's pclose", 2
+      unless $^O =~ /^(linux|.*bsd|darwin)$/ia;
+    # [perl #122112] refcnt: fd -1 < 0 when a signal handler dies
+    # while a pipe close is waiting on a child process
+    my $prog = <<PROG;
+\$SIG{ALRM}=sub{die};
+alarm 1;
+\$Perl = "$Perl";
+my \$cmd = qq(\$Perl -e "sleep 3");
+my \$pid = open my \$fh, "|\$cmd" or die "\$!\n";
+close \$fh;
+PROG
+    my $out = fresh_perl($prog, {});
+    $::TODO = "not fixed yet";
+    cmp_ok($out, '!~', qr/refcnt/, "no exception from PerlIO");
+    undef $::TODO;
+    # checks that that program did something rather than failing to
+    # compile
+    cmp_ok($out, '=~', qr/Died at/, "but we did get the exception from die");
+}
-- 
2.11.0

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented May 30, 2018

From @tonycoz

0002-perl-122112-prevent-access-to-closed-pip-FH-on-a-sig.patch
From 4a0e84cfb4e3e88db08219eb4fc033b8ddbc29d5 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 13 Sep 2017 08:53:38 +1000
Subject: (perl #122112) prevent access to closed pip FH on a signal that dies

Don't access a closed PerlIO handle if a signal handler dies
when closing a pipe.
---
 doio.c      | 106 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 sv.h        |   1 +
 t/io/pipe.t |   2 --
 util.c      |   4 +--
 4 files changed, 108 insertions(+), 5 deletions(-)

diff --git a/doio.c b/doio.c
index 4b8923f77c..03c75219df 100644
--- a/doio.c
+++ b/doio.c
@@ -1726,6 +1726,110 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit)
     return retval;
 }
 
+#if (!defined(DOSISH) || defined(HAS_FORK)) && !defined(VMS) && !defined(__LIBCATAMOUNT__) && !defined(__amigaos4__)
+
+static int
+S_pclose_free(pTHX_ SV *io, MAGIC *mg) {
+    if (mg->mg_obj && SvIVX(mg->mg_obj) > 0) {
+        /* We should only get here for an implicit close.
+
+           We do the close here rather than in S_do_pclose() because
+           during destruction magic is freed before io_close() is
+           called, so we no longer have access to the original PerlIO
+           object, which has been closed if we get here.
+         */
+        int fd = (int)SvIVX(mg->mg_obj);
+        SV **svp = av_fetch(PL_fdpid,fd,TRUE);
+        Pid_t pid = (SvTYPE(*svp) == SVt_IV) ? SvIVX(*svp) : -1;
+
+        if (pid > 0) {
+            Pid_t pid2;
+            int status;
+            do {
+                /* a die within a signal handler in here may ... */
+                pid2 = wait4pid(pid, &status, 0);
+                /* ... prevent anything following here running */
+            } while (pid2 == -1 && errno == EINTR);
+        }
+        /* ensure sv_clear() doesn't try to close it again */
+        IoIFP(io) = NULL;
+        SvREFCNT_dec(*svp);
+        *svp = NULL;
+    }
+    return 0;
+}
+
+static const MGVTBL pclose_vtbl =
+    {
+        NULL, /* svt_get */
+        NULL, /* svt_set */
+        NULL, /* svt_len */
+        NULL, /* svt_clear */
+        S_pclose_free, /* svt_free */
+        NULL, /* svt_copy */
+        NULL, /* svt_dup */
+        NULL  /* svt_local */
+    };
+
+static int
+S_do_pclose(pTHX_ IO *io) {
+    MAGIC *mg = mg_findext((SV*)io, PERL_MAGIC_uvar, &pclose_vtbl);
+    int status;
+    if (!mg) {
+        mg = sv_magicext((SV*)io, sv_2mortal(newSViv(-1)), PERL_MAGIC_uvar, &pclose_vtbl, NULL, 0);
+    }
+    if (SvIVX(mg->mg_obj) == -1) {
+        int fd = PerlIO_fileno(IoIFP(io));
+        sv_setiv(mg->mg_obj, fd);
+
+        /* it's possible for a signal handler to be called when pclose() waits
+           on the child process, and for that signal handler to die, which leaves
+           the underlying PerlIO object freed, but the child process still
+           un-wait()ed upon.
+        */
+        status = PerlProc_pclose(IoIFP(io));
+    }
+    else {
+
+        /* if we get here, close() has been explicitly called on a
+           pipe handle we've already tried to close.
+
+           The magic free code will handle the implicit close in this
+           case.
+        */
+
+        int fd = (int)SvIVX(mg->mg_obj);
+        SV **svp = av_fetch(PL_fdpid,fd,TRUE);
+        Pid_t pid = (SvTYPE(*svp) == SVt_IV) ? SvIVX(*svp) : -1;
+
+        if (pid > 0) {
+            Pid_t pid2;
+            do {
+                /* a die within a signal handler in here may ... */
+                pid2 = wait4pid(pid, &status, 0);
+                /* ... prevent anything following here running */
+            } while (pid2 == -1 && errno == EINTR);
+            status = pid2 < 0 ? pid2 : status == 0 ? 0 : (errno = 0, status);
+        }
+        else {
+            status = 0;
+        }
+        SvREFCNT_dec(*svp);
+        *svp = NULL;
+    }
+    sv_setiv(mg->mg_obj, -1);
+
+    return status;
+}
+
+#define do_pclose(io) S_do_pclose(aTHX_ (io));
+
+#else
+
+#define do_pclose(io) PerlProc_pclose(IoIFP(io))
+
+#endif
+
 bool
 Perl_io_close(pTHX_ IO *io, GV *gv, bool not_implicit, bool warn_on_fail)
 {
@@ -1735,7 +1839,7 @@ Perl_io_close(pTHX_ IO *io, GV *gv, bool not_implicit, bool warn_on_fail)
 
     if (IoIFP(io)) {
 	if (IoTYPE(io) == IoTYPE_PIPE) {
-	    const int status = PerlProc_pclose(IoIFP(io));
+            const int status = do_pclose(io);
 	    if (not_implicit) {
 		STATUS_NATIVE_CHILD_SET(status);
 		retval = (STATUS_UNIX == 0);
diff --git a/sv.h b/sv.h
index 1c7224277f..503fd14eb7 100644
--- a/sv.h
+++ b/sv.h
@@ -1422,6 +1422,7 @@ object type. Exposed to perl code via Internals::SvREADONLY().
 #define IoFMT_GV(sv)	((XPVIO*)  SvANY(sv))->xio_fmt_gv
 #define IoBOTTOM_NAME(sv)((XPVIO*) SvANY(sv))->xio_bottom_name
 #define IoBOTTOM_GV(sv)	((XPVIO*)  SvANY(sv))->xio_bottom_gv
+#define IoPIPE_PID(sv)	((XPVIO*)  SvANY(sv))->xio_pipe_pid
 #define IoTYPE(sv)	((XPVIO*)  SvANY(sv))->xio_type
 #define IoFLAGS(sv)	((XPVIO*)  SvANY(sv))->xio_flags
 
diff --git a/t/io/pipe.t b/t/io/pipe.t
index 8196f05393..c95da9c796 100644
--- a/t/io/pipe.t
+++ b/t/io/pipe.t
@@ -257,9 +257,7 @@ my \$pid = open my \$fh, "|\$cmd" or die "\$!\n";
 close \$fh;
 PROG
     my $out = fresh_perl($prog, {});
-    $::TODO = "not fixed yet";
     cmp_ok($out, '!~', qr/refcnt/, "no exception from PerlIO");
-    undef $::TODO;
     # checks that that program did something rather than failing to
     # compile
     cmp_ok($out, '=~', qr/Died at/, "but we did get the exception from die");
diff --git a/util.c b/util.c
index 647f53307d..58fdc4e6e3 100644
--- a/util.c
+++ b/util.c
@@ -2795,8 +2795,6 @@ Perl_my_pclose(pTHX_ PerlIO *ptr)
 
     svp = av_fetch(PL_fdpid,fd,TRUE);
     pid = (SvTYPE(*svp) == SVt_IV) ? SvIVX(*svp) : -1;
-    SvREFCNT_dec(*svp);
-    *svp = NULL;
 
 #if defined(USE_PERLIO)
     /* Find out whether the refcount is low enough for us to wait for the
@@ -2816,6 +2814,8 @@ Perl_my_pclose(pTHX_ PerlIO *ptr)
     if (should_wait) do {
 	pid2 = wait4pid(pid, &status, 0);
     } while (pid2 == -1 && errno == EINTR);
+    SvREFCNT_dec(*svp);
+    *svp = NULL;
     if (close_failed) {
 	RESTORE_ERRNO;
 	return -1;
-- 
2.11.0

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented May 9, 2019

From @tonycoz

On Tue, 29 May 2018 22​:54​:52 -0700, tonyc wrote​:

On Mon, 07 Jul 2014 12​:48​:51 -0700, vsespb wrote​:

Perl_my_pclose should continue and run wait4pid loop, but
PerlIO_close
should be skipped.

Also, "if (fd < 0) {" can be improved like
"if we are in signal handler which is called from Perl_my_pclose for
same filehandle".
(disclaimer​: totally not sure how it's possible to implement in terms
of perl internals)

The attached fixes this specific problem.

It does leave the PerlIO handle in the IO SV IFP slot, so if someone
attempts to use the handle after an interruptted pipe close they might
still have problems.

I think the attached is a better solution, as detailed in the commit message.

Tony

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented May 9, 2019

From @tonycoz

0002-perl-122112-a-simpler-fix-for-pclose-aborted-by-a-si.patch
From cfc3d5eb217d47974692a6f052c10c1f47bc2dcf Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Thu, 9 May 2019 09:52:30 +1000
Subject: (perl #122112) a simpler fix for pclose() aborted by a signal

This change results in a zombie child process for the lifetime of
the process, but I think that's the responsibility of the signal
handler that aborted pclose().

We could add some magic to retry (and retry and retry) waiting on
child process as we rewind (since there's no other way to remove
the zombie), but the program has chosen implicitly to abort the
wait() done by pclose() and it's best to honor that.

If we do choose to retry the wait() we might be blocking an attempt
by the process to terminate, whether by exit() or die().

If a program does need more flexible handling there's always
pipe()/fork()/exec() and/or the various event-driven frameworks on
CPAN.
---
 doio.c      | 12 +++++++++++-
 t/io/pipe.t |  2 --
 2 files changed, 11 insertions(+), 3 deletions(-)

diff --git a/doio.c b/doio.c
index 0cc4e55404..05a06968dc 100644
--- a/doio.c
+++ b/doio.c
@@ -1779,7 +1779,17 @@ Perl_io_close(pTHX_ IO *io, GV *gv, bool not_implicit, bool warn_on_fail)
 
     if (IoIFP(io)) {
 	if (IoTYPE(io) == IoTYPE_PIPE) {
-	    const int status = PerlProc_pclose(IoIFP(io));
+            PerlIO *fh = IoIFP(io);
+            int status;
+
+            /* my_pclose() can propagate signals which might bypass any code
+               after the call here if the signal handler throws an exception.
+               This would leave the handle in the IO object and try to close it again
+               when the SV is destroyed on unwind or global destruction.
+               So NULL it early.
+            */
+            IoOFP(io) = IoIFP(io) = NULL;
+	    status = PerlProc_pclose(fh);
 	    if (not_implicit) {
 		STATUS_NATIVE_CHILD_SET(status);
 		retval = (STATUS_UNIX == 0);
diff --git a/t/io/pipe.t b/t/io/pipe.t
index 1d01db6af6..fc3071300d 100644
--- a/t/io/pipe.t
+++ b/t/io/pipe.t
@@ -255,9 +255,7 @@ close \$fh;
 PROG
     print $prog;
     my $out = fresh_perl($prog, {});
-    $::TODO = "not fixed yet";
     cmp_ok($out, '!~', qr/refcnt/, "no exception from PerlIO");
-    undef $::TODO;
     # checks that that program did something rather than failing to
     # compile
     cmp_ok($out, '=~', qr/Died at/, "but we did get the exception from die");
-- 
2.11.0

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented May 30, 2019

From @tonycoz

On Wed, 08 May 2019 18​:41​:08 -0700, tonyc wrote​:

On Tue, 29 May 2018 22​:54​:52 -0700, tonyc wrote​:

On Mon, 07 Jul 2014 12​:48​:51 -0700, vsespb wrote​:

Perl_my_pclose should continue and run wait4pid loop, but
PerlIO_close
should be skipped.

Also, "if (fd < 0) {" can be improved like
"if we are in signal handler which is called from Perl_my_pclose
for
same filehandle".
(disclaimer​: totally not sure how it's possible to implement in
terms
of perl internals)

The attached fixes this specific problem.

It does leave the PerlIO handle in the IO SV IFP slot, so if someone
attempts to use the handle after an interruptted pipe close they
might
still have problems.

I think the attached is a better solution, as detailed in the commit
message.

Test case applied as fb5e771 and the simple fix as 35608a1.

Tony

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented May 30, 2019

@tonycoz - Status changed from 'open' to 'pending release'

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented May 31, 2019

@tonycoz - Status changed from 'pending release' to 'open'

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 1, 2019

From rich@hyphen-dash-hyphen.info

On Fri, May 31, 2019 at 8​:45 PM Richard Leach
<rich@​hyphen-dash-hyphen.info> wrote​:

io/pipe.t has just started hanging on my Android builds, seemingly
since these commits.

Sorry, io/pipe.t has started failing but it's io/eintr that seems to
have started hanging.

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 1, 2019

From rich@hyphen-dash-hyphen.info

On Thu, May 30, 2019 at 1​:36 AM Tony Cook via RT
<perlbug-followup@​perl.org> wrote​:

Test case applied as fb5e771 and the simple fix as 35608a1.

Hi Tony,

io/pipe.t has just started hanging on my Android builds, seemingly
since these commits. Output from a manual poke below.

I'll have time over the weekend to look in more detail, is there any
specific debugging you'd like me to do?

$ ./perl harness -v io/pipe.t
io/pipe.t ..
1..27
ok 1 - open |- || exec
ok 2 - again
ok 3 - open -|
ok 4 - again
ok 5 - '97 98 99 10 114 115 116 13 120 121 122 13 10 102 111 111 10'
passes through '-|'
ok 6 - '97 98 99 10 114 115 116 13 120 121 122 13 10 102 111 111 10'
passes through '|-'
ok 7 - pipe & fork
ok 8 - with fh dup
ok 10
ok 11 - pipe endpoints not inherited across exec
ok 12 - close error on broken pipe
ok 13 - close failure on non-zero piped exit
ok 14 - errno
ok 15 - status
ok 16 - close failure for... umm, something
ok 17 - status
ok 18 - errno
ok 19 - status correct after wait
ok 20 - wait pid
ok 21 - errno
ok 22 - missing command in piped open input
ok 23 - output
ok 24 - status unaffected by implicit close
ok 25 - child reaped if piped program cannot be executed
$SIG{ALRM}=sub{die};
alarm 1;
$Perl = "./perl";
my $cmd = qq($Perl -e "sleep 3");
my $pid = open my $fh, "|$cmd" or die "$!
";
close $fh;
ok 26 - no exception from PerlIO
ok 27 - but we did get the exception from die
Failed 1/27 subtests

Test Summary Report


io/pipe.t (Wstat​: 0 Tests​: 26 Failed​: 0)
  Parse errors​: Tests out of sequence. Found (10) but expected (9)
  Tests out of sequence. Found (11) but expected (10)
  Tests out of sequence. Found (12) but expected (11)
  Tests out of sequence. Found (13) but expected (12)
  Tests out of sequence. Found (14) but expected (13)
Displayed the first 5 of 19 TAP syntax errors.
Re-run prove with the -p option to see them all.
Files=1, Tests=26, 12 wallclock secs ( 0.06 usr 0.01 sys + 0.36 cusr
0.14 csys = 0.57 CPU)
Result​: FAIL


via perlbug​: queue​: perl5 status​: open
https://rt-archive.perl.org/perl5/Ticket/Display.html?id=122112

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 3, 2019

From @tonycoz

On Fri, 31 May 2019 21​:41​:46 -0700, rich@​hyphen-dash-hyphen.info wrote​:

On Fri, May 31, 2019 at 8​:45 PM Richard Leach
<rich@​hyphen-dash-hyphen.info> wrote​:

io/pipe.t has just started hanging on my Android builds, seemingly
since these commits.

Sorry, io/pipe.t has started failing but it's io/eintr that seems to
have started hanging.

Was this consistent?

ie. was pipe.t consistently passing before the change and is now consistently failing? and similarly for eintr.t?

Can you see where eintr.t is blocking? Something like​:

cd t ; ./perl io/eintr.t

will run the test manually.

I don't see how the change I ended up making would cause the signal not to be delivered in either case.[1]

Tony

[1] one of the changes I considered could have caused blocking

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 3, 2019

From rich@hyphen-dash-hyphen.info

On Mon, Jun 3, 2019 at 2​:58 AM Tony Cook via RT
<perlbug-followup@​perl.org> wrote​:

On Fri, 31 May 2019 21​:41​:46 -0700, rich@​hyphen-dash-hyphen.info wrote​:

On Fri, May 31, 2019 at 8​:45 PM Richard Leach
<rich@​hyphen-dash-hyphen.info> wrote​:

io/pipe.t has just started hanging on my Android builds, seemingly
since these commits.

Sorry, io/pipe.t has started failing but it's io/eintr that seems to
have started hanging.

Was this consistent?

eintr.t turned out to be a local problem that went away after a reboot.

pipe.t is more persistent. It was consistently passing in the run up
to 5.30 and now fails consistently on blead.

Trying to identify the breaking commit (and learn how to use bisect.pl
at the same time), yours might just have happened to be in the
vicinity. I'll report back sometime this week.

Regards,
Richard

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 3, 2019

From rich@hyphen-dash-hyphen.info

On Mon, Jun 3, 2019 at 8​:00 AM Richard Leach
<rich@​hyphen-dash-hyphen.info> wrote​:

pipe.t is more persistent. It was consistently passing in the run up
to 5.30 and now fails consistently on blead.

Hi Tony,

It was definitely fb5e771 wot broke it.

Thanks,
Richard

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 3, 2019

From rich@hyphen-dash-hyphen.info

On Mon, Jun 3, 2019 at 6​:43 PM Richard Leach
<rich@​hyphen-dash-hyphen.info> wrote​:

It was definitely fb5e771 wot broke it.

That commit broke the test from a smoker's perspective, but it was
heisenbroken on some platforms before that. Prior to that commit,
t/io/pipe.t tests all passed under "make test" or "make test_harness",
but do not if t/ harness or t/TEST are invoked manually. (Many "WTFs"
have been uttered.)

https://help-bash.gnu.narkive.com/la0zjaBe/when-pipes-fail-and-when-not
- suggests that GNUroot and Termux have a problem where the parent
process ignores SIGPIPE.

The Termux SSH shell indeed cannot catch SIGPIPE​:

  $ trap '' pipe; bash -c 'trap - pipe; for i in {0..9}; do
  > /bin/echo $i; sleep 1; done | dd bs=1 count=10'
  0
  1
  2
  3
  4
  10+0 records in
  10+0 records out
  10 bytes copied, 4.20389 s, 0.0 kB/s
  /bin/echo​: write error​: Broken pipe
  /bin/echo​: write error​: Broken pipe
  /bin/echo​: write error​: Broken pipe
  /bin/echo​: write error​: Broken pipe
  /bin/echo​: write error​: Broken pipe

I'm not sufficiently familiar with the process model to know how
running the tests via 'make' seems to work. Should there be something
we can try to get the SIGPIPE tests working here?

I've run out of time this evening, but options otherwise seem to be​:
(1) skip some tests if ($^O eq 'android'), although that wouldn't help
anyone building under GNUroot
(2) run a check like the above for SIGPIPE behaviour, then skip tests
if necessary

Thanks,
Richard

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 4, 2019

From @tonycoz

On Mon, Jun 03, 2019 at 10​:36​:56PM +0100, Richard Leach wrote​:

On Mon, Jun 3, 2019 at 6​:43 PM Richard Leach
<rich@​hyphen-dash-hyphen.info> wrote​:

It was definitely fb5e771 wot broke it.

That commit broke the test from a smoker's perspective, but it was
heisenbroken on some platforms before that. Prior to that commit,
t/io/pipe.t tests all passed under "make test" or "make test_harness",
but do not if t/ harness or t/TEST are invoked manually. (Many "WTFs"
have been uttered.)

https://help-bash.gnu.narkive.com/la0zjaBe/when-pipes-fail-and-when-not
- suggests that GNUroot and Termux have a problem where the parent
process ignores SIGPIPE.

The Termux SSH shell indeed cannot catch SIGPIPE​:

$ trap '' pipe; bash -c 'trap - pipe; for i in {0..9}; do

/bin/echo $i; sleep 1; done | dd bs=1 count=10'
0
1
2
3
4
10+0 records in
10+0 records out
10 bytes copied, 4.20389 s, 0.0 kB/s
/bin/echo​: write error​: Broken pipe
/bin/echo​: write error​: Broken pipe
/bin/echo​: write error​: Broken pipe
/bin/echo​: write error​: Broken pipe
/bin/echo​: write error​: Broken pipe

I'm not sufficiently familiar with the process model to know how
running the tests via 'make' seems to work. Should there be something
we can try to get the SIGPIPE tests working here?

I've run out of time this evening, but options otherwise seem to be​:
(1) skip some tests if ($^O eq 'android'), although that wouldn't help
anyone building under GNUroot
(2) run a check like the above for SIGPIPE behaviour, then skip tests
if necessary

The io/pipe.t test that's failing is setting up a signal handler for
SIGPIPE, which should override the ignore done (or inherited) by the
shell.

I'm setting up an Android VM, maybe that will let me track it down.

Tony

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 6, 2019

From @jmdh

On Mon, 03 Jun 2019 18​:17​:20 -0700, tonyc wrote​:

On Mon, Jun 03, 2019 at 10​:36​:56PM +0100, Richard Leach wrote​:

On Mon, Jun 3, 2019 at 6​:43 PM Richard Leach
<rich@​hyphen-dash-hyphen.info> wrote​:

It was definitely fb5e771 wot broke it.

That commit broke the test from a smoker's perspective, but it was
heisenbroken on some platforms before that. Prior to that commit,
t/io/pipe.t tests all passed under "make test" or "make test_harness",
but do not if t/ harness or t/TEST are invoked manually. (Many "WTFs"
have been uttered.)

https://help-bash.gnu.narkive.com/la0zjaBe/when-pipes-fail-and-when-not
- suggests that GNUroot and Termux have a problem where the parent
process ignores SIGPIPE.

The Termux SSH shell indeed cannot catch SIGPIPE​:

$ trap '' pipe; bash -c 'trap - pipe; for i in {0..9}; do

/bin/echo $i; sleep 1; done | dd bs=1 count=10'
0
1
2
3
4
10+0 records in
10+0 records out
10 bytes copied, 4.20389 s, 0.0 kB/s
/bin/echo​: write error​: Broken pipe
/bin/echo​: write error​: Broken pipe
/bin/echo​: write error​: Broken pipe
/bin/echo​: write error​: Broken pipe
/bin/echo​: write error​: Broken pipe

I'm not sufficiently familiar with the process model to know how
running the tests via 'make' seems to work. Should there be something
we can try to get the SIGPIPE tests working here?

I've run out of time this evening, but options otherwise seem to be​:
(1) skip some tests if ($^O eq 'android'), although that wouldn't help
anyone building under GNUroot
(2) run a check like the above for SIGPIPE behaviour, then skip tests
if necessary

The io/pipe.t test that's failing is setting up a signal handler for
SIGPIPE, which should override the ignore done (or inherited) by the
shell.

I'm setting up an Android VM, maybe that will let me track it down.

Tony

io/pipe.t reproducibly fails on Debian (both 9 and unstable)​: make test_harness is happy, but make test is definitely not​:

t/io/pipe ...................................................... FAILED--unexpected output at test 25

This just seems to be left-over print debugging? line 256​:

  print $prog;

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 7, 2019

From @Leont

On Thu, Jun 6, 2019 at 7​:10 PM Dominic Hargreaves via RT
<perlbug-followup@​perl.org> wrote​:

io/pipe.t reproducibly fails on Debian (both 9 and unstable)​: make test_harness is happy, but make test is definitely not​:

t/io/pipe ...................................................... FAILED--unexpected output at test 25

This just seems to be left-over print debugging? line 256​:

print $prog;

Apparently, TEST allows for extra output in cpan|dist|ext|lib, but not
elsewhere. Indeed eliminating the print statement should fix that.

(puts Test​::Harness hat on) I would not recommend extra output
anywhere when dealing with TAP (takes hat off).

Leon

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 11, 2019

From @tonycoz

On Thu, Jun 06, 2019 at 10​:10​:35AM -0700, Dominic Hargreaves via RT wrote​:

io/pipe.t reproducibly fails on Debian (both 9 and unstable)​: make test_harness is happy, but make test is definitely not​:

t/io/pipe ...................................................... FAILED--unexpected output at test 25

This just seems to be left-over print debugging? line 256​:

print $prog;

Thanks, fixed in 2fe0d7f.

Tony

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 25, 2019

From @tonycoz

On Fri, 31 May 2019 21​:41​:49 -0700, rich@​hyphen-dash-hyphen.info wrote​:

On Thu, May 30, 2019 at 1​:36 AM Tony Cook via RT
<perlbug-followup@​perl.org> wrote​:

Test case applied as fb5e771 and the
simple fix as 35608a1.

Hi Tony,

io/pipe.t has just started hanging on my Android builds, seemingly
since these commits. Output from a manual poke below.

I'll have time over the weekend to look in more detail, is there any
specific debugging you'd like me to do?

$ ./perl harness -v io/pipe.t
io/pipe.t ..
1..27
ok 1 - open |- || exec
ok 2 - again
ok 3 - open -|
ok 4 - again
ok 5 - '97 98 99 10 114 115 116 13 120 121 122 13 10 102 111 111 10'
passes through '-|'
ok 6 - '97 98 99 10 114 115 116 13 120 121 122 13 10 102 111 111 10'
passes through '|-'
ok 7 - pipe & fork
ok 8 - with fh dup
ok 10
ok 11 - pipe endpoints not inherited across exec
ok 12 - close error on broken pipe
ok 13 - close failure on non-zero piped exit
ok 14 - errno
ok 15 - status
ok 16 - close failure for... umm, something
ok 17 - status
ok 18 - errno
ok 19 - status correct after wait
ok 20 - wait pid
ok 21 - errno
ok 22 - missing command in piped open input
ok 23 - output
ok 24 - status unaffected by implicit close
ok 25 - child reaped if piped program cannot be executed
$SIG{ALRM}=sub{die};
alarm 1;
$Perl = "./perl";
my $cmd = qq($Perl -e "sleep 3");
my $pid = open my $fh, "|$cmd" or die "$!
";
close $fh;
ok 26 - no exception from PerlIO
ok 27 - but we did get the exception from die
Failed 1/27 subtests

Test Summary Report
-------------------
io/pipe.t (Wstat​: 0 Tests​: 26 Failed​: 0)
Parse errors​: Tests out of sequence. Found (10) but expected (9)
Tests out of sequence. Found (11) but expected (10)
Tests out of sequence. Found (12) but expected (11)
Tests out of sequence. Found (13) but expected (12)
Tests out of sequence. Found (14) but expected (13)
Displayed the first 5 of 19 TAP syntax errors.
Re-run prove with the -p option to see them all.
Files=1, Tests=26, 12 wallclock secs ( 0.06 usr 0.01 sys + 0.36 cusr
0.14 csys = 0.57 CPU)
Result​: FAIL

There were two problems, one that 2fe0d7f fixed, the extraneous output from the test.

The other problem was that the PIPE signal wasn't being delivered when the test wasn't being run through make, ie. any of the following failed to output "ok 9"​:

  cd t ; ./perl -I../lib io/pipe.t
  cd t ; ./perl harness io/pipe.t
  TEST_FILES=io/pipe.t ./runtests choose

but​:

  make test TEST_FILES=io/pipe.t

worked.

It turned out to be that the problem was that SIGPIPE was blocked, presumably something in make was unblocking it.

The attached adjusts the signal mask so that SIGPIPE isn't blocked, assuming the right POSIX APIs are available, the eval should ensure nothing happens if the APIs aren't available.

Tony

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 25, 2019

From @tonycoz

0001-perl-122112-make-sure-SIGPIPE-is-delivered-if-we-tes.patch
From f9c44acd1d6465f687b5aeb2d845879ef0db6f84 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 25 Jun 2019 15:47:57 +1000
Subject: (perl #122112) make sure SIGPIPE is delivered if we test it

---
 t/io/pipe.t | 12 ++++++++++++
 1 file changed, 12 insertions(+)

diff --git a/t/io/pipe.t b/t/io/pipe.t
index 9f5bb3bcf8..bdf743c26c 100644
--- a/t/io/pipe.t
+++ b/t/io/pipe.t
@@ -125,6 +125,18 @@ wait;				# Collect from $pid
 pipe(READER,WRITER) || die "Can't open pipe";
 close READER;
 
+eval {
+    # one platform at least appears to block SIGPIPE by default (see #122112)
+    # so make sure it's unblocked.
+    # The eval wrapper should ensure this does nothing if these aren't
+    # implemented.
+    require POSIX;
+    my $mask = POSIX::SigSet->new(POSIX::SIGPIPE());
+    my $old = POSIX::SigSet->new();
+    POSIX::sigprocmask(POSIX::SIG_UNBLOCK(), $mask, $old);
+    note "Yes, SIGPIPE was blocked" if $old->ismember(POSIX::SIGPIPE());
+};
+
 $SIG{'PIPE'} = 'broken_pipe';
 
 sub broken_pipe {
-- 
2.11.0

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 25, 2019

From rich@hyphen-dash-hyphen.info

On Tue, Jun 25, 2019 at 7​:16 AM Tony Cook via RT
<perlbug-followup@​perl.org> wrote​:

It turned out to be that the problem was that SIGPIPE was blocked, presumably something in make was unblocking it.

The attached adjusts the signal mask so that SIGPIPE isn't blocked, assuming the right POSIX APIs are available, the eval should ensure nothing happens if the APIs aren't available.

Many thanks for digging into that case!


via perlbug​: queue​: perl5 status​: open
https://rt-archive.perl.org/perl5/Ticket/Display.html?id=122112

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 26, 2019

From @tonycoz

On Tue, 25 Jun 2019 00​:21​:09 -0700, rich@​hyphen-dash-hyphen.info wrote​:

On Tue, Jun 25, 2019 at 7​:16 AM Tony Cook via RT
<perlbug-followup@​perl.org> wrote​:

It turned out to be that the problem was that SIGPIPE was blocked,
presumably something in make was unblocking it.

The attached adjusts the signal mask so that SIGPIPE isn't blocked,
assuming the right POSIX APIs are available, the eval should ensure
nothing happens if the APIs aren't available.

Many thanks for digging into that case!

Applied as 293a533.

Tony

@p5pRT
Copy link
Collaborator Author

@p5pRT p5pRT commented Jun 26, 2019

@tonycoz - Status changed from 'open' to 'pending release'

@p5pRT p5pRT closed this Jun 26, 2019
@p5pRT p5pRT added the Severity Low label Oct 19, 2019
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Linked pull requests

Successfully merging a pull request may close this issue.

None yet
1 participant
You can’t perform that action at this time.