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

[perl #24269] 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 #24269] socket() call uses non-IFS providers causing subsequent print/read to hang or misbehave
Message ID:
rt-24269-66378.10.0224568227254@rt.perl.org
# New Ticket Created by  apm@atwss.com 
# Please include the string:  [perl #24269]
# in the subject line of all future correspondence about this issue. 
# <URL: http://rt.perl.org/rt2/Ticket/Display.html?id=24269 >


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