develooper Front page | perl.perl5.porters | Postings from October 2003

[perl #24268] socket() call uses non-IFS providers causing subsequent print/read to hang or misbehave

From:
perlbug-followup
Date:
October 22, 2003 20:04
Subject:
[perl #24268] socket() call uses non-IFS providers causing subsequent print/read to hang or misbehave
Message ID:
rt-24268-66373.19.7436534425192@rt.perl.org
# New Ticket Created by  apm@atwss.com 
# Please include the string:  [perl #24268]
# in the subject line of all future correspondence about this issue. 
# <URL: http://rt.perl.org/rt2/Ticket/Display.html?id=24268 >


This is a bug report for perl from apm@prog8,
generated with the help of perlbug 1.34 running under perl v5.8.1.


-----------------------------------------------------------------
How to reproduce:
1) install any non-IFS layered service provider on WinNT/Win2k/WinXP.
   You can get sample LSP from MS Platform SDK
2) run sample TCP/IP client and server from "perldoc perlipc"
3) server and client hang. This is NOT a bug in sample perl code

Desired result:
client prints server's response AND quits

Problem description:
socket() call selects first suitable service provider for given
address family/proto type/etc. non-IFS is selected first if it's 
installed. Next, you set SO_SYNCHRONOUS_NONALERT on socket and then
call print. The thing is that print (WriteFile() in win32) is
mapped to overlapped WSPSend() on socket, but it's not possible
to use overlapped IO after SO_SYNCHRONOUS_NONALERT unless
provider is IFS-compatible.

Fix:
socket() should be replaced with WSASocket() and provider lookup
must be done to find IFS-compatible provider. It's known for sure
that at least one provider (MSAFD) has IFS support.

Patch:
diff -ruN perl-5.8.1/win32/Makefile perl-5.8.1-new/win32/Makefile
--- perl-5.8.1/win32/Makefile	Thu Sep 25 14:14:19 2003
+++ perl-5.8.1-new/win32/Makefile	Thu Oct 23 10:19:49 2003
@@ -326,7 +326,7 @@
 

 # VC 6.0 can load the socket dll on demand.  Makes the test suite

 # run in about 10% less time.

-DELAYLOAD	= -DELAYLOAD:wsock32.dll -DELAYLOAD:shell32.dll delayimp.lib

+DELAYLOAD	= -DELAYLOAD:ws2_32.dll -DELAYLOAD:shell32.dll delayimp.lib

 !ENDIF

 

 ARCHDIR		= ..\lib\$(ARCHNAME)

@@ -408,7 +408,7 @@
 LIBBASEFILES	= $(CRYPT_LIB) \

 		oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib \

 		comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib \

-		netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib \

+		netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib \

 		version.lib

 

 # win64 doesn't have some libs

diff -ruN perl-5.8.1/win32/win32sck.c perl-5.8.1-new/win32/win32sck.c
--- perl-5.8.1/win32/win32sck.c	Tue Sep  2 16:42:10 2003
+++ perl-5.8.1-new/win32/win32sck.c	Wed Oct 22 16:03:40 2003
@@ -16,6 +16,11 @@
 #define Win32_Winsock
 #endif
 #include <windows.h>
+#include <ws2spi.h>
+/* winsock2.h overrides winsock.h but does not include the following*/
+#define SO_SYNCHRONOUS_NONALERT 0x20
+#define SO_OPENTYPE     0x7008
+
 #include "EXTERN.h"
 #include "perl.h"
 
@@ -399,6 +404,63 @@
     return r;
 }
 
