This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
regen headers
[perl5.git] / doio.c
CommitLineData
a0d0e21e 1/* doio.c
a687059c 2 *
9607fc9c 3 * Copyright (c) 1991-1997, Larry Wall
a687059c 4 *
6e21c824
LW
5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
a687059c 7 *
a0d0e21e
LW
8 */
9
10/*
11 * "Far below them they saw the white waters pour into a foaming bowl, and
12 * then swirl darkly about a deep oval basin in the rocks, until they found
13 * their way out again through a narrow gate, and flowed away, fuming and
14 * chattering, into calmer and more level reaches."
a687059c
LW
15 */
16
17#include "EXTERN.h"
18#include "perl.h"
19
fe14fcc3 20#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
c2ab57d4 21#include <sys/ipc.h>
fe14fcc3 22#ifdef HAS_MSG
c2ab57d4 23#include <sys/msg.h>
e5d73d77 24#endif
fe14fcc3 25#ifdef HAS_SEM
c2ab57d4 26#include <sys/sem.h>
e5d73d77 27#endif
fe14fcc3 28#ifdef HAS_SHM
c2ab57d4 29#include <sys/shm.h>
a0d0e21e
LW
30# ifndef HAS_SHMAT_PROTOTYPE
31 extern Shmat_t shmat _((int, char *, int));
32# endif
c2ab57d4 33#endif
e5d73d77 34#endif
c2ab57d4 35
663a0e37 36#ifdef I_UTIME
3730b96e 37# if defined(_MSC_VER) || defined(__MINGW32__)
3fe9a6f1
PP
38# include <sys/utime.h>
39# else
40# include <utime.h>
41# endif
663a0e37 42#endif
85aff577 43
ff8e2863
LW
44#ifdef I_FCNTL
45#include <fcntl.h>
46#endif
fe14fcc3
LW
47#ifdef I_SYS_FILE
48#include <sys/file.h>
49#endif
85aff577
CS
50#ifdef O_EXCL
51# define OPEN_EXCL O_EXCL
52#else
53# define OPEN_EXCL 0
54#endif
a687059c 55
76121258
PP
56#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
57#include <signal.h>
58#endif
59
60/* XXX If this causes problems, set i_unistd=undef in the hint file. */
61#ifdef I_UNISTD
62# include <unistd.h>
63#endif
64
232e078e
AD
65#if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */
66# include <sys/socket.h>
67# include <netdb.h>
68# ifndef ENOTSOCK
69# ifdef I_NET_ERRNO
70# include <net/errno.h>
71# endif
72# endif
73#endif
74
d574b85e
CS
75/* Put this after #includes because <unistd.h> defines _XOPEN_*. */
76#ifndef Sock_size_t
137443ea 77# if _XOPEN_VERSION >= 5 || defined(_XOPEN_SOURCE_EXTENDED) || defined(__GLIBC__)
d574b85e
CS
78# define Sock_size_t Size_t
79# else
80# define Sock_size_t int
81# endif
82#endif
83
a687059c 84bool
6acef3b7 85do_open(GV *gv, register char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp)
a687059c 86{
a0d0e21e 87 register IO *io = GvIOn(gv);
760ac839
LW
88 PerlIO *saveifp = Nullfp;
89 PerlIO *saveofp = Nullfp;
6e21c824 90 char savetype = ' ';
c07a80fd 91 int writing = 0;
760ac839 92 PerlIO *fp;
c07a80fd
PP
93 int fd;
94 int result;
3500f679 95 bool was_fdopen = FALSE;
a687059c 96
3280af22 97 PL_forkprocess = 1; /* assume true if no fork */
c07a80fd 98
a0d0e21e 99 if (IoIFP(io)) {
760ac839 100 fd = PerlIO_fileno(IoIFP(io));
8990e307 101 if (IoTYPE(io) == '-')
c2ab57d4 102 result = 0;
3280af22 103 else if (fd <= PL_maxsysfd) {
8990e307
LW
104 saveifp = IoIFP(io);
105 saveofp = IoOFP(io);
106 savetype = IoTYPE(io);
6e21c824
LW
107 result = 0;
108 }
8990e307 109 else if (IoTYPE(io) == '|')
3028581b 110 result = PerlProc_pclose(IoIFP(io));
8990e307
LW
111 else if (IoIFP(io) != IoOFP(io)) {
112 if (IoOFP(io)) {
760ac839
LW
113 result = PerlIO_close(IoOFP(io));
114 PerlIO_close(IoIFP(io)); /* clear stdio, fd already closed */
c2ab57d4
LW
115 }
116 else
760ac839 117 result = PerlIO_close(IoIFP(io));
a687059c 118 }
a687059c 119 else
760ac839 120 result = PerlIO_close(IoIFP(io));
3280af22 121 if (result == EOF && fd > PL_maxsysfd)
760ac839 122 PerlIO_printf(PerlIO_stderr(), "Warning: unable to close filehandle %s properly.\n",
79072805 123 GvENAME(gv));
8990e307 124 IoOFP(io) = IoIFP(io) = Nullfp;
a687059c 125 }
c07a80fd
PP
126
127 if (as_raw) {
5ff3f7a4
GS
128#if defined(O_LARGEFILE)
129 rawmode |= O_LARGEFILE;
130#endif
131
9d116dd7
JH
132#ifndef O_ACCMODE
133#define O_ACCMODE 3 /* Assume traditional implementation */
134#endif
5ff3f7a4 135
9d116dd7
JH
136 switch (result = rawmode & O_ACCMODE) {
137 case O_RDONLY:
138 IoTYPE(io) = '<';
139 break;
140 case O_WRONLY:
141 IoTYPE(io) = '>';
142 break;
143 case O_RDWR:
144 default:
145 IoTYPE(io) = '+';
146 break;
147 }
148
c07a80fd 149 writing = (result > 0);
3028581b 150 fd = PerlLIO_open3(name, rawmode, rawperm);
9d116dd7 151
c07a80fd
PP
152 if (fd == -1)
153 fp = NULL;
154 else {
360e5741 155 char *fpmode;
9d116dd7 156 if (result == O_RDONLY)
360e5741
CS
157 fpmode = "r";
158#ifdef O_APPEND
159 else if (rawmode & O_APPEND)
9d116dd7 160 fpmode = (result == O_WRONLY) ? "a" : "a+";
360e5741
CS
161#endif
162 else
9d116dd7 163 fpmode = (result == O_WRONLY) ? "w" : "r+";
360e5741 164 fp = PerlIO_fdopen(fd, fpmode);
c07a80fd 165 if (!fp)
3028581b 166 PerlLIO_close(fd);
c07a80fd 167 }
a687059c 168 }
c07a80fd
PP
169 else {
170 char *myname;
171 char mode[3]; /* stdio file mode ("r\0" or "r+\0") */
172 int dodup;
173
174 myname = savepvn(name, len);
175 SAVEFREEPV(myname);
176 name = myname;
177 while (len && isSPACE(name[len-1]))
178 name[--len] = '\0';
179
180 mode[0] = mode[1] = mode[2] = '\0';
181 IoTYPE(io) = *name;
182 if (*name == '+' && len > 1 && name[len-1] != '|') { /* scary */
183 mode[1] = *name++;
184 --len;
185 writing = 1;
a687059c 186 }
c07a80fd
PP
187
188 if (*name == '|') {
189 /*SUPPRESS 530*/
190 for (name++; isSPACE(*name); name++) ;
191 if (strNE(name,"-"))
192 TAINT_ENV();
193 TAINT_PROPER("piped open");
7b8d334a 194 if (name[strlen(name)-1] == '|') {
d008e5eb 195 dTHR;
7b8d334a 196 name[strlen(name)-1] = '\0' ;
599cee73
PM
197 if (ckWARN(WARN_PIPE))
198 warner(WARN_PIPE, "Can't do bidirectional pipe");
7b8d334a 199 }
3028581b 200 fp = PerlProc_popen(name,"w");
c07a80fd
PP
201 writing = 1;
202 }
203 else if (*name == '>') {
204 TAINT_PROPER("open");
bf38876a 205 name++;
c07a80fd
PP
206 if (*name == '>') {
207 mode[0] = IoTYPE(io) = 'a';
bf38876a 208 name++;
a0d0e21e 209 }
c07a80fd
PP
210 else
211 mode[0] = 'w';
212 writing = 1;
213
214 if (*name == '&') {
215 duplicity:
216 dodup = 1;
217 name++;
218 if (*name == '=') {
219 dodup = 0;
a0d0e21e 220 name++;
c07a80fd
PP
221 }
222 if (!*name && supplied_fp)
223 fp = supplied_fp;
a0d0e21e 224 else {
c07a80fd
PP
225 /*SUPPRESS 530*/
226 for (; isSPACE(*name); name++) ;
227 if (isDIGIT(*name))
228 fd = atoi(name);
229 else {
230 IO* thatio;
231 gv = gv_fetchpv(name,FALSE,SVt_PVIO);
232 thatio = GvIO(gv);
233 if (!thatio) {
6e21c824 234#ifdef EINVAL
c07a80fd 235 SETERRNO(EINVAL,SS$_IVCHAN);
6e21c824 236#endif
c07a80fd
PP
237 goto say_false;
238 }
239 if (IoIFP(thatio)) {
760ac839 240 fd = PerlIO_fileno(IoIFP(thatio));
c07a80fd
PP
241 if (IoTYPE(thatio) == 's')
242 IoTYPE(io) = 's';
243 }
244 else
245 fd = -1;
a0d0e21e 246 }
fec02dd3 247 if (dodup)
3028581b 248 fd = PerlLIO_dup(fd);
3500f679
RS
249 else
250 was_fdopen = TRUE;
760ac839 251 if (!(fp = PerlIO_fdopen(fd,mode))) {
c07a80fd 252 if (dodup)
3028581b 253 PerlLIO_close(fd);
517844ec 254 }
c07a80fd 255 }
bf38876a 256 }
c07a80fd
PP
257 else {
258 /*SUPPRESS 530*/
259 for (; isSPACE(*name); name++) ;
260 if (strEQ(name,"-")) {
760ac839 261 fp = PerlIO_stdout();
c07a80fd
PP
262 IoTYPE(io) = '-';
263 }
264 else {
760ac839 265 fp = PerlIO_open(name,mode);
c07a80fd 266 }
bf38876a
LW
267 }
268 }
c07a80fd
PP
269 else if (*name == '<') {
270 /*SUPPRESS 530*/
271 for (name++; isSPACE(*name); name++) ;
bf38876a 272 mode[0] = 'r';
bf38876a
LW
273 if (*name == '&')
274 goto duplicity;
a687059c 275 if (strEQ(name,"-")) {
760ac839 276 fp = PerlIO_stdin();
8990e307 277 IoTYPE(io) = '-';
a687059c 278 }
bf38876a 279 else
760ac839 280 fp = PerlIO_open(name,mode);
a687059c 281 }
00db4c45 282 else if (len > 1 && name[len-1] == '|') {
a687059c 283 name[--len] = '\0';
99b89507 284 while (len && isSPACE(name[len-1]))
a687059c 285 name[--len] = '\0';
99b89507
LW
286 /*SUPPRESS 530*/
287 for (; isSPACE(*name); name++) ;
79072805
LW
288 if (strNE(name,"-"))
289 TAINT_ENV();
290 TAINT_PROPER("piped open");
3028581b 291 fp = PerlProc_popen(name,"r");
8990e307 292 IoTYPE(io) = '|';
a687059c
LW
293 }
294 else {
8990e307 295 IoTYPE(io) = '<';
99b89507
LW
296 /*SUPPRESS 530*/
297 for (; isSPACE(*name); name++) ;
a687059c 298 if (strEQ(name,"-")) {
760ac839 299 fp = PerlIO_stdin();
8990e307 300 IoTYPE(io) = '-';
a687059c
LW
301 }
302 else
760ac839 303 fp = PerlIO_open(name,"r");
a687059c
LW
304 }
305 }
bee1dbe2 306 if (!fp) {
d008e5eb 307 dTHR;
599cee73 308 if (ckWARN(WARN_NEWLINE) && IoTYPE(io) == '<' && strchr(name, '\n'))
22c35a8c 309 warner(WARN_NEWLINE, PL_warn_nl, "open");
6e21c824 310 goto say_false;
bee1dbe2 311 }
8990e307
LW
312 if (IoTYPE(io) &&
313 IoTYPE(io) != '|' && IoTYPE(io) != '-') {
96827780 314 dTHR;
3280af22 315 if (PerlLIO_fstat(PerlIO_fileno(fp),&PL_statbuf) < 0) {
760ac839 316 (void)PerlIO_close(fp);
6e21c824 317 goto say_false;
a687059c 318 }
3280af22 319 if (S_ISSOCK(PL_statbuf.st_mode))
8990e307 320 IoTYPE(io) = 's'; /* in case a socket was passed in to us */
99b89507
LW
321#ifdef HAS_SOCKET
322 else if (
c623bd54 323#ifdef S_IFMT
3280af22 324 !(PL_statbuf.st_mode & S_IFMT)
99b89507 325#else
b28d0864 326 !PL_statbuf.st_mode
99b89507
LW
327#endif
328 ) {
96827780
MB
329 char tmpbuf[256];
330 Sock_size_t buflen = sizeof tmpbuf;
3028581b 331 if (PerlSock_getsockname(PerlIO_fileno(fp), (struct sockaddr *)tmpbuf,
d574b85e
CS
332 &buflen) >= 0
333 || errno != ENOTSOCK)
8990e307 334 IoTYPE(io) = 's'; /* some OS's return 0 on fstat()ed socket */
99b89507
LW
335 /* but some return 0 for streams too, sigh */
336 }
bf38876a 337#endif
a687059c 338 }
6e21c824 339 if (saveifp) { /* must use old fp? */
760ac839 340 fd = PerlIO_fileno(saveifp);
6e21c824 341 if (saveofp) {
760ac839 342 PerlIO_flush(saveofp); /* emulate PerlIO_close() */
6e21c824 343 if (saveofp != saveifp) { /* was a socket? */
760ac839 344 PerlIO_close(saveofp);
99b89507
LW
345 if (fd > 2)
346 Safefree(saveofp);
6e21c824
LW
347 }
348 }
760ac839 349 if (fd != PerlIO_fileno(fp)) {
bee1dbe2 350 int pid;
79072805 351 SV *sv;
bee1dbe2 352
3028581b 353 PerlLIO_dup2(PerlIO_fileno(fp), fd);
3280af22 354 sv = *av_fetch(PL_fdpid,PerlIO_fileno(fp),TRUE);
a0d0e21e 355 (void)SvUPGRADE(sv, SVt_IV);
463ee0b2
LW
356 pid = SvIVX(sv);
357 SvIVX(sv) = 0;
3280af22 358 sv = *av_fetch(PL_fdpid,fd,TRUE);
a0d0e21e 359 (void)SvUPGRADE(sv, SVt_IV);
463ee0b2 360 SvIVX(sv) = pid;
3500f679
RS
361 if (!was_fdopen)
362 PerlIO_close(fp);
bee1dbe2 363
6e21c824
LW
364 }
365 fp = saveifp;
760ac839 366 PerlIO_clearerr(fp);
6e21c824 367 }
a0d0e21e 368#if defined(HAS_FCNTL) && defined(F_SETFD)
a8710ca1
GS
369 {
370 int save_errno = errno;
371 fd = PerlIO_fileno(fp);
372 fcntl(fd,F_SETFD,fd > PL_maxsysfd); /* can change errno */
373 errno = save_errno;
374 }
1462b684 375#endif
8990e307 376 IoIFP(io) = fp;
bf38876a 377 if (writing) {
96827780 378 dTHR;
8990e307 379 if (IoTYPE(io) == 's'
3280af22 380 || (IoTYPE(io) == '>' && S_ISCHR(PL_statbuf.st_mode)) ) {
760ac839
LW
381 if (!(IoOFP(io) = PerlIO_fdopen(PerlIO_fileno(fp),"w"))) {
382 PerlIO_close(fp);
8990e307 383 IoIFP(io) = Nullfp;
6e21c824 384 goto say_false;
fe14fcc3 385 }
1462b684
LW
386 }
387 else
8990e307 388 IoOFP(io) = fp;
bf38876a 389 }
a687059c 390 return TRUE;
6e21c824
LW
391
392say_false:
8990e307
LW
393 IoIFP(io) = saveifp;
394 IoOFP(io) = saveofp;
395 IoTYPE(io) = savetype;
6e21c824 396 return FALSE;
a687059c
LW
397}
398
760ac839 399PerlIO *
8ac85365 400nextargv(register GV *gv)
a687059c 401{
79072805 402 register SV *sv;
99b89507 403#ifndef FLEXFILENAMES
c623bd54
LW
404 int filedev;
405 int fileino;
99b89507 406#endif
c623bd54
LW
407 int fileuid;
408 int filegid;
fe14fcc3 409
3280af22
NIS
410 if (!PL_argvoutgv)
411 PL_argvoutgv = gv_fetchpv("ARGVOUT",TRUE,SVt_PVIO);
412 if (PL_filemode & (S_ISUID|S_ISGID)) {
413 PerlIO_flush(IoIFP(GvIOn(PL_argvoutgv))); /* chmod must follow last write */
fe14fcc3 414#ifdef HAS_FCHMOD
3280af22 415 (void)fchmod(PL_lastfd,PL_filemode);
fe14fcc3 416#else
b28d0864 417 (void)PerlLIO_chmod(PL_oldname,PL_filemode);
fe14fcc3
LW
418#endif
419 }
3280af22 420 PL_filemode = 0;
79072805 421 while (av_len(GvAV(gv)) >= 0) {
11343788 422 dTHR;
85aff577 423 STRLEN oldlen;
79072805 424 sv = av_shift(GvAV(gv));
8990e307 425 SAVEFREESV(sv);
79072805
LW
426 sv_setsv(GvSV(gv),sv);
427 SvSETMAGIC(GvSV(gv));
3280af22 428 PL_oldname = SvPVx(GvSV(gv), oldlen);
9d116dd7 429 if (do_open(gv,PL_oldname,oldlen,PL_inplace!=0,O_RDONLY,0,Nullfp)) {
3280af22 430 if (PL_inplace) {
79072805 431 TAINT_PROPER("inplace open");
3280af22 432 if (oldlen == 1 && *PL_oldname == '-') {
4633a7c4 433 setdefout(gv_fetchpv("STDOUT",TRUE,SVt_PVIO));
a0d0e21e 434 return IoIFP(GvIOp(gv));
c623bd54 435 }
99b89507 436#ifndef FLEXFILENAMES
b28d0864
NIS
437 filedev = PL_statbuf.st_dev;
438 fileino = PL_statbuf.st_ino;
99b89507 439#endif
3280af22
NIS
440 PL_filemode = PL_statbuf.st_mode;
441 fileuid = PL_statbuf.st_uid;
442 filegid = PL_statbuf.st_gid;
443 if (!S_ISREG(PL_filemode)) {
c623bd54 444 warn("Can't do inplace edit: %s is not a regular file",
3280af22 445 PL_oldname );
79072805 446 do_close(gv,FALSE);
c623bd54
LW
447 continue;
448 }
3280af22
NIS
449 if (*PL_inplace) {
450 char *star = strchr(PL_inplace, '*');
2d259d92 451 if (star) {
3280af22 452 char *begin = PL_inplace;
2d259d92
CK
453 sv_setpvn(sv, "", 0);
454 do {
455 sv_catpvn(sv, begin, star - begin);
3280af22 456 sv_catpvn(sv, PL_oldname, oldlen);
2d259d92
CK
457 begin = ++star;
458 } while ((star = strchr(begin, '*')));
3d66d7bb
GS
459 if (*begin)
460 sv_catpv(sv,begin);
2d259d92
CK
461 }
462 else {
3280af22 463 sv_catpv(sv,PL_inplace);
2d259d92 464 }
c623bd54 465#ifndef FLEXFILENAMES
b28d0864
NIS
466 if (PerlLIO_stat(SvPVX(sv),&PL_statbuf) >= 0
467 && PL_statbuf.st_dev == filedev
468 && PL_statbuf.st_ino == fileino
39e571d4
ML
469#ifdef DJGPP
470 || (_djstat_fail_bits & _STFAIL_TRUENAME)!=0
471#endif
472 ) {
752ebe84 473 warn("Can't do inplace edit: %s would not be unique",
463ee0b2 474 SvPVX(sv) );
79072805 475 do_close(gv,FALSE);
c623bd54
LW
476 continue;
477 }
478#endif
fe14fcc3 479#ifdef HAS_RENAME
bee1dbe2 480#ifndef DOSISH
3280af22 481 if (PerlLIO_rename(PL_oldname,SvPVX(sv)) < 0) {
c623bd54 482 warn("Can't rename %s to %s: %s, skipping file",
3280af22 483 PL_oldname, SvPVX(sv), Strerror(errno) );
79072805 484 do_close(gv,FALSE);
c623bd54
LW
485 continue;
486 }
a687059c 487#else
79072805 488 do_close(gv,FALSE);
3028581b 489 (void)PerlLIO_unlink(SvPVX(sv));
b28d0864 490 (void)PerlLIO_rename(PL_oldname,SvPVX(sv));
9d116dd7 491 do_open(gv,SvPVX(sv),SvCUR(sv),PL_inplace!=0,O_RDONLY,0,Nullfp);
55497cff 492#endif /* DOSISH */
ff8e2863 493#else
463ee0b2 494 (void)UNLINK(SvPVX(sv));
b28d0864 495 if (link(PL_oldname,SvPVX(sv)) < 0) {
c623bd54 496 warn("Can't rename %s to %s: %s, skipping file",
b28d0864 497 PL_oldname, SvPVX(sv), Strerror(errno) );
79072805 498 do_close(gv,FALSE);
c623bd54
LW
499 continue;
500 }
b28d0864 501 (void)UNLINK(PL_oldname);
a687059c
LW
502#endif
503 }
504 else {
a8c18271 505#if !defined(DOSISH) && !defined(AMIGAOS)
edc7bc49 506# ifndef VMS /* Don't delete; use automatic file versioning */
3280af22 507 if (UNLINK(PL_oldname) < 0) {
85aff577 508 warn("Can't remove %s: %s, skipping file",
3280af22 509 PL_oldname, Strerror(errno) );
79072805 510 do_close(gv,FALSE);
fe14fcc3
LW
511 continue;
512 }
edc7bc49 513# endif
ff8e2863 514#else
463ee0b2 515 croak("Can't do inplace edit without backup");
ff8e2863 516#endif
a687059c
LW
517 }
518
3280af22
NIS
519 sv_setpvn(sv,">",!PL_inplace);
520 sv_catpvn(sv,PL_oldname,oldlen);
748a9306 521 SETERRNO(0,0); /* in case sprintf set errno */
4119ab01
HM
522#ifdef VMS
523 if (!do_open(PL_argvoutgv,SvPVX(sv),SvCUR(sv),PL_inplace!=0,
524 O_WRONLY|O_CREAT|O_TRUNC,0,Nullfp)) {
525#else
3280af22 526 if (!do_open(PL_argvoutgv,SvPVX(sv),SvCUR(sv),PL_inplace!=0,
85aff577 527 O_WRONLY|O_CREAT|OPEN_EXCL,0666,Nullfp)) {
4119ab01 528#endif
c623bd54 529 warn("Can't do inplace edit on %s: %s",
3280af22 530 PL_oldname, Strerror(errno) );
79072805 531 do_close(gv,FALSE);
fe14fcc3
LW
532 continue;
533 }
3280af22
NIS
534 setdefout(PL_argvoutgv);
535 PL_lastfd = PerlIO_fileno(IoIFP(GvIOp(PL_argvoutgv)));
536 (void)PerlLIO_fstat(PL_lastfd,&PL_statbuf);
fe14fcc3 537#ifdef HAS_FCHMOD
3280af22 538 (void)fchmod(PL_lastfd,PL_filemode);
a687059c 539#else
3e3baf6d
TB
540# if !(defined(WIN32) && defined(__BORLANDC__))
541 /* Borland runtime creates a readonly file! */
b28d0864 542 (void)PerlLIO_chmod(PL_oldname,PL_filemode);
3e3baf6d 543# endif
a687059c 544#endif
3280af22 545 if (fileuid != PL_statbuf.st_uid || filegid != PL_statbuf.st_gid) {
fe14fcc3 546#ifdef HAS_FCHOWN
3280af22 547 (void)fchown(PL_lastfd,fileuid,filegid);
a687059c 548#else
fe14fcc3 549#ifdef HAS_CHOWN
b28d0864 550 (void)PerlLIO_chown(PL_oldname,fileuid,filegid);
a687059c 551#endif
b1248f16 552#endif
fe14fcc3 553 }
a687059c 554 }
a0d0e21e 555 return IoIFP(GvIOp(gv));
a687059c
LW
556 }
557 else
22fae026 558 PerlIO_printf(PerlIO_stderr(), "Can't open %s: %s\n",
2d8e6c8d 559 SvPV(sv, oldlen), Strerror(errno));
a687059c 560 }
3280af22
NIS
561 if (PL_inplace) {
562 (void)do_close(PL_argvoutgv,FALSE);
4633a7c4 563 setdefout(gv_fetchpv("STDOUT",TRUE,SVt_PVIO));
a687059c
LW
564 }
565 return Nullfp;
566}
567
fe14fcc3 568#ifdef HAS_PIPE
afd9f252 569void
8ac85365 570do_pipe(SV *sv, GV *rgv, GV *wgv)
afd9f252 571{
79072805
LW
572 register IO *rstio;
573 register IO *wstio;
afd9f252
LW
574 int fd[2];
575
79072805 576 if (!rgv)
afd9f252 577 goto badexit;
79072805 578 if (!wgv)
afd9f252
LW
579 goto badexit;
580
a0d0e21e
LW
581 rstio = GvIOn(rgv);
582 wstio = GvIOn(wgv);
afd9f252 583
a0d0e21e 584 if (IoIFP(rstio))
79072805 585 do_close(rgv,FALSE);
a0d0e21e 586 if (IoIFP(wstio))
79072805 587 do_close(wgv,FALSE);
afd9f252 588
3028581b 589 if (PerlProc_pipe(fd) < 0)
afd9f252 590 goto badexit;
760ac839
LW
591 IoIFP(rstio) = PerlIO_fdopen(fd[0], "r");
592 IoOFP(wstio) = PerlIO_fdopen(fd[1], "w");
8990e307
LW
593 IoIFP(wstio) = IoOFP(wstio);
594 IoTYPE(rstio) = '<';
595 IoTYPE(wstio) = '>';
596 if (!IoIFP(rstio) || !IoOFP(wstio)) {
760ac839 597 if (IoIFP(rstio)) PerlIO_close(IoIFP(rstio));
3028581b 598 else PerlLIO_close(fd[0]);
760ac839 599 if (IoOFP(wstio)) PerlIO_close(IoOFP(wstio));
3028581b 600 else PerlLIO_close(fd[1]);
fe14fcc3
LW
601 goto badexit;
602 }
afd9f252 603
3280af22 604 sv_setsv(sv,&PL_sv_yes);
afd9f252
LW
605 return;
606
607badexit:
3280af22 608 sv_setsv(sv,&PL_sv_undef);
afd9f252
LW
609 return;
610}
b1248f16 611#endif
afd9f252 612
517844ec 613/* explicit renamed to avoid C++ conflict -- kja */
a687059c 614bool
517844ec 615do_close(GV *gv, bool not_implicit)
a687059c 616{
1193dd27
IZ
617 bool retval;
618 IO *io;
a687059c 619
79072805 620 if (!gv)
3280af22 621 gv = PL_argvgv;
a0d0e21e 622 if (!gv || SvTYPE(gv) != SVt_PVGV) {
1d2dff63
GS
623 if (not_implicit)
624 SETERRNO(EBADF,SS$_IVCHAN);
c2ab57d4 625 return FALSE;
99b89507 626 }
79072805
LW
627 io = GvIO(gv);
628 if (!io) { /* never opened */
1d2dff63 629 if (not_implicit) {
d008e5eb 630 dTHR;
599cee73
PM
631 if (ckWARN(WARN_UNOPENED))
632 warner(WARN_UNOPENED,
633 "Close on unopened file <%s>",GvENAME(gv));
1d2dff63
GS
634 SETERRNO(EBADF,SS$_IVCHAN);
635 }
a687059c
LW
636 return FALSE;
637 }
1193dd27 638 retval = io_close(io);
517844ec 639 if (not_implicit) {
1193dd27
IZ
640 IoLINES(io) = 0;
641 IoPAGE(io) = 0;
642 IoLINES_LEFT(io) = IoPAGE_LEN(io);
643 }
644 IoTYPE(io) = ' ';
645 return retval;
646}
647
648bool
8ac85365 649io_close(IO *io)
1193dd27
IZ
650{
651 bool retval = FALSE;
652 int status;
653
8990e307
LW
654 if (IoIFP(io)) {
655 if (IoTYPE(io) == '|') {
3028581b 656 status = PerlProc_pclose(IoIFP(io));
f86702cc 657 STATUS_NATIVE_SET(status);
1e422769 658 retval = (STATUS_POSIX == 0);
a687059c 659 }
8990e307 660 else if (IoTYPE(io) == '-')
a687059c
LW
661 retval = TRUE;
662 else {
8990e307 663 if (IoOFP(io) && IoOFP(io) != IoIFP(io)) { /* a socket */
760ac839
LW
664 retval = (PerlIO_close(IoOFP(io)) != EOF);
665 PerlIO_close(IoIFP(io)); /* clear stdio, fd already closed */
c2ab57d4
LW
666 }
667 else
760ac839 668 retval = (PerlIO_close(IoIFP(io)) != EOF);
a687059c 669 }
8990e307 670 IoOFP(io) = IoIFP(io) = Nullfp;
79072805 671 }
20408e3c
GS
672 else {
673 SETERRNO(EBADF,SS$_IVCHAN);
674 }
1193dd27 675
a687059c
LW
676 return retval;
677}
678
679bool
8ac85365 680do_eof(GV *gv)
a687059c 681{
11343788 682 dTHR;
79072805 683 register IO *io;
a687059c
LW
684 int ch;
685
79072805 686 io = GvIO(gv);
a687059c 687
79072805 688 if (!io)
a687059c
LW
689 return TRUE;
690
8990e307 691 while (IoIFP(io)) {
a687059c 692
760ac839
LW
693 if (PerlIO_has_cntptr(IoIFP(io))) { /* (the code works without this) */
694 if (PerlIO_get_cnt(IoIFP(io)) > 0) /* cheat a little, since */
695 return FALSE; /* this is the most usual case */
696 }
a687059c 697
760ac839 698 ch = PerlIO_getc(IoIFP(io));
a687059c 699 if (ch != EOF) {
760ac839 700 (void)PerlIO_ungetc(IoIFP(io),ch);
a687059c
LW
701 return FALSE;
702 }
760ac839
LW
703 if (PerlIO_has_cntptr(IoIFP(io)) && PerlIO_canset_cnt(IoIFP(io))) {
704 if (PerlIO_get_cnt(IoIFP(io)) < -1)
705 PerlIO_set_cnt(IoIFP(io),-1);
706 }
533c011a 707 if (PL_op->op_flags & OPf_SPECIAL) { /* not necessarily a real EOF yet? */
3280af22 708 if (!nextargv(PL_argvgv)) /* get another fp handy */
a687059c
LW
709 return TRUE;
710 }
711 else
712 return TRUE; /* normal fp, definitely end of file */
713 }
714 return TRUE;
715}
716
5ff3f7a4 717Off_t
8ac85365 718do_tell(GV *gv)
a687059c 719{
79072805 720 register IO *io;
96e4d5b1 721 register PerlIO *fp;
a687059c 722
96e4d5b1 723 if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) {
bee1dbe2 724#ifdef ULTRIX_STDIO_BOTCH
96e4d5b1
PP
725 if (PerlIO_eof(fp))
726 (void)PerlIO_seek(fp, 0L, 2); /* ultrix 1.2 workaround */
bee1dbe2 727#endif
8903cb82 728 return PerlIO_tell(fp);
96e4d5b1 729 }
d008e5eb
GS
730 {
731 dTHR;
732 if (ckWARN(WARN_UNOPENED))
733 warner(WARN_UNOPENED, "tell() on unopened file");
734 }
748a9306 735 SETERRNO(EBADF,RMS$_IFI);
5ff3f7a4 736 return (Off_t)-1;
a687059c
LW
737}
738
739bool
5ff3f7a4 740do_seek(GV *gv, Off_t pos, int whence)
a687059c 741{
79072805 742 register IO *io;
137443ea 743 register PerlIO *fp;
a687059c 744
137443ea 745 if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) {
bee1dbe2 746#ifdef ULTRIX_STDIO_BOTCH
137443ea
PP
747 if (PerlIO_eof(fp))
748 (void)PerlIO_seek(fp, 0L, 2); /* ultrix 1.2 workaround */
bee1dbe2 749#endif
8903cb82 750 return PerlIO_seek(fp, pos, whence) >= 0;
137443ea 751 }
d008e5eb
GS
752 {
753 dTHR;
754 if (ckWARN(WARN_UNOPENED))
755 warner(WARN_UNOPENED, "seek() on unopened file");
756 }
748a9306 757 SETERRNO(EBADF,RMS$_IFI);
a687059c
LW
758 return FALSE;
759}
760
97cc44eb
SH
761Off_t
762do_sysseek(GV *gv, Off_t pos, int whence)
8903cb82
PP
763{
764 register IO *io;
765 register PerlIO *fp;
766
767 if (gv && (io = GvIO(gv)) && (fp = IoIFP(io)))
3028581b 768 return PerlLIO_lseek(PerlIO_fileno(fp), pos, whence);
d008e5eb
GS
769 {
770 dTHR;
771 if (ckWARN(WARN_UNOPENED))
772 warner(WARN_UNOPENED, "sysseek() on unopened file");
773 }
8903cb82
PP
774 SETERRNO(EBADF,RMS$_IFI);
775 return -1L;
776}
777
6ff81951
GS
778int
779do_binmode(PerlIO *fp, int iotype, int flag)
780{
781 if (flag != TRUE)
782 croak("panic: unsetting binmode"); /* Not implemented yet */
783#ifdef DOSISH
61ae2fbf 784#if defined(atarist) || defined(__MINT__)
6ff81951
GS
785 if (!PerlIO_flush(fp) && (fp->_flag |= _IOBIN))
786 return 1;
787 else
788 return 0;
789#else
790 if (PerlLIO_setmode(PerlIO_fileno(fp), OP_BINARY) != -1) {
791#if defined(WIN32) && defined(__BORLANDC__)
792 /* The translation mode of the stream is maintained independent
793 * of the translation mode of the fd in the Borland RTL (heavy
794 * digging through their runtime sources reveal). User has to
795 * set the mode explicitly for the stream (though they don't
796 * document this anywhere). GSAR 97-5-24
797 */
798 PerlIO_seek(fp,0L,0);
873ef191 799 ((FILE*)fp)->flags |= _F_BIN;
6ff81951
GS
800#endif
801 return 1;
802 }
803 else
804 return 0;
805#endif
806#else
807#if defined(USEMYBINMODE)
808 if (my_binmode(fp,iotype) != NULL)
809 return 1;
810 else
811 return 0;
812#else
813 return 1;
814#endif
815#endif
816}
817
a0d0e21e 818#if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP)
c2ab57d4 819 /* code courtesy of William Kucharski */
fe14fcc3 820#define HAS_CHSIZE
6eb13c3b 821
517844ec 822I32 my_chsize(fd, length)
79072805 823I32 fd; /* file descriptor */
85e6fe83 824Off_t length; /* length to set file to */
6eb13c3b 825{
6eb13c3b
LW
826 struct flock fl;
827 struct stat filebuf;
828
3028581b 829 if (PerlLIO_fstat(fd, &filebuf) < 0)
6eb13c3b
LW
830 return -1;
831
832 if (filebuf.st_size < length) {
833
834 /* extend file length */
835
3028581b 836 if ((PerlLIO_lseek(fd, (length - 1), 0)) < 0)
6eb13c3b
LW
837 return -1;
838
839 /* write a "0" byte */
840
3028581b 841 if ((PerlLIO_write(fd, "", 1)) != 1)
6eb13c3b
LW
842 return -1;
843 }
844 else {
845 /* truncate length */
846
847 fl.l_whence = 0;
848 fl.l_len = 0;
849 fl.l_start = length;
a0d0e21e 850 fl.l_type = F_WRLCK; /* write lock on file space */
6eb13c3b
LW
851
852 /*
a0d0e21e 853 * This relies on the UNDOCUMENTED F_FREESP argument to
6eb13c3b
LW
854 * fcntl(2), which truncates the file so that it ends at the
855 * position indicated by fl.l_start.
856 *
857 * Will minor miracles never cease?
858 */
859
a0d0e21e 860 if (fcntl(fd, F_FREESP, &fl) < 0)
6eb13c3b
LW
861 return -1;
862
863 }
864
865 return 0;
866}
a0d0e21e 867#endif /* F_FREESP */
ff8e2863 868
a687059c 869bool
6acef3b7 870do_print(register SV *sv, PerlIO *fp)
a687059c
LW
871{
872 register char *tmps;
463ee0b2 873 STRLEN len;
a687059c 874
79072805
LW
875 /* assuming fp is checked earlier */
876 if (!sv)
877 return TRUE;
3280af22 878 if (PL_ofmt) {
8990e307 879 if (SvGMAGICAL(sv))
79072805 880 mg_get(sv);
463ee0b2 881 if (SvIOK(sv) && SvIVX(sv) != 0) {
3280af22 882 PerlIO_printf(fp, PL_ofmt, (double)SvIVX(sv));
760ac839 883 return !PerlIO_error(fp);
79072805 884 }
463ee0b2 885 if ( (SvNOK(sv) && SvNVX(sv) != 0.0)
79072805 886 || (looks_like_number(sv) && sv_2nv(sv) != 0.0) ) {
3280af22 887 PerlIO_printf(fp, PL_ofmt, SvNVX(sv));
760ac839 888 return !PerlIO_error(fp);
79072805 889 }
a687059c 890 }
79072805
LW
891 switch (SvTYPE(sv)) {
892 case SVt_NULL:
d008e5eb
GS
893 {
894 dTHR;
895 if (ckWARN(WARN_UNINITIALIZED))
22c35a8c 896 warner(WARN_UNINITIALIZED, PL_warn_uninit);
d008e5eb 897 }
ff8e2863 898 return TRUE;
79072805 899 case SVt_IV:
a0d0e21e
LW
900 if (SvIOK(sv)) {
901 if (SvGMAGICAL(sv))
902 mg_get(sv);
760ac839
LW
903 PerlIO_printf(fp, "%ld", (long)SvIVX(sv));
904 return !PerlIO_error(fp);
a0d0e21e
LW
905 }
906 /* FALL THROUGH */
79072805 907 default:
463ee0b2 908 tmps = SvPV(sv, len);
79072805 909 break;
ff8e2863 910 }
760ac839 911 if (len && (PerlIO_write(fp,tmps,len) == 0 || PerlIO_error(fp)))
a687059c 912 return FALSE;
760ac839 913 return !PerlIO_error(fp);
a687059c
LW
914}
915
79072805 916I32
8ac85365 917my_stat(ARGSproto)
a687059c 918{
4e35701f 919 djSP;
79072805 920 IO *io;
748a9306 921 GV* tmpgv;
79072805 922
533c011a 923 if (PL_op->op_flags & OPf_REF) {
924508f0 924 EXTEND(SP,1);
748a9306
LW
925 tmpgv = cGVOP->op_gv;
926 do_fstat:
927 io = GvIO(tmpgv);
8990e307 928 if (io && IoIFP(io)) {
3280af22
NIS
929 PL_statgv = tmpgv;
930 sv_setpv(PL_statname,"");
931 PL_laststype = OP_STAT;
932 return (PL_laststatval = PerlLIO_fstat(PerlIO_fileno(IoIFP(io)), &PL_statcache));
a687059c
LW
933 }
934 else {
3280af22
NIS
935 if (tmpgv == PL_defgv)
936 return PL_laststatval;
599cee73
PM
937 if (ckWARN(WARN_UNOPENED))
938 warner(WARN_UNOPENED, "Stat on unopened file <%s>",
748a9306 939 GvENAME(tmpgv));
3280af22
NIS
940 PL_statgv = Nullgv;
941 sv_setpv(PL_statname,"");
942 return (PL_laststatval = -1);
a687059c
LW
943 }
944 }
945 else {
748a9306 946 SV* sv = POPs;
4b74e3fb 947 char *s;
2d8e6c8d 948 STRLEN n_a;
79072805 949 PUTBACK;
748a9306
LW
950 if (SvTYPE(sv) == SVt_PVGV) {
951 tmpgv = (GV*)sv;
952 goto do_fstat;
953 }
954 else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
955 tmpgv = (GV*)SvRV(sv);
956 goto do_fstat;
957 }
958
2d8e6c8d 959 s = SvPV(sv, n_a);
3280af22
NIS
960 PL_statgv = Nullgv;
961 sv_setpv(PL_statname, s);
962 PL_laststype = OP_STAT;
963 PL_laststatval = PerlLIO_stat(s, &PL_statcache);
599cee73 964 if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(s, '\n'))
22c35a8c 965 warner(WARN_NEWLINE, PL_warn_nl, "stat");
3280af22 966 return PL_laststatval;
a687059c
LW
967 }
968}
969
79072805 970I32
8ac85365 971my_lstat(ARGSproto)
c623bd54 972{
4e35701f 973 djSP;
79072805 974 SV *sv;
2d8e6c8d 975 STRLEN n_a;
533c011a 976 if (PL_op->op_flags & OPf_REF) {
924508f0 977 EXTEND(SP,1);
3280af22
NIS
978 if (cGVOP->op_gv == PL_defgv) {
979 if (PL_laststype != OP_LSTAT)
463ee0b2 980 croak("The stat preceding -l _ wasn't an lstat");
3280af22 981 return PL_laststatval;
fe14fcc3 982 }
463ee0b2 983 croak("You can't use -l on a filehandle");
fe14fcc3 984 }
c623bd54 985
3280af22
NIS
986 PL_laststype = OP_LSTAT;
987 PL_statgv = Nullgv;
79072805
LW
988 sv = POPs;
989 PUTBACK;
2d8e6c8d 990 sv_setpv(PL_statname,SvPV(sv, n_a));
fe14fcc3 991#ifdef HAS_LSTAT
2d8e6c8d 992 PL_laststatval = PerlLIO_lstat(SvPV(sv, n_a),&PL_statcache);
c623bd54 993#else
2d8e6c8d 994 PL_laststatval = PerlLIO_stat(SvPV(sv, n_a),&PL_statcache);
c623bd54 995#endif
2d8e6c8d 996 if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, n_a), '\n'))
22c35a8c 997 warner(WARN_NEWLINE, PL_warn_nl, "lstat");
3280af22 998 return PL_laststatval;
c623bd54
LW
999}
1000
a687059c 1001bool
8ac85365 1002do_aexec(SV *really, register SV **mark, register SV **sp)
a687059c 1003{
a687059c 1004 register char **a;
a687059c 1005 char *tmps;
2d8e6c8d 1006 STRLEN n_a;
a687059c 1007
79072805 1008 if (sp > mark) {
11343788 1009 dTHR;
3280af22
NIS
1010 New(401,PL_Argv, sp - mark + 1, char*);
1011 a = PL_Argv;
79072805
LW
1012 while (++mark <= sp) {
1013 if (*mark)
2d8e6c8d 1014 *a++ = SvPVx(*mark, n_a);
a687059c
LW
1015 else
1016 *a++ = "";
1017 }
1018 *a = Nullch;
3280af22 1019 if (*PL_Argv[0] != '/') /* will execvp use PATH? */
79072805 1020 TAINT_ENV(); /* testing IFS here is overkill, probably */
2d8e6c8d 1021 if (really && *(tmps = SvPV(really, n_a)))
3280af22 1022 PerlProc_execvp(tmps,PL_Argv);
a687059c 1023 else
3280af22 1024 PerlProc_execvp(PL_Argv[0],PL_Argv);
599cee73
PM
1025 if (ckWARN(WARN_EXEC))
1026 warner(WARN_EXEC, "Can't exec \"%s\": %s",
1027 PL_Argv[0], Strerror(errno));
a687059c 1028 }
bee1dbe2 1029 do_execfree();
a687059c
LW
1030 return FALSE;
1031}
1032
fe14fcc3 1033void
8ac85365 1034do_execfree(void)
ff8e2863 1035{
3280af22
NIS
1036 if (PL_Argv) {
1037 Safefree(PL_Argv);
1038 PL_Argv = Null(char **);
ff8e2863 1039 }
3280af22
NIS
1040 if (PL_Cmd) {
1041 Safefree(PL_Cmd);
1042 PL_Cmd = Nullch;
ff8e2863
LW
1043 }
1044}
1045
39e571d4 1046#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP)
760ac839 1047
a687059c 1048bool
8ac85365 1049do_exec(char *cmd)
a687059c
LW
1050{
1051 register char **a;
1052 register char *s;
a687059c
LW
1053 char flags[10];
1054
748a9306
LW
1055 while (*cmd && isSPACE(*cmd))
1056 cmd++;
1057
a687059c
LW
1058 /* save an extra exec if possible */
1059
bf38876a 1060#ifdef CSH
3280af22 1061 if (strnEQ(cmd,PL_cshname,PL_cshlen) && strnEQ(cmd+PL_cshlen," -c",3)) {
a687059c 1062 strcpy(flags,"-c");
3280af22 1063 s = cmd+PL_cshlen+3;
a687059c
LW
1064 if (*s == 'f') {
1065 s++;
1066 strcat(flags,"f");
1067 }
1068 if (*s == ' ')
1069 s++;
1070 if (*s++ == '\'') {
1071 char *ncmd = s;
1072
1073 while (*s)
1074 s++;
1075 if (s[-1] == '\n')
1076 *--s = '\0';
1077 if (s[-1] == '\'') {
1078 *--s = '\0';
3280af22 1079 PerlProc_execl(PL_cshname,"csh", flags,ncmd,(char*)0);
a687059c
LW
1080 *s = '\'';
1081 return FALSE;
1082 }
1083 }
1084 }
bf38876a 1085#endif /* CSH */
a687059c
LW
1086
1087 /* see if there are shell metacharacters in it */
1088
748a9306
LW
1089 if (*cmd == '.' && isSPACE(cmd[1]))
1090 goto doshell;
1091
1092 if (strnEQ(cmd,"exec",4) && isSPACE(cmd[4]))
1093 goto doshell;
1094
99b89507 1095 for (s = cmd; *s && isALPHA(*s); s++) ; /* catch VAR=val gizmo */
63f2c1e1
LW
1096 if (*s == '=')
1097 goto doshell;
748a9306 1098
a687059c 1099 for (s = cmd; *s; s++) {
93a17b20 1100 if (*s != ' ' && !isALPHA(*s) && strchr("$&*(){}[]'\";\\|?<>~`\n",*s)) {
a687059c
LW
1101 if (*s == '\n' && !s[1]) {
1102 *s = '\0';
1103 break;
1104 }
1105 doshell:
3280af22 1106 PerlProc_execl(PL_sh_path, "sh", "-c", cmd, (char*)0);
a687059c
LW
1107 return FALSE;
1108 }
1109 }
748a9306 1110
3280af22
NIS
1111 New(402,PL_Argv, (s - cmd) / 2 + 2, char*);
1112 PL_Cmd = savepvn(cmd, s-cmd);
1113 a = PL_Argv;
1114 for (s = PL_Cmd; *s;) {
99b89507 1115 while (*s && isSPACE(*s)) s++;
a687059c
LW
1116 if (*s)
1117 *(a++) = s;
99b89507 1118 while (*s && !isSPACE(*s)) s++;
a687059c
LW
1119 if (*s)
1120 *s++ = '\0';
1121 }
1122 *a = Nullch;
3280af22
NIS
1123 if (PL_Argv[0]) {
1124 PerlProc_execvp(PL_Argv[0],PL_Argv);
b1248f16 1125 if (errno == ENOEXEC) { /* for system V NIH syndrome */
ff8e2863 1126 do_execfree();
a687059c 1127 goto doshell;
b1248f16 1128 }
d008e5eb
GS
1129 {
1130 dTHR;
1131 if (ckWARN(WARN_EXEC))
1132 warner(WARN_EXEC, "Can't exec \"%s\": %s",
1133 PL_Argv[0], Strerror(errno));
1134 }
a687059c 1135 }
ff8e2863 1136 do_execfree();
a687059c
LW
1137 return FALSE;
1138}
1139
6890e559 1140#endif /* OS2 || WIN32 */
760ac839 1141
79072805 1142I32
8ac85365 1143apply(I32 type, register SV **mark, register SV **sp)
a687059c 1144{
11343788 1145 dTHR;
79072805
LW
1146 register I32 val;
1147 register I32 val2;
1148 register I32 tot = 0;
20408e3c 1149 char *what;
a687059c 1150 char *s;
79072805 1151 SV **oldmark = mark;
2d8e6c8d 1152 STRLEN n_a;
a687059c 1153
20408e3c 1154#define APPLY_TAINT_PROPER() \
3280af22
NIS
1155 STMT_START { \
1156 if (PL_tainting && PL_tainted) { goto taint_proper_label; } \
873ef191 1157 } STMT_END
20408e3c
GS
1158
1159 /* This is a first heuristic; it doesn't catch tainting magic. */
3280af22 1160 if (PL_tainting) {
463ee0b2 1161 while (++mark <= sp) {
bbce6d69
PP
1162 if (SvTAINTED(*mark)) {
1163 TAINT;
1164 break;
1165 }
463ee0b2
LW
1166 }
1167 mark = oldmark;
1168 }
a687059c 1169 switch (type) {
79072805 1170 case OP_CHMOD:
20408e3c
GS
1171 what = "chmod";
1172 APPLY_TAINT_PROPER();
79072805 1173 if (++mark <= sp) {
463ee0b2 1174 val = SvIVx(*mark);
20408e3c
GS
1175 APPLY_TAINT_PROPER();
1176 tot = sp - mark;
79072805 1177 while (++mark <= sp) {
2d8e6c8d 1178 char *name = SvPVx(*mark, n_a);
20408e3c
GS
1179 APPLY_TAINT_PROPER();
1180 if (PerlLIO_chmod(name, val))
a687059c
LW
1181 tot--;
1182 }
1183 }
1184 break;
fe14fcc3 1185#ifdef HAS_CHOWN
79072805 1186 case OP_CHOWN:
20408e3c
GS
1187 what = "chown";
1188 APPLY_TAINT_PROPER();
79072805 1189 if (sp - mark > 2) {
463ee0b2
LW
1190 val = SvIVx(*++mark);
1191 val2 = SvIVx(*++mark);
20408e3c 1192 APPLY_TAINT_PROPER();
a0d0e21e 1193 tot = sp - mark;
79072805 1194 while (++mark <= sp) {
2d8e6c8d 1195 char *name = SvPVx(*mark, n_a);
20408e3c 1196 APPLY_TAINT_PROPER();
36660982 1197 if (PerlLIO_chown(name, val, val2))
a687059c
LW
1198 tot--;
1199 }
1200 }
1201 break;
b1248f16 1202#endif
dd64f1c3
AD
1203/*
1204XXX Should we make lchown() directly available from perl?
1205For now, we'll let Configure test for HAS_LCHOWN, but do
1206nothing in the core.
1207 --AD 5/1998
1208*/
fe14fcc3 1209#ifdef HAS_KILL
79072805 1210 case OP_KILL:
20408e3c
GS
1211 what = "kill";
1212 APPLY_TAINT_PROPER();
55497cff
PP
1213 if (mark == sp)
1214 break;
2d8e6c8d 1215 s = SvPVx(*++mark, n_a);
79072805
LW
1216 if (isUPPER(*s)) {
1217 if (*s == 'S' && s[1] == 'I' && s[2] == 'G')
1218 s += 3;
1219 if (!(val = whichsig(s)))
463ee0b2 1220 croak("Unrecognized signal name \"%s\"",s);
79072805
LW
1221 }
1222 else
463ee0b2 1223 val = SvIVx(*mark);
20408e3c
GS
1224 APPLY_TAINT_PROPER();
1225 tot = sp - mark;
3595fcef
PP
1226#ifdef VMS
1227 /* kill() doesn't do process groups (job trees?) under VMS */
1228 if (val < 0) val = -val;
1229 if (val == SIGKILL) {
1230# include <starlet.h>
1231 /* Use native sys$delprc() to insure that target process is
1232 * deleted; supervisor-mode images don't pay attention to
1233 * CRTL's emulation of Unix-style signals and kill()
1234 */
1235 while (++mark <= sp) {
1236 I32 proc = SvIVx(*mark);
1237 register unsigned long int __vmssts;
20408e3c 1238 APPLY_TAINT_PROPER();
3595fcef
PP
1239 if (!((__vmssts = sys$delprc(&proc,0)) & 1)) {
1240 tot--;
1241 switch (__vmssts) {
1242 case SS$_NONEXPR:
1243 case SS$_NOSUCHNODE:
1244 SETERRNO(ESRCH,__vmssts);
1245 break;
1246 case SS$_NOPRIV:
1247 SETERRNO(EPERM,__vmssts);
1248 break;
1249 default:
1250 SETERRNO(EVMSERR,__vmssts);
1251 }
1252 }
1253 }
1254 break;
1255 }
1256#endif
79072805
LW
1257 if (val < 0) {
1258 val = -val;
1259 while (++mark <= sp) {
463ee0b2 1260 I32 proc = SvIVx(*mark);
20408e3c 1261 APPLY_TAINT_PROPER();
fe14fcc3 1262#ifdef HAS_KILLPG
3028581b 1263 if (PerlProc_killpg(proc,val)) /* BSD */
a687059c 1264#else
3028581b 1265 if (PerlProc_kill(-proc,val)) /* SYSV */
a687059c 1266#endif
79072805 1267 tot--;
a687059c 1268 }
79072805
LW
1269 }
1270 else {
1271 while (++mark <= sp) {
20408e3c
GS
1272 I32 proc = SvIVx(*mark);
1273 APPLY_TAINT_PROPER();
1274 if (PerlProc_kill(proc, val))
79072805 1275 tot--;
a687059c
LW
1276 }
1277 }
1278 break;
b1248f16 1279#endif
79072805 1280 case OP_UNLINK:
20408e3c
GS
1281 what = "unlink";
1282 APPLY_TAINT_PROPER();
79072805
LW
1283 tot = sp - mark;
1284 while (++mark <= sp) {
2d8e6c8d 1285 s = SvPVx(*mark, n_a);
20408e3c 1286 APPLY_TAINT_PROPER();
3280af22 1287 if (PL_euid || PL_unsafe) {
a687059c
LW
1288 if (UNLINK(s))
1289 tot--;
1290 }
1291 else { /* don't let root wipe out directories without -U */
fe14fcc3 1292#ifdef HAS_LSTAT
3280af22 1293 if (PerlLIO_lstat(s,&PL_statbuf) < 0 || S_ISDIR(PL_statbuf.st_mode))
a687059c 1294#else
b28d0864 1295 if (PerlLIO_stat(s,&PL_statbuf) < 0 || S_ISDIR(PL_statbuf.st_mode))
a687059c 1296#endif
a687059c
LW
1297 tot--;
1298 else {
1299 if (UNLINK(s))
1300 tot--;
1301 }
1302 }
1303 }
1304 break;
a0d0e21e 1305#ifdef HAS_UTIME
79072805 1306 case OP_UTIME:
20408e3c
GS
1307 what = "utime";
1308 APPLY_TAINT_PROPER();
79072805 1309 if (sp - mark > 2) {
748a9306 1310#if defined(I_UTIME) || defined(VMS)
663a0e37
LW
1311 struct utimbuf utbuf;
1312#else
a687059c 1313 struct {
663a0e37
LW
1314 long actime;
1315 long modtime;
a687059c 1316 } utbuf;
663a0e37 1317#endif
a687059c 1318
afd9f252 1319 Zero(&utbuf, sizeof utbuf, char);
517844ec
PP
1320#ifdef BIG_TIME
1321 utbuf.actime = (Time_t)SvNVx(*++mark); /* time accessed */
1322 utbuf.modtime = (Time_t)SvNVx(*++mark); /* time modified */
1323#else
463ee0b2
LW
1324 utbuf.actime = SvIVx(*++mark); /* time accessed */
1325 utbuf.modtime = SvIVx(*++mark); /* time modified */
517844ec 1326#endif
20408e3c 1327 APPLY_TAINT_PROPER();
79072805
LW
1328 tot = sp - mark;
1329 while (++mark <= sp) {
2d8e6c8d 1330 char *name = SvPVx(*mark, n_a);
20408e3c
GS
1331 APPLY_TAINT_PROPER();
1332 if (PerlLIO_utime(name, &utbuf))
a687059c
LW
1333 tot--;
1334 }
a687059c
LW
1335 }
1336 else
79072805 1337 tot = 0;
a687059c 1338 break;
a0d0e21e 1339#endif
a687059c
LW
1340 }
1341 return tot;
20408e3c 1342
873ef191 1343 taint_proper_label:
20408e3c
GS
1344 TAINT_PROPER(what);
1345 return 0; /* this should never happen */
1346
1347#undef APPLY_TAINT_PROPER
a687059c
LW
1348}
1349
1350/* Do the permissions allow some operation? Assumes statcache already set. */
a0d0e21e 1351#ifndef VMS /* VMS' cando is in vms.c */
79072805 1352I32
8ac85365 1353cando(I32 bit, I32 effective, register struct stat *statbufp)
a687059c 1354{
bee1dbe2 1355#ifdef DOSISH
fe14fcc3
LW
1356 /* [Comments and code from Len Reed]
1357 * MS-DOS "user" is similar to UNIX's "superuser," but can't write
1358 * to write-protected files. The execute permission bit is set
1359 * by the Miscrosoft C library stat() function for the following:
1360 * .exe files
1361 * .com files
1362 * .bat files
1363 * directories
1364 * All files and directories are readable.
1365 * Directories and special files, e.g. "CON", cannot be
1366 * write-protected.
1367 * [Comment by Tom Dinger -- a directory can have the write-protect
1368 * bit set in the file system, but DOS permits changes to
1369 * the directory anyway. In addition, all bets are off
1370 * here for networked software, such as Novell and
1371 * Sun's PC-NFS.]
1372 */
1373
bee1dbe2
LW
1374 /* Atari stat() does pretty much the same thing. we set x_bit_set_in_stat
1375 * too so it will actually look into the files for magic numbers
1376 */
fe14fcc3
LW
1377 return (bit & statbufp->st_mode) ? TRUE : FALSE;
1378
55497cff 1379#else /* ! DOSISH */
3280af22 1380 if ((effective ? PL_euid : PL_uid) == 0) { /* root is special */
c623bd54
LW
1381 if (bit == S_IXUSR) {
1382 if (statbufp->st_mode & 0111 || S_ISDIR(statbufp->st_mode))
a687059c
LW
1383 return TRUE;
1384 }
1385 else
1386 return TRUE; /* root reads and writes anything */
1387 return FALSE;
1388 }
3280af22 1389 if (statbufp->st_uid == (effective ? PL_euid : PL_uid) ) {
a687059c
LW
1390 if (statbufp->st_mode & bit)
1391 return TRUE; /* ok as "user" */
1392 }
79072805 1393 else if (ingroup((I32)statbufp->st_gid,effective)) {
a687059c
LW
1394 if (statbufp->st_mode & bit >> 3)
1395 return TRUE; /* ok as "group" */
1396 }
1397 else if (statbufp->st_mode & bit >> 6)
1398 return TRUE; /* ok as "other" */
1399 return FALSE;
55497cff 1400#endif /* ! DOSISH */
a687059c 1401}
a0d0e21e 1402#endif /* ! VMS */
a687059c 1403
79072805 1404I32
8ac85365 1405ingroup(I32 testgid, I32 effective)
a687059c 1406{
3280af22 1407 if (testgid == (effective ? PL_egid : PL_gid))
a687059c 1408 return TRUE;
fe14fcc3 1409#ifdef HAS_GETGROUPS
a687059c
LW
1410#ifndef NGROUPS
1411#define NGROUPS 32
1412#endif
1413 {
a0d0e21e 1414 Groups_t gary[NGROUPS];
79072805 1415 I32 anum;
a687059c
LW
1416
1417 anum = getgroups(NGROUPS,gary);
1418 while (--anum >= 0)
1419 if (gary[anum] == testgid)
1420 return TRUE;
1421 }
1422#endif
1423 return FALSE;
1424}
c2ab57d4 1425
fe14fcc3 1426#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
c2ab57d4 1427
79072805 1428I32
8ac85365 1429do_ipcget(I32 optype, SV **mark, SV **sp)
c2ab57d4 1430{
11343788 1431 dTHR;
c2ab57d4 1432 key_t key;
79072805 1433 I32 n, flags;
c2ab57d4 1434
463ee0b2
LW
1435 key = (key_t)SvNVx(*++mark);
1436 n = (optype == OP_MSGGET) ? 0 : SvIVx(*++mark);
1437 flags = SvIVx(*++mark);
748a9306 1438 SETERRNO(0,0);
c2ab57d4
LW
1439 switch (optype)
1440 {
fe14fcc3 1441#ifdef HAS_MSG
79072805 1442 case OP_MSGGET:
c2ab57d4 1443 return msgget(key, flags);
e5d73d77 1444#endif
fe14fcc3 1445#ifdef HAS_SEM
79072805 1446 case OP_SEMGET:
c2ab57d4 1447 return semget(key, n, flags);
e5d73d77 1448#endif
fe14fcc3 1449#ifdef HAS_SHM
79072805 1450 case OP_SHMGET:
c2ab57d4 1451 return shmget(key, n, flags);
e5d73d77 1452#endif
fe14fcc3 1453#if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM)
e5d73d77 1454 default:
4369b173 1455 croak("%s not implemented", PL_op_desc[optype]);
e5d73d77 1456#endif
c2ab57d4
LW
1457 }
1458 return -1; /* should never happen */
1459}
1460
79072805 1461I32
8ac85365 1462do_ipcctl(I32 optype, SV **mark, SV **sp)
c2ab57d4 1463{
11343788 1464 dTHR;
79072805 1465 SV *astr;
c2ab57d4 1466 char *a;
a0d0e21e
LW
1467 I32 id, n, cmd, infosize, getinfo;
1468 I32 ret = -1;
c2ab57d4 1469
463ee0b2
LW
1470 id = SvIVx(*++mark);
1471 n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0;
1472 cmd = SvIVx(*++mark);
79072805 1473 astr = *++mark;
c2ab57d4
LW
1474 infosize = 0;
1475 getinfo = (cmd == IPC_STAT);
1476
1477 switch (optype)
1478 {
fe14fcc3 1479#ifdef HAS_MSG
79072805 1480 case OP_MSGCTL:
c2ab57d4
LW
1481 if (cmd == IPC_STAT || cmd == IPC_SET)
1482 infosize = sizeof(struct msqid_ds);
1483 break;
e5d73d77 1484#endif
fe14fcc3 1485#ifdef HAS_SHM
79072805 1486 case OP_SHMCTL:
c2ab57d4
LW
1487 if (cmd == IPC_STAT || cmd == IPC_SET)
1488 infosize = sizeof(struct shmid_ds);
1489 break;
e5d73d77 1490#endif
fe14fcc3 1491#ifdef HAS_SEM
79072805 1492 case OP_SEMCTL:
c2ab57d4
LW
1493 if (cmd == IPC_STAT || cmd == IPC_SET)
1494 infosize = sizeof(struct semid_ds);
1495 else if (cmd == GETALL || cmd == SETALL)
1496 {
8e591e46 1497 struct semid_ds semds;
bd89102f
AD
1498 union semun semun;
1499
84902520 1500 semun.buf = &semds;
c2ab57d4 1501 getinfo = (cmd == GETALL);
9b89d93d
GB
1502 if (Semctl(id, 0, IPC_STAT, semun) == -1)
1503 return -1;
6e21c824
LW
1504 infosize = semds.sem_nsems * sizeof(short);
1505 /* "short" is technically wrong but much more portable
1506 than guessing about u_?short(_t)? */
c2ab57d4
LW
1507 }
1508 break;
e5d73d77 1509#endif
fe14fcc3 1510#if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM)
e5d73d77 1511 default:
4369b173 1512 croak("%s not implemented", PL_op_desc[optype]);
e5d73d77 1513#endif
c2ab57d4
LW
1514 }
1515
1516 if (infosize)
1517 {
a0d0e21e 1518 STRLEN len;
c2ab57d4
LW
1519 if (getinfo)
1520 {
a0d0e21e
LW
1521 SvPV_force(astr, len);
1522 a = SvGROW(astr, infosize+1);
c2ab57d4
LW
1523 }
1524 else
1525 {
463ee0b2
LW
1526 a = SvPV(astr, len);
1527 if (len != infosize)
9607fc9c 1528 croak("Bad arg length for %s, is %lu, should be %ld",
4ec43091
JH
1529 PL_op_desc[optype],
1530 (unsigned long)len,
1531 (long)infosize);
c2ab57d4
LW
1532 }
1533 }
1534 else
1535 {
c030ccd9 1536 IV i = SvIV(astr);
c2ab57d4
LW
1537 a = (char *)i; /* ouch */
1538 }
748a9306 1539 SETERRNO(0,0);
c2ab57d4
LW
1540 switch (optype)
1541 {
fe14fcc3 1542#ifdef HAS_MSG
79072805 1543 case OP_MSGCTL:
bee1dbe2 1544 ret = msgctl(id, cmd, (struct msqid_ds *)a);
c2ab57d4 1545 break;
e5d73d77 1546#endif
fe14fcc3 1547#ifdef HAS_SEM
bd89102f
AD
1548 case OP_SEMCTL: {
1549 union semun unsemds;
1550
1551 unsemds.buf = (struct semid_ds *)a;
1552 ret = Semctl(id, n, cmd, unsemds);
1553 }
c2ab57d4 1554 break;
e5d73d77 1555#endif
fe14fcc3 1556#ifdef HAS_SHM
79072805 1557 case OP_SHMCTL:
bee1dbe2 1558 ret = shmctl(id, cmd, (struct shmid_ds *)a);
c2ab57d4 1559 break;
e5d73d77 1560#endif
c2ab57d4
LW
1561 }
1562 if (getinfo && ret >= 0) {
79072805
LW
1563 SvCUR_set(astr, infosize);
1564 *SvEND(astr) = '\0';
a0d0e21e 1565 SvSETMAGIC(astr);
c2ab57d4
LW
1566 }
1567 return ret;
1568}
1569
79072805 1570I32
8ac85365 1571do_msgsnd(SV **mark, SV **sp)
c2ab57d4 1572{
fe14fcc3 1573#ifdef HAS_MSG
11343788 1574 dTHR;
79072805 1575 SV *mstr;
c2ab57d4 1576 char *mbuf;
79072805 1577 I32 id, msize, flags;
463ee0b2 1578 STRLEN len;
c2ab57d4 1579
463ee0b2 1580 id = SvIVx(*++mark);
79072805 1581 mstr = *++mark;
463ee0b2
LW
1582 flags = SvIVx(*++mark);
1583 mbuf = SvPV(mstr, len);
1584 if ((msize = len - sizeof(long)) < 0)
1585 croak("Arg too short for msgsnd");
748a9306 1586 SETERRNO(0,0);
bee1dbe2 1587 return msgsnd(id, (struct msgbuf *)mbuf, msize, flags);
e5d73d77 1588#else
463ee0b2 1589 croak("msgsnd not implemented");
e5d73d77 1590#endif
c2ab57d4
LW
1591}
1592
79072805 1593I32
8ac85365 1594do_msgrcv(SV **mark, SV **sp)
c2ab57d4 1595{
fe14fcc3 1596#ifdef HAS_MSG
11343788 1597 dTHR;
79072805 1598 SV *mstr;
c2ab57d4
LW
1599 char *mbuf;
1600 long mtype;
79072805 1601 I32 id, msize, flags, ret;
463ee0b2 1602 STRLEN len;
79072805 1603
463ee0b2 1604 id = SvIVx(*++mark);
79072805 1605 mstr = *++mark;
463ee0b2
LW
1606 msize = SvIVx(*++mark);
1607 mtype = (long)SvIVx(*++mark);
1608 flags = SvIVx(*++mark);
ed6116ce
LW
1609 if (SvTHINKFIRST(mstr)) {
1610 if (SvREADONLY(mstr))
1611 croak("Can't msgrcv to readonly var");
1612 if (SvROK(mstr))
1613 sv_unref(mstr);
1614 }
a0d0e21e
LW
1615 SvPV_force(mstr, len);
1616 mbuf = SvGROW(mstr, sizeof(long)+msize+1);
1617
748a9306 1618 SETERRNO(0,0);
bee1dbe2 1619 ret = msgrcv(id, (struct msgbuf *)mbuf, msize, mtype, flags);
c2ab57d4 1620 if (ret >= 0) {
79072805
LW
1621 SvCUR_set(mstr, sizeof(long)+ret);
1622 *SvEND(mstr) = '\0';
c2ab57d4
LW
1623 }
1624 return ret;
e5d73d77 1625#else
463ee0b2 1626 croak("msgrcv not implemented");
e5d73d77 1627#endif
c2ab57d4
LW
1628}
1629
79072805 1630I32
8ac85365 1631do_semop(SV **mark, SV **sp)
c2ab57d4 1632{
fe14fcc3 1633#ifdef HAS_SEM
11343788 1634 dTHR;
79072805 1635 SV *opstr;
c2ab57d4 1636 char *opbuf;
463ee0b2
LW
1637 I32 id;
1638 STRLEN opsize;
c2ab57d4 1639
463ee0b2 1640 id = SvIVx(*++mark);
79072805 1641 opstr = *++mark;
463ee0b2 1642 opbuf = SvPV(opstr, opsize);
c2ab57d4
LW
1643 if (opsize < sizeof(struct sembuf)
1644 || (opsize % sizeof(struct sembuf)) != 0) {
748a9306 1645 SETERRNO(EINVAL,LIB$_INVARG);
c2ab57d4
LW
1646 return -1;
1647 }
748a9306 1648 SETERRNO(0,0);
6e21c824 1649 return semop(id, (struct sembuf *)opbuf, opsize/sizeof(struct sembuf));
e5d73d77 1650#else
463ee0b2 1651 croak("semop not implemented");
e5d73d77 1652#endif
c2ab57d4
LW
1653}
1654
79072805 1655I32
8ac85365 1656do_shmio(I32 optype, SV **mark, SV **sp)
c2ab57d4 1657{
fe14fcc3 1658#ifdef HAS_SHM
11343788 1659 dTHR;
79072805 1660 SV *mstr;
c2ab57d4 1661 char *mbuf, *shm;
79072805 1662 I32 id, mpos, msize;
463ee0b2 1663 STRLEN len;
c2ab57d4 1664 struct shmid_ds shmds;
c2ab57d4 1665
463ee0b2 1666 id = SvIVx(*++mark);
79072805 1667 mstr = *++mark;
463ee0b2
LW
1668 mpos = SvIVx(*++mark);
1669 msize = SvIVx(*++mark);
748a9306 1670 SETERRNO(0,0);
c2ab57d4
LW
1671 if (shmctl(id, IPC_STAT, &shmds) == -1)
1672 return -1;
1673 if (mpos < 0 || msize < 0 || mpos + msize > shmds.shm_segsz) {
748a9306 1674 SETERRNO(EFAULT,SS$_ACCVIO); /* can't do as caller requested */
c2ab57d4
LW
1675 return -1;
1676 }
8ac85365 1677 shm = (char *)shmat(id, (char*)NULL, (optype == OP_SHMREAD) ? SHM_RDONLY : 0);
c2ab57d4
LW
1678 if (shm == (char *)-1) /* I hate System V IPC, I really do */
1679 return -1;
79072805 1680 if (optype == OP_SHMREAD) {
a0d0e21e
LW
1681 SvPV_force(mstr, len);
1682 mbuf = SvGROW(mstr, msize+1);
1683
bee1dbe2 1684 Copy(shm + mpos, mbuf, msize, char);
79072805
LW
1685 SvCUR_set(mstr, msize);
1686 *SvEND(mstr) = '\0';
a0d0e21e 1687 SvSETMAGIC(mstr);
c2ab57d4
LW
1688 }
1689 else {
79072805 1690 I32 n;
c2ab57d4 1691
a0d0e21e 1692 mbuf = SvPV(mstr, len);
463ee0b2 1693 if ((n = len) > msize)
c2ab57d4 1694 n = msize;
bee1dbe2 1695 Copy(mbuf, shm + mpos, n, char);
c2ab57d4 1696 if (n < msize)
bee1dbe2 1697 memzero(shm + mpos + n, msize - n);
c2ab57d4
LW
1698 }
1699 return shmdt(shm);
e5d73d77 1700#else
463ee0b2 1701 croak("shm I/O not implemented");
e5d73d77 1702#endif
c2ab57d4
LW
1703}
1704
fe14fcc3 1705#endif /* SYSV IPC */
4e35701f 1706