diff options
| -rw-r--r-- | perlio.c | 163 |
1 files changed, 125 insertions, 38 deletions
@@ -2684,13 +2684,86 @@ PerlIOStdio_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags) return f; } +static int +PerlIOStdio_invalidate_fileno(pTHX_ FILE *f) +{ + /* XXX this could use PerlIO_canset_fileno() and + * PerlIO_set_fileno() support from Configure + */ +# if defined(__GLIBC__) + /* There may be a better way for GLIBC: + - libio.h defines a flag to not close() on cleanup + */ + f->_fileno = -1; + return 1; +# elif defined(__sun__) +# if defined(_LP64) + /* On solaris, if _LP64 is defined, the FILE structure is this: + * + * struct FILE { + * long __pad[16]; + * }; + * + * It turns out that the fd is stored in the top 32 bits of + * file->__pad[4]. The lower 32 bits contain flags. file->pad[5] appears + * to contain a pointer or offset into another structure. All the + * remaining fields are zero. + * + * We set the top bits to -1 (0xFFFFFFFF). + */ + f->__pad[4] |= 0xffffffff00000000L; + assert(fileno(f) == 0xffffffff); +# else /* !defined(_LP64) */ + /* _file is just a unsigned char :-( + Not clear why we dup() rather than using -1 + even if that would be treated as 0xFF - so will + a dup fail ... + */ + f->_file = PerlLIO_dup(fd); +# endif /* defined(_LP64) */ + return 1; +# elif defined(__hpux) + f->__fileH = 0xff; + f->__fileL = 0xff; + return 1; +# elif defined(_AIX) + f->_file = -1; + return 1; +# elif defined(__FreeBSD__) + /* There may be a better way on FreeBSD: + - we could insert a dummy func in the _close function entry + f->_close = (int (*)(void *)) dummy_close; + */ + f->_file = -1; + return 1; +# elif defined(__CYGWIN__) + /* There may be a better way on CYGWIN: + - we could insert a dummy func in the _close function entry + f->_close = (int (*)(void *)) dummy_close; + */ + f->_file = -1; + return 1; +# elif defined(WIN32) +# if defined(__BORLANDC__) + f->fd = PerlLIO_dup(fileno(f)); +# else + f->_file = -1; +# endif + return 1; +# else +#if 0 + /* Sarathy's code did this - we fall back to a dup/dup2 hack + (which isn't thread safe) instead + */ +# error "Don't know how to set FILE.fileno on your platform" +#endif + return 0; +# endif +} + IV PerlIOStdio_close(pTHX_ PerlIO *f) { -#ifdef SOCKS5_VERSION_NAME - int optval; - Sock_size_t optlen = sizeof(int); -#endif FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio; if (!stdio) { errno = EBADF; @@ -2698,52 +2771,66 @@ PerlIOStdio_close(pTHX_ PerlIO *f) } else { int fd = fileno(stdio); - int dupfd = -1; + int socksfd = 0; + int invalidate = 0; IV result; + int saveerr = 0; + int dupfd = 0; +#ifdef SOCKS5_VERSION_NAME + /* Socks lib overrides close() but stdio isn't linked to + that library (though we are) - so we must call close() + on sockets on stdio's behalf. + */ + int optval; + Sock_size_t optlen = sizeof(int); + if (getsockopt(fd, SOL_SOCKET, SO_TYPE, (void *) &optval, &optlen) == 0) { + socksfd = 1; + invalidate = 1; + } +#endif if (PerlIOUnix_refcnt_dec(fd) > 0) { /* File descriptor still in use */ - if (fd < 3) { - /* For STD* handles don't close the stdio at all */ + invalidate = 1; + socksfd = 0; + } + if (invalidate) { + /* For STD* handles don't close the stdio at all + this is because we have shared the FILE * too + */ + if (stdio == stdin) { + /* Some stdios are buggy fflush-ing inputs */ + return 0; + } + else if (stdio == stdout || stdio == stderr) { return PerlIO_flush(f); } - else { - /* Tricky - must fclose(stdio) to free memory but not close(fd) */ -#ifdef USE_THREADS - /* Sarathy pointed out that another thread could reuse - fd after fclose() but before we dup2() below - so take out a MUTEX to shut them out - */ - MUTEX_LOCK(&PerlIO_mutex); -#endif + /* Tricky - must fclose(stdio) to free memory but not close(fd) + Use Sarathy's trick from maint-5.6 to invalidate the + fileno slot of the FILE * + */ + saveerr = errno; + if (!(invalidate = PerlIOStdio_invalidate_fileno(aTHX_ stdio))) { dupfd = PerlLIO_dup(fd); } - } - result = ( -#ifdef SOCKS5_VERSION_NAME - (getsockopt - (PerlIO_fileno(f), SOL_SOCKET, SO_TYPE, (void *) &optval, - &optlen) < - 0) ? PerlSIO_fclose(stdio) : close(PerlIO_fileno(f)) -#else - PerlSIO_fclose(stdio) -#endif - ); - if (dupfd >= 0) { - /* We need to restore fd from the saved copy */ - if (PerlLIO_dup2(dupfd,fd) != fd) - result = -1; -#ifdef USE_THREADS - MUTEX_UNLOCK(&PerlIO_mutex); -#endif - if (PerlLIO_close(dupfd) != 0) - result = -1; + } + result = PerlSIO_fclose(stdio); + /* We treat EBADF from stdio as success if we invalidated */ + if (invalidate && result != 0 && errno == EBADF) { + errno = saveerr; + result = 0; + } + if (socksfd) { + /* in SOCKS case let close() determine return value */ + result = close(fd); + } + if (dupfd) { + PerlLIO_dup2(dupfd,fd); + close(dupfd); } return result; } } - - SSize_t PerlIOStdio_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) { |