[perl #46309] Buffer overflow in win32_select() (PATCH included)  # New Ticket Created by  Risto Kankkunen  # Please include the string:  [perl #46309] # in the subject line of all future correspondence about this issue.  #  This is a bug report for perl from jztov.famrtsomr@f-secure.com, generated with the help of perlbug 1.35 running under perl v5.8.7. ----------------------------------------------------------------- I've found a nasty buffer overflow problem in win32_select() function that has made our product, which is using embedded Perl, very unreliable. We are currently using version 5.8.7, but I have checked that the problematic code is the same in 5.8.8. The problem happens, when some of the select() sets are not specified. In this case the code uses a dummy variable in place of the actual bit vector: win32/win32sck.c:282: > int > win32_select(int nfds, Perl_fd_set* rd, Perl_fd_set* wr, Perl_fd_set* ex, > const struct timeval* timeout) > { >     int r; > #ifdef USE_SOCKETS_AS_HANDLES >    Perl_fd_set dummy; win32/win32sck.c:304: >     if (!rd) > 	rd = &dummy, prd = NULL; Perl_fd_set is defined in win32/include/sys/socket.h:26 as: > #ifndef PERL_FD_SETSIZE > #define PERL_FD_SETSIZE		64 > #endif > > #define PERL_BITS_PER_BYTE	8 > #define	PERL_NFDBITS		(sizeof(Perl_fd_mask)*PERL_BITS_PER_BYTE) > > typedef int			Perl_fd_mask; > > typedef struct	Perl_fd_set { >     Perl_fd_mask bits[(PERL_FD_SETSIZE+PERL_NFDBITS-1)/PERL_NFDBITS]; > }				Perl_fd_set; If a socket number exceeds 63, this code writes over the end of dummy, destroying some local variables, the return address and so on: win32/win32sck.c:334: >     for (i = 0; i < nfds; i++) { > 	fd = TO_SOCKET(i); > 	if (PERL_FD_ISSET(i,rd) && !FD_ISSET(fd, &nrd)) > 	    PERL_FD_CLR(i,rd); You can easily repro the problem with the attached socketcrash.pl script. I have attached a patch that fixes the buffer overflow by eliminating the dummy variable. Regards, Risto Kankkunen ~~~ socketcrash.pl ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ use strict; use warnings; use IO::Socket; sub fhbits { 	my @fhlist = @_; 	my($bits)=""; 	vec($bits,fileno($_),1) = 1 for (@fhlist); 	return $bits; } my @handles = (); 	for (1..2000) { 	my $handle = new IO::Socket( 		Domain=>AF_INET, 		Proto=>"udp", 		PeerAddr=>"127.0.0.2:8888" 	) or die; 	 	push(@handles, $handle); } printf "handles=%d-%d\\n", fileno($handles[0]), fileno($handles[-1]); my $rin = fhbits(@handles); my ($rout, $wout, $eout); my ($count, $timeleft) = select($rout=$rin, $wout=undef, $eout=undef, 1); print "count=$count\\n"; print "timeleft=$timeleft\\n"; printf "rin =%*v08b\\n", " " , $rin; printf "rout=%*v08b\\n", " " , $rout || 0; printf "wout=%*v08b\\n", " " , $wout || 0; printf "eout=%*v08b\\n", " " , $eout || 0; ~~~ win32_select.patch ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Index: perl/src/win32/win32sck.c =================================================================== --- perl/src/win32/win32sck.c	(revision 3794) +++ perl/src/win32/win32sck.c	(working copy) @@ -287,9 +287,8 @@   {       int r;   #ifdef USE_SOCKETS_AS_HANDLES -    Perl_fd_set dummy;       int i, fd, save_errno = errno; -    FD_SET nrd, nwr, nex, *prd, *pwr, *pex; +    FD_SET nrd, nwr, nex;       /* winsock seems incapable of dealing with all three null fd_sets,        * so do the (millisecond) sleep as a special case @@ -303,44 +302,31 @@   	return 0;       }       StartSockets(); -    PERL_FD_ZERO(&dummy); -    if (!rd) -	rd = &dummy, prd = NULL; -    else -	prd = &nrd -    if (!wr) -	wr = &dummy, pwr = NULL; -    else -	pwr = &nwr -    if (!ex) -	ex = &dummy, pex = NULL; -    else -	pex = &nex       FD_ZERO(&nrd);       FD_ZERO(&nwr);       FD_ZERO(&nex);       for (i = 0; i < nfds; i++) {   	fd = TO_SOCKET(i); -	if (PERL_FD_ISSET(i,rd)) +	if (rd && PERL_FD_ISSET(i,rd))   	    FD_SET((unsigned)fd, &nrd); -	if (PERL_FD_ISSET(i,wr)) +	if (wr && PERL_FD_ISSET(i,wr))   	    FD_SET((unsigned)fd, &nwr); -	if (PERL_FD_ISSET(i,ex)) +	if (ex && PERL_FD_ISSET(i,ex))   	    FD_SET((unsigned)fd, &nex);       }       errno = save_errno; -    SOCKET_TEST_ERROR(r = select(nfds, prd, pwr, pex, timeout)); +    SOCKET_TEST_ERROR(r = select(nfds, &nrd, &nwr, &nex, timeout));       save_errno = errno;       for (i = 0; i < nfds; i++) {   	fd = TO_SOCKET(i); -	if (PERL_FD_ISSET(i,rd) && !FD_ISSET(fd, &nrd)) +	if (rd && PERL_FD_ISSET(i,rd) && !FD_ISSET(fd, &nrd))   	    PERL_FD_CLR(i,rd); -	if (PERL_FD_ISSET(i,wr) && !FD_ISSET(fd, &nwr)) +	if (wr && PERL_FD_ISSET(i,wr) && !FD_ISSET(fd, &nwr))   	    PERL_FD_CLR(i,wr); -	if (PERL_FD_ISSET(i,ex) && !FD_ISSET(fd, &nex)) +	if (ex && PERL_FD_ISSET(i,ex) && !FD_ISSET(fd, &nex))   	    PERL_FD_CLR(i,ex);       }       errno = save_errno; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ----------------------------------------------------------------- --- Flags:      category=core      severity=high --- Site configuration information for perl v5.8.7: Configured by kankri at Mon Oct 30 15:14:16 2006. Summary of my perl5 (revision 5 version 8 subversion 7) configuration:    Platform:      osname=MSWin32, osvers=5.1, archname=MSWin32-x86-multi-thread      uname=''      config_args='undef'      hint=recommended, useposix=true, d_sigaction=undef      usethreads=define 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 -MD -Zi -DNDEBUG -O1 -DWIN32 -D_CONSOLE -DNO_STRICT -DHAVE_DES_FCRYPT  -DPERL_NO_EXIT -DPERL_IMPLICIT_CONTEXT -DPERL_IMPLICIT_SYS -DUSE_PERLIO -DPERL_MSVCRT_READFIX',      optimize='-MD -Zi -DNDEBUG -O1',      cppflags='-DWIN32'      ccversion='12.00.8804', 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 -opt:ref,icf -libpath:"c:\\fs-perl\\lib\\CORE"  -machine:x86'      libpth=\\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 ws2_32.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 ws2_32.lib mpr.lib winmm.lib version.lib odbc32.lib odbccp32.lib msvcrt.lib      libc=msvcrt.lib, so=dll, useshrplib=yes, libperl=fspl58.lib      gnulibc_version='undef'    Dynamic Linking:      dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' '      cccdlflags=' ', lddlflags='-dll -nologo -nodefaultlib -debug -opt:ref,icf  -libpath:"c:\\fs-perl\\lib\\CORE"  -machine:x86' Locally applied patches: --- @INC for perl v5.8.7:      C:/fs-perl/lib      C:/fs-perl/site/lib      . --- Environment for perl v5.8.7:      HOME (unset)      LANG (unset)      LANGUAGE (unset)      LD_LIBRARY_PATH (unset)      LOGDIR (unset)      PATH=      PERL_BADLANG (unset)      SHELL (unset)