1N/A * Copyright 2009 Sun Microsystems, Inc. All rights reserved. 1N/A * Use is subject to license terms. 1N/A * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 1N/A * 2000, 2001, 2002, 2003, 2004, by Larry Wall and others 1N/A * You may distribute under the terms of either the GNU General Public 1N/A * License or the Artistic License, as specified in the README file. 1N/A * "Far below them they saw the white waters pour into a foaming bowl, and 1N/A * then swirl darkly about a deep oval basin in the rocks, until they found 1N/A * their way out again through a narrow gate, and flowed away, fuming and 1N/A * chattering, into calmer and more level reaches." 1N/A char mode[
8];
/* stdio file mode ("r\0", "rb\0", "r+b\0" etc.) */ 1N/A /* set up IO layers */ 1N/A /* If currently open - close before we re-open */ 1N/A /* This is a clone of one of STD* handles */ 1N/A /* This is one of the original STD* handles */ 1N/A /* Why is this not Perl_warn*() call ? */ 1N/A "Warning: unable to close filehandle %s properly.\n",
1N/A /* sysopen style args, i.e. integer mode and permissions */ 1N/A It might be (in OS/390 and Mac OS Classic it is) 1N/A This means that simple & with O_RDWR would look 1N/A like O_RDONLY is present. Therefore we have to 1N/A /* Regular (non-sys) open */ 1N/A /* Lose leading and trailing white space */ 1N/A /* New style explicit name, type is just mode and layer info */ 1N/A "Can't open a reference");
1N/A#
endif /* USE_STDIO */ 1N/A /* command is missing 19990114 */ 1N/A /* Two IoTYPE_WRONLYs in a row make for an IoTYPE_APPEND. */ 1N/A /* "<+&" etc. is used by typemaps */ 1N/A /* Flush stdio buffer before dup. --mjd 1N/A * Unfortunately SEEK_CURing 0 seems to 1N/A * be optimized away on most platforms; 1N/A * only Solaris and Linux seem to flush 1N/A /* sfio fails to clear error on next 1N/A sfwrite, contrary to documentation. 1N/A /* On the other hand, do all platforms 1N/A * take gracefully to flushing a read-only 1N/A * filehandle? Perhaps we should do 1N/A * fsetpos(src)+fgetpos(dst)? --nik */ 1N/A /* When dup()ing STDIN, STDOUT or STDERR 1N/A * explicitly set appropriate access mode */ 1N/A /* When dup()ing a socket, say result is 1N/A }
/* IoTYPE_WRONLY */ 1N/A }
/* IoTYPE_RDONLY */ 1N/A /* command is missing 19990114 */ 1N/A else {
/* layer(Args) */ 1N/A "Filehandle STD%s reopened as %s only for input",
1N/A "Filehandle STDIN reopened as %s only for output",
1N/A /* If there is no fd (e.g. PerlIO::scalar) assume it isn't a 1N/A * socket - this covers PerlIO::scalar - otherwise unless we "know" the 1N/A * type probe for socket-ness. 1N/A /* If PerlIO claims to have fd we had better be able to fstat() it. */ 1N/A ) {
/* on OS's that return 0 on fstat()ed pipe */ 1N/A /* but some return 0 for streams too, sigh */ 1N/A#
endif /* HAS_SOCKET */ 1N/A#
endif /* !PERL_MICRO */ 1N/A * If this is a standard handle we discard all the layer stuff 1N/A * and just dup the fd into whatever was on the handle before ! 1N/A /* If fd is less that PL_maxsysfd i.e. STDIN..STDERR 1N/A then dup the new fileno down 1N/A /* Still a small can-of-worms here if (say) PerlIO::scalar 1N/A is assigned to (say) STDOUT - for now let dup2() fail 1N/A and provide the error 1N/A /* PL_fdpid isn't used on Windows, so avoid this useless work. 1N/A * XXX Probably the same for a lot of other places. */ 1N/A /* need to close fp without closing underlying fd */ 1N/A /* Assume if we have F_SETFD we have F_GETFD */ 1N/A /* The dup trick has lost close-on-exec on ofd */ 1N/A "Can't do inplace edit: %s is not a regular file",
1N/A "Can't do inplace edit: %"SVf" would not be unique",
1N/A "Can't rename %s to %"SVf": %s, skipping file",
1N/A "Can't rename %s to %"SVf": %s, skipping file",
1N/A#
ifndef VMS /* Don't delete; use automatic file versioning */ 1N/A "Can't remove %s: %s, skipping file",
1N/A /* Borland runtime creates a readonly file! */ 1N/A "Can't do inplace edit: %s is not a regular file",
1N/A/* explicit renamed to avoid C++ conflict -- kja */ 1N/A if (!
io) {
/* never opened */ 1N/A return FALSE;
/* this is the most usual case */ 1N/A return TRUE;
/* normal fp, definitely end of file */ 1N/A /* The old body of this is now in non-LAYER part of perlio.c 1N/A * This is a stub for any XS code which might have been calling it. 1N/A /* code courtesy of William Kucharski */ 1N/A /* extend file length */ 1N/A /* write a "0" byte */ 1N/A /* truncate length */ 1N/A * This relies on the UNDOCUMENTED F_FREESP argument to 1N/A * fcntl(2), which truncates the file so that it ends at the 1N/A * position indicated by fl.l_start. 1N/A * Will minor miracles never cease? 1N/A#
endif /* F_FREESP */ 1N/A /* assuming fp is checked earlier */ 1N/A /* To detect whether the process is about to overstep its 1N/A * filesize limit we would need getrlimit(). We could then 1N/A * also transparently raise the limit with setrlimit() -- 1N/A * but only until the system hard limit/the filesystem limit, 1N/A * at which we would get EPERM. Note that when using buffered 1N/A * io the write failure can be delayed until the flush/close. --jhi */ 1N/A /* save an extra exec if possible */ 1N/A if (s[-
1] ==
'\'') {
1N/A /* see if there are shell metacharacters in it */ 1N/A for (s =
cmd; *s &&
isALNUM(*s); s++) ;
/* catch VAR=val gizmo */ 1N/A if (*s ==
'\n' && !s[
1]) {
1N/A /* handle the 2>&1 construct at the end */ 1N/A if (*s ==
'>' && s[
1] ==
'&' && s[
2] ==
'1' 1N/A#
endif /* OS2 || WIN32 */ 1N/A /* This is a first heuristic; it doesn't catch tainting magic. */ 1N/AXXX Should we make lchown() directly available from perl? 1N/AFor now, we'll let Configure test for HAS_LCHOWN, but do 1N/A if (*s ==
'S' && s[
1] ==
'I' && s[
2] ==
'G')
1N/A /* kill() doesn't do process groups (job trees?) under VMS */ 1N/A /* Use native sys$delprc() to insure that target process is 1N/A * deleted; supervisor-mode images don't pay attention to 1N/A * CRTL's emulation of Unix-style signals and kill() 1N/A else {
/* don't let root wipe out directories without -U */ 1N/A /* Be like C, and if both times are undefined, let the C 1N/A * library figure out what to do. This usually means 1N/A * "current time". */ 1N/A/* Do the permissions allow some operation? Assumes statcache already set. */ 1N/A/* Note: we use `effective' both for uids and gids. 1N/A * Here we are betting on Uid_t being equal or wider than Gid_t. */ 1N/A /* [Comments and code from Len Reed] 1N/A * MS-DOS "user" is similar to UNIX's "superuser," but can't write 1N/A * to write-protected files. The execute permission bit is set 1N/A * by the Miscrosoft C library stat() function for the following: 1N/A * All files and directories are readable. 1N/A * Directories and special files, e.g. "CON", cannot be 1N/A * [Comment by Tom Dinger -- a directory can have the write-protect 1N/A * bit set in the file system, but DOS permits changes to 1N/A * the directory anyway. In addition, all bets are off 1N/A * here for networked software, such as Novell and 1N/A /* Atari stat() does pretty much the same thing. we set x_bit_set_in_stat 1N/A * too so it will actually look into the files for magic numbers 1N/A return TRUE;
/* root reads and writes anything */ 1N/A#
endif /* ! DOSISH */ 1N/A /* This is simply not correct for AppleShare, but fix it yerself. */ 1N/A return -
1;
/* should never happen */ 1N/A /* "short" is technically wrong but much more portable 1N/A than guessing about u_?short(_t)? */ 1N/A /* suppress warning when reading into undef var --jhi */ 1N/A /* who knows who has been playing with this message? */ 1N/A /* We can't assume that sizeof(struct sembuf) == 3 * sizeof(short). */ 1N/A if (
shm == (
char *)-
1)
/* I hate System V IPC, I really do */ 1N/A /* suppress warning when reading into undef var (tchrist 3/Mar/00) */ 1N/A /* who knows who has been playing with this shared memory? */ 1N/A#
endif /* SYSV IPC */ 1N/A=for apidoc start_glob 1N/AFunction called by C<do_readline> to spawn a glob (or do the glob inside 1N/Aperl on VMS). This code used to be inline, but now perl uses C<File::Glob> 1N/Athis glob starter is only used by miniperl during the build process. 1N/A#
ifdef VMS /* expand the wildcards right here, rather than opening a pipe, */ 1N/A /* since spawning off a process is a real performance hit */ 1N/A /* We could find out if there's an explicit dev/dir or version 1N/A by peeking into lib$find_file's internal context at 1N/A ((struct NAM *)((struct FAB *)cxt)->fab$l_nam)->nam$l_fnb 1N/A but that's unsupported, so I don't want to do it now and 1N/A have it bite someone in the future. */ 1N/A if (
cp[i] ==
']' ||
cp[i] ==
'>' ||
cp[i] ==
':') {
1N/A if (*
cp ==
'?') *
cp =
'%';
/* VMS style single-char wildcard */ 1N/A /* with varying string, 1st word of buffer contains result length */ 1N/A#
endif /* MACOS_TRADITIONAL */