X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doio.c;h=62b7de9fb54eef6959b21c2955d1a91a7216be92;hb=64f14228217abb04a437553319642d6e7a82a3e8;hp=af51cd866e6e7da639d0c2a2bf7fc1be0b2b4bf8;hpb=7612125845c02d2d99c5f292ac704179da10f10e;p=p5sagit%2Fp5-mst-13.2.git diff --git a/doio.c b/doio.c index af51cd8..62b7de9 100644 --- a/doio.c +++ b/doio.c @@ -1,6 +1,6 @@ /* doio.c * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -34,7 +34,11 @@ #endif #ifdef I_UTIME -#include +# ifdef _MSC_VER +# include +# else +# include +# endif #endif #ifdef I_FCNTL #include @@ -62,6 +66,15 @@ # endif #endif +/* Put this after #includes because defines _XOPEN_*. */ +#ifndef Sock_size_t +# if _XOPEN_VERSION >= 5 || defined(_XOPEN_SOURCE_EXTENDED) || defined(__GLIBC__) +# define Sock_size_t Size_t +# else +# define Sock_size_t int +# endif +#endif + bool do_open(gv,name,len,as_raw,rawmode,rawperm,supplied_fp) GV *gv; @@ -118,9 +131,16 @@ PerlIO *supplied_fp; if (fd == -1) fp = NULL; else { - fp = PerlIO_fdopen(fd, ((result == 0) ? "r" - : (result == 1) ? "w" - : "r+")); + char *fpmode; + if (result == 0) + fpmode = "r"; +#ifdef O_APPEND + else if (rawmode & O_APPEND) + fpmode = (result == 1) ? "a" : "a+"; +#endif + else + fpmode = (result == 1) ? "w" : "r+"; + fp = PerlIO_fdopen(fd, fpmode); if (!fp) close(fd); } @@ -277,9 +297,10 @@ PerlIO *supplied_fp; !statbuf.st_mode #endif ) { - int buflen = sizeof tokenbuf; - if (getsockname(PerlIO_fileno(fp), (struct sockaddr *)tokenbuf, &buflen) >= 0 - || errno != ENOTSOCK) + Sock_size_t buflen = sizeof tokenbuf; + if (getsockname(PerlIO_fileno(fp), (struct sockaddr *)tokenbuf, + &buflen) >= 0 + || errno != ENOTSOCK) IoTYPE(io) = 's'; /* some OS's return 0 on fstat()ed socket */ /* but some return 0 for streams too, sigh */ } @@ -418,7 +439,7 @@ register GV *gv; (void)unlink(SvPVX(sv)); (void)rename(oldname,SvPVX(sv)); do_open(gv,SvPVX(sv),SvCUR(sv),FALSE,0,0,Nullfp); -#endif /* MSDOS */ +#endif /* DOSISH */ #else (void)UNLINK(SvPVX(sv)); if (link(oldname,SvPVX(sv)) < 0) { @@ -431,13 +452,15 @@ register GV *gv; #endif } else { -#ifndef DOSISH +#if !defined(DOSISH) && !defined(AMIGAOS) +# ifndef VMS /* Don't delete; use automatic file versioning */ if (UNLINK(oldname) < 0) { warn("Can't rename %s to %s: %s, skipping file", oldname, SvPVX(sv), Strerror(errno) ); do_close(gv,FALSE); continue; } +# endif #else croak("Can't do inplace edit without backup"); #endif @@ -458,7 +481,10 @@ register GV *gv; #ifdef HAS_FCHMOD (void)fchmod(lastfd,filemode); #else +# if !(defined(WIN32) && defined(__BORLANDC__)) + /* Borland runtime creates a readonly file! */ (void)chmod(oldname,filemode); +# endif #endif if (fileuid != statbuf.st_uid || filegid != statbuf.st_gid) { #ifdef HAS_FCHOWN @@ -575,8 +601,8 @@ IO* io; if (IoIFP(io)) { if (IoTYPE(io) == '|') { status = my_pclose(IoIFP(io)); - retval = (status == 0); - statusvalue = FIXSTATUS(status); + STATUS_NATIVE_SET(status); + retval = (STATUS_POSIX == 0); } else if (IoTYPE(io) == '-') retval = TRUE; @@ -637,22 +663,15 @@ do_tell(gv) GV *gv; { register IO *io; + register PerlIO *fp; - if (!gv) - goto phooey; - - io = GvIO(gv); - if (!io || !IoIFP(io)) - goto phooey; - + if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) { #ifdef ULTRIX_STDIO_BOTCH - if (PerlIO_eof(IoIFP(io))) - (void)PerlIO_seek (IoIFP(io), 0L, 2); /* ultrix 1.2 workaround */ + if (PerlIO_eof(fp)) + (void)PerlIO_seek(fp, 0L, 2); /* ultrix 1.2 workaround */ #endif - - return PerlIO_tell(IoIFP(io)); - -phooey: + return PerlIO_tell(fp); + } if (dowarn) warn("tell() on unopened file"); SETERRNO(EBADF,RMS$_IFI); @@ -666,28 +685,38 @@ long pos; int whence; { register IO *io; + register PerlIO *fp; - if (!gv) - goto nuts; - - io = GvIO(gv); - if (!io || !IoIFP(io)) - goto nuts; - + if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) { #ifdef ULTRIX_STDIO_BOTCH - if (PerlIO_eof(IoIFP(io))) - (void)PerlIO_seek (IoIFP(io), 0L, 2); /* ultrix 1.2 workaround */ + if (PerlIO_eof(fp)) + (void)PerlIO_seek(fp, 0L, 2); /* ultrix 1.2 workaround */ #endif - - return PerlIO_seek(IoIFP(io), pos, whence) >= 0; - -nuts: + return PerlIO_seek(fp, pos, whence) >= 0; + } if (dowarn) warn("seek() on unopened file"); SETERRNO(EBADF,RMS$_IFI); return FALSE; } +long +do_sysseek(gv, pos, whence) +GV *gv; +long pos; +int whence; +{ + register IO *io; + register PerlIO *fp; + + if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) + return lseek(PerlIO_fileno(fp), pos, whence); + if (dowarn) + warn("sysseek() on unopened file"); + SETERRNO(EBADF,RMS$_IFI); + return -1L; +} + #if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP) /* code courtesy of William Kucharski */ #define HAS_CHSIZE @@ -696,7 +725,6 @@ I32 my_chsize(fd, length) I32 fd; /* file descriptor */ Off_t length; /* length to set file to */ { - extern long lseek(); struct flock fl; struct stat filebuf; @@ -740,56 +768,6 @@ Off_t length; /* length to set file to */ } #endif /* F_FREESP */ -I32 -looks_like_number(sv) -SV *sv; -{ - register char *s; - register char *send; - - if (!SvPOK(sv)) { - STRLEN len; - if (!SvPOKp(sv)) - return TRUE; - s = SvPV(sv, len); - send = s + len; - } - else { - s = SvPVX(sv); - send = s + SvCUR(sv); - } - while (isSPACE(*s)) - s++; - if (s >= send) - return FALSE; - if (*s == '+' || *s == '-') - s++; - while (isDIGIT(*s)) - s++; - if (s == send) - return TRUE; - if (*s == '.') - s++; - else if (s == SvPVX(sv)) - return FALSE; - while (isDIGIT(*s)) - s++; - if (s == send) - return TRUE; - if (*s == 'e' || *s == 'E') { - s++; - if (*s == '+' || *s == '-') - s++; - while (isDIGIT(*s)) - s++; - } - while (isSPACE(*s)) - s++; - if (s >= send) - return TRUE; - return FALSE; -} - bool do_print(sv,fp) register SV *sv; @@ -1025,7 +1003,7 @@ char *cmd; break; } doshell: - execl(SH_PATH, "sh", "-c", cmd, (char*)0); + execl(sh_path, "sh", "-c", cmd, (char*)0); return FALSE; } } @@ -1055,7 +1033,7 @@ char *cmd; return FALSE; } -#endif +#endif /* OS2 */ I32 apply(type,mark,sp) @@ -1071,9 +1049,10 @@ register SV **sp; if (tainting) { while (++mark <= sp) { - MAGIC *mg; - if (SvMAGICAL(*mark) && (mg = mg_find(*mark, 't')) && mg->mg_len & 1) - tainted = TRUE; + if (SvTAINTED(*mark)) { + TAINT; + break; + } } mark = oldmark; } @@ -1106,6 +1085,8 @@ register SV **sp; #ifdef HAS_KILL case OP_KILL: TAINT_PROPER("kill"); + if (mark == sp) + break; s = SvPVx(*++mark, na); tot = sp - mark; if (isUPPER(*s)) { @@ -1256,7 +1237,7 @@ register struct stat *statbufp; */ return (bit & statbufp->st_mode) ? TRUE : FALSE; -#else /* ! MSDOS */ +#else /* ! DOSISH */ if ((effective ? euid : uid) == 0) { /* root is special */ if (bit == S_IXUSR) { if (statbufp->st_mode & 0111 || S_ISDIR(statbufp->st_mode)) @@ -1277,7 +1258,7 @@ register struct stat *statbufp; else if (statbufp->st_mode & bit >> 6) return TRUE; /* ok as "other" */ return FALSE; -#endif /* ! MSDOS */ +#endif /* ! DOSISH */ } #endif /* ! VMS */ @@ -1352,6 +1333,9 @@ SV **sp; char *a; I32 id, n, cmd, infosize, getinfo; I32 ret = -1; +#ifdef __linux__ /* XXX Need metaconfig test */ + union semun unsemds; +#endif id = SvIVx(*++mark); n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0; @@ -1380,11 +1364,29 @@ SV **sp; infosize = sizeof(struct semid_ds); else if (cmd == GETALL || cmd == SETALL) { +#ifdef __linux__ /* XXX Need metaconfig test */ +/* linux uses : + int semctl (int semid, int semnun, int cmd, union semun arg) + + union semun { + int val; + struct semid_ds *buf; + ushort *array; + }; +*/ + union semun semds; + if (semctl(id, 0, IPC_STAT, semds) == -1) +#else struct semid_ds semds; if (semctl(id, 0, IPC_STAT, &semds) == -1) +#endif return -1; getinfo = (cmd == GETALL); +#ifdef __linux__ /* XXX Need metaconfig test */ + infosize = semds.buf->sem_nsems * sizeof(short); +#else infosize = semds.sem_nsems * sizeof(short); +#endif /* "short" is technically wrong but much more portable than guessing about u_?short(_t)? */ } @@ -1408,13 +1410,13 @@ SV **sp; { a = SvPV(astr, len); if (len != infosize) - croak("Bad arg length for %s, is %d, should be %d", - op_desc[optype], len, infosize); + croak("Bad arg length for %s, is %lu, should be %ld", + op_desc[optype], (unsigned long)len, (long)infosize); } } else { - I32 i = SvIV(astr); + IV i = SvIV(astr); a = (char *)i; /* ouch */ } SETERRNO(0,0); @@ -1427,7 +1429,12 @@ SV **sp; #endif #ifdef HAS_SEM case OP_SEMCTL: +#ifdef __linux__ /* XXX Need metaconfig test */ + unsemds.buf = (struct semid_ds *)a; + ret = semctl(id, n, cmd, unsemds); +#else ret = semctl(id, n, cmd, (struct semid_ds *)a); +#endif break; #endif #ifdef HAS_SHM