From: Nick Ing-Simmons Date: Wed, 21 May 2003 20:16:45 +0000 (+0000) Subject: Work-in-progress - do not integrate yet X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a9a28921a06508e1ec8a1da7fdf58c72faa64c96;p=p5sagit%2Fp5-mst-13.2.git Work-in-progress - do not integrate yet Experimental PerlIO_syslayer() [or sysread only at this point] 3 fails on a UNIX :perlio stack - warnings misses Filehandle F opened only for output (weird) - socketpair discovers that Unix_read() restarts on EINTR (gotcha) - lib/open fails to sysread() chars (a feature?) p4raw-id: //depot/perlio@19587 --- diff --git a/makedef.pl b/makedef.pl index 74773fb..1a6f571 100644 --- a/makedef.pl +++ b/makedef.pl @@ -812,6 +812,7 @@ my @layer_syms = qw( PerlIO_pop PerlIO_sv_dup PerlIO_perlio + PerlIO_syslayer Perl_PerlIO_clearerr Perl_PerlIO_close diff --git a/perlio.c b/perlio.c index 765882e..d0ed97a 100644 --- a/perlio.c +++ b/perlio.c @@ -430,14 +430,6 @@ PerlIO_findFILE(PerlIO *pio) #include #endif -/* - * Why is this here - not in perlio.h? RMB - */ -void PerlIO_debug(const char *fmt, ...) -#ifdef CHECK_FORMAT - __attribute__ ((__format__(__printf__, 1, 2))) -#endif -; void PerlIO_debug(const char *fmt, ...) @@ -1025,6 +1017,27 @@ PerlIO_layer_fetch(pTHX_ PerlIO_list_t *av, IV n, PerlIO_funcs *def) return def; } +PerlIO * +PerlIO_syslayer(pTHX_ PerlIO *f) +{ + if (PerlIOValid(f)) { + PerlIOl *l; + while (*PerlIONext(f)) { + f = PerlIONext(f); + } + l = *f; +#if 0 + Perl_warn(aTHX_ "syslayer %s",l->tab->name); +#endif + return f; + } + else { + SETERRNO(EBADF, SS_IVCHAN); + return NULL; + } +} + + IV PerlIOPop_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) { @@ -2008,6 +2021,10 @@ PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) f, PerlIOBase(f)->tab->name, (omode) ? omode : "(Null)", l->flags, PerlIO_modestr(f, temp)); #endif + if (l->next) { + l->flags |= l->next->flags & + (PERLIO_F_TTY | PERLIO_F_NOTREG | PERLIO_F_SOCKET); + } return 0; } @@ -2338,9 +2355,16 @@ static void PerlIOUnix_setfd(pTHX_ PerlIO *f, int fd, int imode) { PerlIOUnix *s = PerlIOSelf(f, PerlIOUnix); -#if defined(WIN32) + +#if 1 || defined(WIN32) || defined(HAS_SOCKET) && \ + (defined(PERL_SOCK_SYSREAD_IS_RECV) || \ + defined(PERL_SOCK_SYSWRITE_IS_SEND)) Stat_t st; if (PerlLIO_fstat(fd, &st) == 0) { +#if defined(WIN32) + /* WIN32 needs to know about non-regular files + as only regular files can be lseek()ed + */ if (!S_ISREG(st.st_mode)) { PerlIO_debug("%d is not regular file\n",fd); PerlIOBase(f)->flags |= PERLIO_F_NOTREG; @@ -2348,8 +2372,32 @@ PerlIOUnix_setfd(pTHX_ PerlIO *f, int fd, int imode) else { PerlIO_debug("%d _is_ a regular file\n",fd); } - } #endif + /* If read/write are to be mapped to recv/send we need + to know this is a socket. + Lifted from code in doio.c that handles socket detection on dup + */ +#ifndef PERL_MICRO + if (S_ISSOCK(st.st_mode)) + PerlIOBase(f)->flags |= PERLIO_F_SOCKET; + else if ( +#ifdef S_IFMT + !(st.st_mode & S_IFMT) +#else + !st.st_mode +#endif + ) { + char tmpbuf[256]; + Sock_size_t buflen = sizeof tmpbuf; + if (PerlSock_getsockname(fd, (struct sockaddr *)tmpbuf, &buflen) >= 0 + || errno != ENOTSOCK) + PerlIOBase(f)->flags |= PERLIO_F_SOCKET; /* some OS's return 0 on fstat()ed socket */ + /* but some return 0 for streams too, sigh */ + } +#endif /* !PERL_MICRO */ + } +#endif /* HAS_SOCKET ... */ + s->fd = fd; s->oflags = imode; PerlIOUnix_refcnt_inc(fd); @@ -2450,7 +2498,16 @@ PerlIOUnix_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) return 0; } while (1) { - SSize_t len = PerlLIO_read(fd, vbuf, count); + SSize_t len; +#ifdef PERL_SOCK_SYSREAD_IS_RECV + if (PerlIOBase(f)->flags & PERLIO_F_SOCKET) { + len = PerlSock_recv(fd, vbuf, count, 0); + } + else +#endif + { + len = PerlLIO_read(fd, vbuf, count); + } if (len >= 0 || errno != EINTR) { if (len < 0) { if (errno != EAGAIN) { diff --git a/perlio.h b/perlio.h index 4d88439..1b7ac36 100644 --- a/perlio.h +++ b/perlio.h @@ -371,9 +371,15 @@ extern int PerlIO_intmode2str(int rawmode, char *mode, int *writing); #ifdef PERLIO_LAYERS extern void PerlIO_cleanup(pTHX); -extern void PerlIO_debug(const char *fmt, ...); +extern void PerlIO_debug(const char *fmt, ...) +#ifdef CHECK_FORMAT + __attribute__ ((__format__(__printf__, 1, 2))) +#endif +; + typedef struct PerlIO_list_s PerlIO_list_t; +extern PerlIO *PerlIO_syslayer(pTHX_ PerlIO *); #endif diff --git a/perliol.h b/perliol.h index 47fe6fc..9833492 100644 --- a/perliol.h +++ b/perliol.h @@ -88,7 +88,8 @@ struct _PerlIO { #define PERLIO_F_OPEN 0x00200000 #define PERLIO_F_FASTGETS 0x00400000 #define PERLIO_F_TTY 0x00800000 -#define PERLIO_F_NOTREG 0x01000000 +#define PERLIO_F_NOTREG 0x01000000 +#define PERLIO_F_SOCKET 0x02000000 #define PerlIOBase(f) (*(f)) #define PerlIOSelf(f,type) ((type *)PerlIOBase(f)) diff --git a/pp_sys.c b/pp_sys.c index ae6d986..c1ff341 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -1527,6 +1527,7 @@ PP(pp_sysread) bool charstart = FALSE; STRLEN charskip = 0; STRLEN skip = 0; + PerlIO *pio; gv = (GV*)*++MARK; if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD) @@ -1565,7 +1566,19 @@ PP(pp_sysread) SETERRNO(EBADF,RMS_IFI); goto say_undef; } - if ((fp_utf8 = PerlIO_isutf8(IoIFP(io))) && !IN_BYTES) { + pio = IoIFP(io); +#ifdef PERLIO_LAYERS + if (PL_op->op_type == OP_SYSREAD) { + /* sysread happens further down the stack + and we need isutf8 of that layer + */ + pio = PerlIO_syslayer(aTHX_ pio); + if (!pio) { + goto say_undef; + } + } +#endif + if ((fp_utf8 = PerlIO_isutf8(pio)) && !IN_BYTES) { buffer = SvPVutf8_force(bufsv, blen); /* UTF8 may not have been set if they are all low bytes */ SvUTF8_on(bufsv); @@ -1595,7 +1608,7 @@ PP(pp_sysread) #endif buffer = SvGROW(bufsv, (STRLEN)(length+1)); /* 'offset' means 'flags' here */ - count = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset, + count = PerlSock_recvfrom(PerlIO_fileno(pio), buffer, length, offset, (struct sockaddr *)namebuf, &bufsize); if (count < 0) RETPUSHUNDEF; @@ -1642,20 +1655,22 @@ PP(pp_sysread) } buffer = buffer + offset; +#ifndef PERLIO_LAYERS if (PL_op->op_type == OP_SYSREAD) { #ifdef PERL_SOCK_SYSREAD_IS_RECV if (IoTYPE(io) == IoTYPE_SOCKET) { - count = PerlSock_recv(PerlIO_fileno(IoIFP(io)), + count = PerlSock_recv(PerlIO_fileno(pio), buffer, length, 0); } else #endif { - count = PerlLIO_read(PerlIO_fileno(IoIFP(io)), + count = PerlLIO_read(PerlIO_fileno(pio), buffer, length); } } else +#endif #ifdef HAS_SOCKET__bad_code_maybe if (IoTYPE(io) == IoTYPE_SOCKET) { char namebuf[MAXPATHLEN]; @@ -1664,15 +1679,15 @@ PP(pp_sysread) #else bufsize = sizeof namebuf; #endif - count = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, 0, + count = PerlSock_recvfrom(PerlIO_fileno(pio), buffer, length, 0, (struct sockaddr *)namebuf, &bufsize); } else #endif { - count = PerlIO_read(IoIFP(io), buffer, length); + count = PerlIO_read(pio, buffer, length); /* PerlIO_read() - like fread() returns 0 on both error and EOF */ - if (count == 0 && PerlIO_error(IoIFP(io))) + if (count == 0 && PerlIO_error(pio)) count = -1; } if (count < 0) {