Closed
Description
This is a bug report for perl from noah@leadboat.com,
generated with the help of perlbug 1.42 running under perl 5.32.1.
Steps to Reproduce
Test program:
#! /usr/bin/perl
use strict;
use warnings;
use Win32 ();
use Win32::Process ();
use Win32::ShellQuote ();
use Win32API::File qw(
FdGetOsFHandle
SetHandleInformation
HANDLE_FLAG_INHERIT
);
$| = 1;
# Ensure win32sck.c::my_close() takes the wsock_started path, which is needed to
# witness the bug. This program doesn't otherwise use sockets.
require Socket;
# Make an inheritable w32 handle for the read end of a pipe.
pipe my $read_fh, my $write_fh;
my $read_h = FdGetOsFHandle fileno($read_fh);
SetHandleInformation($read_h, HANDLE_FLAG_INHERIT, 1);
# Source code for a kid that receives the handle and reads from it.
my $kid_program = <<\_EOPERL;
use Win32API::File qw(OsFHandleOpen);
$| = 1;
my $h = shift;
print "kid start handle=$h\n";
close STDIN;
OsFHandleOpen(\*STDIN, $h, 'r')
or die "$! opening STDIN as Win32 handle $h in $$";
# sleep 2; # effective workaround: give parent time to close($read_fh)
print "gotline: $_" while (<>); # hangs (non-bug or not the bug being reported)
print "(unreachable) kid exit\n";
_EOPERL
# Start that kid.
my $process;
Win32::Process::Create(
$process,
$^X,
Win32::ShellQuote::quote_native($^X, '-e', $kid_program, $read_h),
1, ## Inherit handles
0, ## Inherit parent priority class
".",
)
or do {
my $err = Win32::FormatMessage( Win32::GetLastError() );
die "$err: Win32::Process::Create()";
};
sleep 1; # give kid time to block on the pipe read
print "before close(\$read_fh) in $$\n";
if ($ENV{USE_WORKAROUND}) {
# dup2() does a close()-like operation internally. Since that does not route
# through win32sck.c::my_close(), it bypasses any bug there. This workaround
# replaces the pipe FD with a non-pipe FD, and closing the non-pipe FD is
# uneventful.
require POSIX;
POSIX::dup2(2, fileno $read_fh);
}
close $read_fh; # without workaround, hangs forever (bug)
print "after close(\$read_fh)\n";
print $write_fh "foo\n";
close $write_fh;
print "parent exit\n";Expected behavior
I expected to see a line saying "parent exit", but the last output line
started with "before close". Setting USE_WORKAROUND=1 in the environment
makes the program reach "parent exit", achieving that expectation. I
distilled the test program from cpan-authors/IPC-Run#77.
Non-debug stack trace of hang
Thread 1 (Thread 4352.0x1588):
#0 0x00007ff828a3f854 in ntdll!ZwDeviceIoControlFile () from C:\Windows\SYSTEM32\ntdll.dll
#1 0x00007ff82547fbe8 in Tcpip4_WSHStringToAddress () from C:\Windows\system32\mswsock.dll
#2 0x00007ff8254763cb in ?? () from C:\Windows\system32\mswsock.dll
#3 0x00007ff82547c336 in NSPStartup () from C:\Windows\system32\mswsock.dll
#4 0x00007ff827550bce in WSCWriteNameSpaceOrder32 () from C:\Windows\System32\ws2_32.dll
#5 0x00007ff82752afd2 in WSASendTo () from C:\Windows\System32\ws2_32.dll
#6 0x0000000065902508 in win32_socket () from C:\Strawberry64_532\perl\bin\perl532.dll
#7 0x00000000658f8930 in perl532!PerlIO_init () from C:\Strawberry64_532\perl\bin\perl532.dll
#8 0x00000000658f7d09 in perl532!PerlIOBase_close () from C:\Strawberry64_532\perl\bin\perl532.dll
#9 0x00000000658f825e in perl532!PerlIOBuf_close () from C:\Strawberry64_532\perl\bin\perl532.dll
#10 0x00000000658f7d68 in perl532!PerlIOBase_close () from C:\Strawberry64_532\perl\bin\perl532.dll
#11 0x00000000658f7da2 in perl532!Perl_PerlIO_close () from C:\Strawberry64_532\perl\bin\perl532.dll
#12 0x00000000658aac5f in perl532!Perl_do_openn () from C:\Strawberry64_532\perl\bin\perl532.dll
#13 0x00000000658aaf5b in perl532!Perl_do_close () from C:\Strawberry64_532\perl\bin\perl532.dll
#14 0x000000006585bf17 in perl532!Perl_find_runcv () from C:\Strawberry64_532\perl\bin\perl532.dll
#15 0x00000000658dfdd6 in perl532!Perl_runops_standard () from C:\Strawberry64_532\perl\bin\perl532.dll
#16 0x0000000065890eb7 in perl_run () from C:\Strawberry64_532\perl\bin\perl532.dll
#17 0x00000000658f3ac8 in perl532!RunPerl () from C:\Strawberry64_532\perl\bin\perl532.dll
I think frame 6 is actually in my_close(), and the lack of debug symbols makes
that not show up here. win32_socket() is immediately before my_close() in the
source code.
Possible fixes
This trouble arises because my_close() assumes closesocket() will always
report WSAENOTSOCK for a non-socket. The first paragraph of the closesocket
documentation remarks says not to rely on that. A robust fix would be to
maintain a data structure recording the FDs Perl has assigned to sockets, then
call closesocket() only for FDs appearing therein. One alternative would be
to use strategies like https://stackoverflow.com/q/50979090 to evaluate
whether a descriptor is a socket. That alternative may be simpler or more
efficient, but it's harder to cite API documentation supporting an expectation
that it will continue to work.
Perl configuration
[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
category=core
severity=medium
---
Site configuration information for perl 5.32.1:
Configured by strawberry-perl at Sun Jan 24 15:01:28 2021.
Summary of my perl5 (revision 5 version 32 subversion 1) configuration:
Platform:
osname=MSWin32
osvers=10.0.19042.746
archname=MSWin32-x64-multi-thread
uname='Win32 strawberry-perl 5.32.1.1 #1 Sun Jan 24 15:00:15 2021 x64'
config_args='undef'
hint=recommended
useposix=true
d_sigaction=undef
useithreads=define
usemultiplicity=define
use64bitint=define
use64bitall=undef
uselongdouble=undef
usemymalloc=n
default_inc_excludes_dot=define
bincompat5005=undef
Compiler:
cc='gcc'
ccflags =' -DWIN32 -DWIN64 -D__USE_MINGW_ANSI_STDIO -DPERL_TEXTMODE_SCRIPTS -DPERL_IMPLICIT_CONTEXT -DPERL_IMPLICIT_SYS -DUSE_PERLIO -fwrapv -fno-strict-aliasing -mms-bitfields'
optimize='-s -O2'
cppflags='-DWIN32'
ccversion=''
gccversion='8.3.0'
gccosandvers=''
intsize=4
longsize=4
ptrsize=8
doublesize=8
byteorder=12345678
doublekind=3
d_longlong=define
longlongsize=8
d_longdbl=define
longdblsize=16
longdblkind=3
ivtype='long long'
ivsize=8
nvtype='double'
nvsize=8
Off_t='long long'
lseeksize=8
alignbytes=8
prototype=define
Linker and Libraries:
ld='g++'
ldflags ='-s -L"C:\STRAWB~1\perl\lib\CORE" -L"C:\STRAWB~1\c\lib"'
libpth=C:\STRAWB~1\c\lib C:\STRAWB~1\c\x86_64-w64-mingw32\lib C:\STRAWB~1\c\lib\gcc\x86_64-w64-mingw32\8.3.0
libs= -lmoldname -lkernel32 -luser32 -lgdi32 -lwinspool -lcomdlg32 -ladvapi32 -lshell32 -lole32 -loleaut32 -lnetapi32 -luuid -lws2_32 -lmpr -lwinmm -lversion -lodbc32 -lodbccp32 -lcomctl32
perllibs= -lmoldname -lkernel32 -luser32 -lgdi32 -lwinspool -lcomdlg32 -ladvapi32 -lshell32 -lole32 -loleaut32 -lnetapi32 -luuid -lws2_32 -lmpr -lwinmm -lversion -lodbc32 -lodbccp32 -lcomctl32
libc=
so=dll
useshrplib=true
libperl=libperl532.a
gnulibc_version=''
Dynamic Linking:
dlsrc=dl_win32.xs
dlext=xs.dll
d_dlsymun=undef
ccdlflags=' '
cccdlflags=' '
lddlflags='-mdll -s -L"C:\STRAWB~1\perl\lib\CORE" -L"C:\STRAWB~1\c\lib"'
---
@INC for perl 5.32.1:
C:/Strawberry64_532/perl/site/lib
C:/Strawberry64_532/perl/vendor/lib
C:/Strawberry64_532/perl/lib
---
Environment for perl 5.32.1:
HOME (unset)
LANG (unset)
LANGUAGE (unset)
LD_LIBRARY_PATH (unset)
LOGDIR (unset)
PATH=C:\Windows\system32;C:\Windows;C:\Windows\System32\Wbem;C:\Windows\System32\WindowsPowerShell\v1.0\;C:\Windows\System32\OpenSSH\;C:\ProgramData\GooGet;C:\Program Files\Google\Compute Engine\metadata_scripts;C:\Program Files (x86)\Google\Cloud SDK\google-cloud-sdk\bin;C:\Program Files\PowerShell\7\;C:\Program Files\Google\Compute Engine\sysprep;C:\Strawberry64_532\c\bin;C:\Strawberry64_532\perl\site\bin;C:\Strawberry64_532\perl\bin;C:\Users\noah\AppData\Local\Microsoft\WindowsApps;
PERL_BADLANG (unset)
SHELL (unset)