+#ifdef USE_SOCKETS_AS_HANDLES
+#define WIN32_OPEN_SOCKET(af, type, protocol) open_ifs_socket(af, type, protocol)
+
+void
+convert_proto_info_w2a(WSAPROTOCOL_INFOW *in, WSAPROTOCOL_INFOA *out)
+{
+    memcpy(out, in, sizeof(WSAPROTOCOL_INFOA));
+    wcstombs(out->szProtocol, in->szProtocol, sizeof(out->szProtocol));
+}
+
+SOCKET
+open_ifs_socket(int af, int type, int protocol)
+{
+    unsigned long proto_buffers_len = 0;
+    int error_code;
+    SOCKET out = INVALID_SOCKET;
+
+    if (WSCEnumProtocols(NULL, NULL, &proto_buffers_len, &error_code) == SOCKET_ERROR
+        && error_code == WSAENOBUFS)
+    {
+        WSAPROTOCOL_INFOW *proto_buffers = (WSAPROTOCOL_INFOW *) malloc(proto_buffers_len);
+        int protocols_available = 0;       
+ 
+        if ((protocols_available = WSCEnumProtocols(NULL, proto_buffers, 
+            &proto_buffers_len, &error_code)) != SOCKET_ERROR)
+        {
+            int i;
+            for (i = 0; i < protocols_available; i++)
+            {
+                WSAPROTOCOL_INFOA proto_info;
+
+                if ((af != AF_UNSPEC && af != proto_buffers[i].iAddressFamily)
+                    || (type != proto_buffers[i].iSocketType)
+                    || (protocol != 0 && protocol != proto_buffers[i].iProtocol))
+                    continue;
+
+                if ((proto_buffers[i].dwServiceFlags1 & XP1_IFS_HANDLES) == 0)
+                    continue;
+
+                convert_proto_info_w2a(&(proto_buffers[i]), &proto_info);
+
+                out = WSASocket(af, type, protocol, &proto_info, 0, 0);
+                break;
+            }
+        }
+
+        if (proto_buffers)
+            free(proto_buffers);
+    }
+
+    return out;
+}
+
+#else
+#define WIN32_OPEN_SOCKET(af, type, protocol) socket(af, type, protocol)
+#endif
+
 SOCKET
 win32_socket(int af, int type, int protocol)
 {
@@ -408,7 +470,8 @@
     SOCKET_TEST(s = socket(af, type, protocol), INVALID_SOCKET);
 #else
     StartSockets();
-    if((s = socket(af, type, protocol)) == INVALID_SOCKET)
+
+    if((s = WIN32_OPEN_SOCKET(af, type, protocol)) == INVALID_SOCKET)
 	errno = WSAGetLastError();
     else
 	s = OPEN_SOCKET(s);
---(cut)---

[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
    category=core
    severity=medium
---
Site configuration information for perl v5.8.1:

Configured by apm at Wed Oct 22 12:26:52 2003.

Summary of my perl5 (revision 5 version 8 subversion 1) configuration:
  Platform:
    osname=MSWin32, osvers=4.0, archname=MSWin32-x86-multi-thread
    uname=''
    config_args='undef'
    hint=recommended, useposix=true, d_sigaction=undef
    usethreads=undef use5005threads=undef useithreads=define usemultiplicity=define
    useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
    use64bitint=undef use64bitall=undef uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cl', ccflags ='-nologo -Gf -W3 -Od -MD -Zi -DDEBUGGING -DWIN32 -D_CONSOLE -DNO_STRICT   -DPERL_IMPLICIT_CONTEXT -DPERL_IMPLICIT_SYS -DUSE_PERLIO -DPERL_MSVCRT_READFIX',
    optimize='-Od -MD -Zi -DDEBUGGING',
    cppflags='-DWIN32'
    ccversion='', gccversion='', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
    d_longlong=undef, longlongsize=8, d_longdbl=define, longdblsize=10
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='__int64', lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='link', ldflags ='-nologo -nodefaultlib -debug  -libpath:"f:\temp\perl\lib\CORE"  -machine:x86'
    libpth="c:\program files\microsoft visual studio\vc98\lib"
    libs=  oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib  comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib  netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib  version.lib odbc32.lib odbccp32.lib msvcrt.lib
    perllibs=  oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib  comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib  netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib  version.lib odbc32.lib odbccp32.lib msvcrt.lib
    libc=msvcrt.lib, so=dll, useshrplib=yes, libperl=perl58.lib
    gnulibc_version='undef'
  Dynamic Linking:
    dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' '
    cccdlflags=' ', lddlflags='-dll -nologo -nodefaultlib -debug  -libpath:"f:\temp\perl\lib\CORE"  -machine:x86'

Locally applied patches:
    

---
@INC for perl v5.8.1:
    F:/tmp/perl-5.8.1/lib
    .

---
Environment for perl v5.8.1:
    CYGWIN=tty
    HOME (unset)
    LANG (unset)
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=F:\tmp\perl-5.8.1;C:\Program Files\Far;C:\Python22\.;C:\Tcl\bin;e:\texmf\miktex\bin\;C:\Perl\bin;C:\WINNT\system32;C:\WINNT;C:\WINNT\System32\Wbem;C:\Program Files\doxygen\bin;C:\PROGRA~1\ATT\Graphviz\bin;C:\PROGRA~1\ATT\Graphviz\bin\tools;e:\Program Files\Rational\common;C:\program files\wise installation system;C:\Program Files\Rational\Quantify;C:\Program Files\Rational\Quantify\cache
    PERL_BADLANG (unset)
    SHELL (unset)




nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About