diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 4183474c537b..1953ca6e5524 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -365,9 +365,19 @@ L section. =over 4 -=item XXX-some-platform +=item Windows -XXX +=over 4 + +=item * + +C no longer creates broken sockets. [GH #20920] + +=item * + +Closing a busy pipe could cause Perl to hang. [GH #19963] + +=back =back diff --git a/win32/win32.c b/win32/win32.c index 435d160eda0f..bc0cf0f74261 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -38,6 +38,7 @@ #include #include #include +#include /* #include "config.h" */ @@ -156,9 +157,6 @@ static void translate_to_errno(void); START_EXTERN_C HANDLE w32_perldll_handle = INVALID_HANDLE_VALUE; char w32_module_name[MAX_PATH+1]; -#ifdef WIN32_DYN_IOINFO_SIZE -Size_t w32_ioinfo_size;/* avoid 0 extend op b4 mul, otherwise could be a U8 */ -#endif END_EXTERN_C static OSVERSIONINFO g_osver = {0, 0, 0, 0, 0, ""}; @@ -3313,7 +3311,7 @@ win32_freopen(const char *path, const char *mode, FILE *stream) DllExport int win32_fclose(FILE *pf) { - return my_fclose(pf); /* defined in win32sck.c */ + return fclose(pf); } DllExport int @@ -3913,13 +3911,10 @@ win32_open(const char *path, int flag, ...) return open(PerlDir_mapA(path), flag, pmode); } -/* close() that understands socket */ -extern int my_close(int); /* in win32sck.c */ - DllExport int win32_close(int fd) { - return my_close(fd); + return _close(fd); } DllExport int @@ -5172,6 +5167,172 @@ ansify_path(void) win32_free(wide_path); } +/* This hooks a function that is imported by the specified module. The hook is + * local to that module. */ +static bool +win32_hook_imported_function_in_module( + HMODULE module, LPCSTR fun_name, FARPROC hook_ptr +) +{ + ULONG_PTR image_base = (ULONG_PTR)module; + PIMAGE_DOS_HEADER dos_header = (PIMAGE_DOS_HEADER)image_base; + PIMAGE_NT_HEADERS nt_headers + = (PIMAGE_NT_HEADERS)(image_base + dos_header->e_lfanew); + PIMAGE_OPTIONAL_HEADER opt_header = &nt_headers->OptionalHeader; + + PIMAGE_DATA_DIRECTORY data_dir = opt_header->DataDirectory; + DWORD data_dir_len = opt_header->NumberOfRvaAndSizes; + + BOOL is_idt_present = data_dir_len > IMAGE_DIRECTORY_ENTRY_IMPORT + && data_dir[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress != 0; + + if (!is_idt_present) + return FALSE; + + BOOL found = FALSE; + + /* Import Directory Table */ + PIMAGE_IMPORT_DESCRIPTOR idt = (PIMAGE_IMPORT_DESCRIPTOR)( + image_base + data_dir[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress + ); + + for (; idt->Name != 0; ++idt) { + /* Import Lookup Table */ + PIMAGE_THUNK_DATA ilt + = (PIMAGE_THUNK_DATA)(image_base + idt->OriginalFirstThunk); + /* Import Address Table */ + PIMAGE_THUNK_DATA iat + = (PIMAGE_THUNK_DATA)(image_base + idt->FirstThunk); + + ULONG_PTR address_of_data; + for (; address_of_data = ilt->u1.AddressOfData; ++ilt, ++iat) { + /* Ordinal imports are quite rare, so skipping them will most likely + * not cause any problems. */ + BOOL is_ordinal + = address_of_data >> ((sizeof(address_of_data) * 8) - 1); + + if (is_ordinal) + continue; + + LPCSTR name = ( + (PIMAGE_IMPORT_BY_NAME)(image_base + address_of_data) + )->Name; + + if (strEQ(name, fun_name)) { + DWORD old_protect = 0; + BOOL succ = VirtualProtect( + &iat->u1.Function, sizeof(iat->u1.Function), PAGE_READWRITE, + &old_protect + ); + if (!succ) + return FALSE; + + iat->u1.Function = (ULONG_PTR)hook_ptr; + found = TRUE; + + VirtualProtect( + &iat->u1.Function, sizeof(iat->u1.Function), old_protect, + &old_protect + ); + break; + } + } + } + + return found; +} + +typedef NTSTATUS (NTAPI *pNtQueryInformationFile_t)(HANDLE, PIO_STATUS_BLOCK, PVOID, ULONG, ULONG); +pNtQueryInformationFile_t pNtQueryInformationFile = NULL; + +typedef BOOL (WINAPI *pCloseHandle)(HANDLE h); +static pCloseHandle CloseHandle_orig; + +/* CloseHandle() that supports sockets. CRT uses mutexes during file operations, + * so the lack of thread safety in this function isn't a problem. */ +static BOOL WINAPI +my_CloseHandle(HANDLE h) +{ + /* In theory, passing a non-socket handle to closesocket() is fine. It + * should return a WSAENOTSOCK error, which is easy to recover from. + * However, we should avoid doing that because it's not that simple in + * practice. For instance, it can deadlock on a handle to a stuck pipe (see: + * https://github.com/Perl/perl5/issues/19963). + * + * There's no foolproof way to tell if a handle is a socket (mostly because + * of the non-IFS sockets), but in some cases we can tell if a handle + * is definitely *not* a socket. + */ + + /* GetFileType() always returns FILE_TYPE_PIPE for sockets. */ + BOOL maybe_socket = (GetFileType(h) == FILE_TYPE_PIPE); + + if (maybe_socket && pNtQueryInformationFile) { + IO_STATUS_BLOCK isb; + struct { + ULONG name_len; + WCHAR name[100]; + } volume = {0}; + + /* There are many ways to tell a named pipe from a socket, but almost + * all of them can deadlock on a handle to a stuck pipe (like in the + * bug ticket mentioned above). According to my tests, + * FileVolumeNameInfomation is the only relevant function that doesn't + * suffer from this problem. + * + * It's undocumented and it requires Windows 10, so on older systems + * we always pass pipes to closesocket(). + */ + NTSTATUS s = pNtQueryInformationFile( + h, &isb, &volume, sizeof(volume), 58 /* FileVolumeNameInformation */ + ); + if (NT_SUCCESS(s)) { + maybe_socket = (_wcsnicmp( + volume.name, L"\\Device\\NamedPipe", C_ARRAY_LENGTH(volume.name) + ) != 0); + } + } + + if (maybe_socket) + if (closesocket((SOCKET)h) == 0) + return TRUE; + else if (WSAGetLastError() != WSAENOTSOCK) + return FALSE; + + return CloseHandle_orig(h); +} + +/* Hook CloseHandle() inside CRT so its functions like _close() or + * _dup2() can close sockets properly. */ +static void +win32_hook_closehandle_in_crt() +{ + /* Get the handle to the CRT module basing on the address of _close() + * function. */ + HMODULE crt_handle; + BOOL succ = GetModuleHandleExA( + GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS + | GET_MODULE_HANDLE_EX_FLAG_UNCHANGED_REFCOUNT, (LPCSTR)_close, + &crt_handle + ); + if (!succ) + return; + + CloseHandle_orig = (pCloseHandle)GetProcAddress( + GetModuleHandleA("kernel32.dll"), "CloseHandle" + ); + if (!CloseHandle_orig) + return; + + win32_hook_imported_function_in_module( + crt_handle, "CloseHandle", (FARPROC)my_CloseHandle + ); + + pNtQueryInformationFile = (pNtQueryInformationFile_t)GetProcAddress( + GetModuleHandleA("ntdll.dll"), "NtQueryInformationFile" + ); +} + void Perl_win32_init(int *argcp, char ***argvp) { @@ -5208,17 +5369,7 @@ Perl_win32_init(int *argcp, char ***argvp) g_osver.dwOSVersionInfoSize = sizeof(g_osver); GetVersionEx(&g_osver); -#ifdef WIN32_DYN_IOINFO_SIZE - { - Size_t ioinfo_size = _msize((void*)__pioinfo[0]);; - if((SSize_t)ioinfo_size <= 0) { /* -1 is err */ - fprintf(stderr, "panic: invalid size for ioinfo\n"); /* no interp */ - exit(1); - } - ioinfo_size /= IOINFO_ARRAY_ELTS; - w32_ioinfo_size = ioinfo_size; - } -#endif + win32_hook_closehandle_in_crt(); ansify_path(); diff --git a/win32/win32.h b/win32/win32.h index c184b9f5f550..77e4f06279a2 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -426,7 +426,6 @@ DllExport void win32_get_child_IO(child_IO_table* ptr); DllExport HWND win32_create_message_window(void); DllExport int win32_async_check(pTHX); -extern int my_fclose(FILE *); extern char * win32_get_privlib(WIN32_NO_REGISTRY_M_(const char *pl) STRLEN *const len); extern char * win32_get_sitelib(const char *pl, STRLEN *const len); extern char * win32_get_vendorlib(const char *pl, STRLEN *const len); @@ -566,83 +565,6 @@ void win32_wait_for_children(pTHX); # define PERL_WAIT_FOR_CHILDREN win32_wait_for_children(aTHX) #endif -/* The following ioinfo struct manipulations had been removed but were - * reinstated to fix RT#120091/118059. However, they do not work with - * the rewritten CRT in VS2015 so they are removed once again for VS2015 - * onwards, which will therefore suffer from the reintroduction of the - * close socket bug. */ -#if (!defined(_MSC_VER)) || (defined(_MSC_VER) && _MSC_VER < 1900) - -#ifdef PERL_CORE - -/* C doesn't like repeat struct definitions */ -#if defined(__MINGW32__) && (__MINGW32_MAJOR_VERSION>=3) -# undef _CRTIMP -#endif -#ifndef _CRTIMP -# define _CRTIMP __declspec(dllimport) -#endif - -#ifndef __MINGW32__ -/* size of ioinfo struct is determined at runtime */ -# define WIN32_DYN_IOINFO_SIZE -#endif - -#ifndef WIN32_DYN_IOINFO_SIZE -/* - * Control structure for lowio file handles - */ -typedef struct { - intptr_t osfhnd;/* underlying OS file HANDLE */ - char osfile; /* attributes of file (e.g., open in text mode?) */ - char pipech; /* one char buffer for handles opened on pipes */ - int lockinitflag; - CRITICAL_SECTION lock; -} ioinfo; -#else -typedef intptr_t ioinfo; -#endif - -/* - * Array of arrays of control structures for lowio files. - */ -EXTERN_C _CRTIMP ioinfo* __pioinfo[]; - -/* - * Definition of IOINFO_L2E, the log base 2 of the number of elements in each - * array of ioinfo structs. - */ -#define IOINFO_L2E 5 - -/* - * Definition of IOINFO_ARRAY_ELTS, the number of elements in ioinfo array - */ -#define IOINFO_ARRAY_ELTS (1 << IOINFO_L2E) - -/* - * Access macros for getting at an ioinfo struct and its fields from a - * file handle - */ -#ifdef WIN32_DYN_IOINFO_SIZE -# define _pioinfo(i) ((intptr_t *) \ - (((Size_t)__pioinfo[(i) >> IOINFO_L2E])/* * to head of array ioinfo [] */\ - /* offset to the head of a particular ioinfo struct */ \ - + (((i) & (IOINFO_ARRAY_ELTS - 1)) * w32_ioinfo_size)) \ - ) -/* first slice of ioinfo is always the OS handle */ -# define _osfhnd(i) (*(_pioinfo(i))) -#else -# define _pioinfo(i) (__pioinfo[(i) >> IOINFO_L2E] + ((i) & (IOINFO_ARRAY_ELTS - 1))) -# define _osfhnd(i) (_pioinfo(i)->osfhnd) -#endif - -/* since we are not doing a dup2(), this works fine */ -#define _set_osfhnd(fh, osfh) (void)(_osfhnd(fh) = (intptr_t)osfh) - -#endif /* PERL_CORE */ - -#endif /* !defined(_MSC_VER) || _MSC_VER<1900 */ - /* IO.xs and POSIX.xs define PERLIO_NOT_STDIO to 1 */ #if defined(PERL_EXT_IO) || defined(PERL_EXT_POSIX) #undef PERLIO_NOT_STDIO diff --git a/win32/win32sck.c b/win32/win32sck.c index f08b7bea295b..4edd1407a4ba 100644 --- a/win32/win32sck.c +++ b/win32/win32sck.c @@ -632,80 +632,6 @@ win32_socket(int af, int type, int protocol) return s; } -/* - * close RTL fd while respecting sockets - * added as temporary measure until PerlIO has real - * Win32 native layer - * -- BKS, 11-11-2000 -*/ - -int my_close(int fd) -{ - int osf; - osf = TO_SOCKET(fd);/* Get it now before it's gone! */ - if (osf != -1) { - int err; - err = closesocket(osf); - if (err == 0) { -#ifdef _set_osfhnd - assert(_osfhnd(fd) == osf); /* catch a bad ioinfo struct def */ - /* don't close freed handle */ - _set_osfhnd(fd, INVALID_HANDLE_VALUE); - return close(fd); -#else - (void)close(fd); /* handle already closed, ignore error */ - return 0; -#endif - } - else if (err == SOCKET_ERROR) { - int wsaerr = WSAGetLastError(); - err = convert_wsa_error_to_errno(wsaerr); - if (err != ENOTSOCK) { - (void)close(fd); - errno = err; - SetLastError(wsaerr); - return EOF; - } - } - } - return close(fd); -} - -#undef fclose -int -my_fclose (FILE *pf) -{ - int osf; - osf = TO_SOCKET(win32_fileno(pf));/* Get it now before it's gone! */ - if (osf != -1) { - int err; - win32_fflush(pf); - err = closesocket(osf); - if (err == 0) { -#ifdef _set_osfhnd - assert(_osfhnd(win32_fileno(pf)) == osf); /* catch a bad ioinfo struct def */ - /* don't close freed handle */ - _set_osfhnd(win32_fileno(pf), INVALID_HANDLE_VALUE); - return fclose(pf); -#else - (void)fclose(pf); /* handle already closed, ignore error */ - return 0; -#endif - } - else if (err == SOCKET_ERROR) { - int wsaerr = WSAGetLastError(); - err = convert_wsa_error_to_errno(wsaerr); - if (err != ENOTSOCK) { - (void)fclose(pf); - errno = err; - SetLastError(wsaerr); - return EOF; - } - } - } - return fclose(pf); -} - struct hostent * win32_gethostbyaddr(const char *addr, int len, int type) {