This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl5.001 patch.1b: [byacc deps fix, set*id fixes, x2p/walk.c emit_split()
[perl5.git] / doio.c
CommitLineData
a0d0e21e 1/* doio.c
a687059c 2 *
a0d0e21e 3 * Copyright (c) 1991-1994, 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
LW
36#ifdef I_UTIME
37#include <utime.h>
38#endif
ff8e2863
LW
39#ifdef I_FCNTL
40#include <fcntl.h>
41#endif
fe14fcc3
LW
42#ifdef I_SYS_FILE
43#include <sys/file.h>
44#endif
a687059c
LW
45
46bool
a0d0e21e 47do_open(gv,name,len,supplied_fp)
79072805 48GV *gv;
a687059c 49register char *name;
79072805 50I32 len;
a0d0e21e 51FILE *supplied_fp;
a687059c
LW
52{
53 FILE *fp;
a0d0e21e
LW
54 register IO *io = GvIOn(gv);
55 char *myname = savepv(name);
a687059c
LW
56 int result;
57 int fd;
58 int writing = 0;
a0d0e21e 59 int dodup;
a687059c 60 char mode[3]; /* stdio file mode ("r\0" or "r+\0") */
6e21c824
LW
61 FILE *saveifp = Nullfp;
62 FILE *saveofp = Nullfp;
63 char savetype = ' ';
a687059c 64
8990e307 65 SAVEFREEPV(myname);
bee1dbe2 66 mode[0] = mode[1] = mode[2] = '\0';
a687059c
LW
67 name = myname;
68 forkprocess = 1; /* assume true if no fork */
99b89507 69 while (len && isSPACE(name[len-1]))
a687059c 70 name[--len] = '\0';
a0d0e21e 71 if (IoIFP(io)) {
8990e307
LW
72 fd = fileno(IoIFP(io));
73 if (IoTYPE(io) == '-')
c2ab57d4 74 result = 0;
6e21c824 75 else if (fd <= maxsysfd) {
8990e307
LW
76 saveifp = IoIFP(io);
77 saveofp = IoOFP(io);
78 savetype = IoTYPE(io);
6e21c824
LW
79 result = 0;
80 }
8990e307
LW
81 else if (IoTYPE(io) == '|')
82 result = my_pclose(IoIFP(io));
83 else if (IoIFP(io) != IoOFP(io)) {
84 if (IoOFP(io)) {
85 result = fclose(IoOFP(io));
86 fclose(IoIFP(io)); /* clear stdio, fd already closed */
c2ab57d4
LW
87 }
88 else
8990e307 89 result = fclose(IoIFP(io));
a687059c 90 }
a687059c 91 else
8990e307 92 result = fclose(IoIFP(io));
6e21c824 93 if (result == EOF && fd > maxsysfd)
a687059c 94 fprintf(stderr,"Warning: unable to close filehandle %s properly.\n",
79072805 95 GvENAME(gv));
8990e307 96 IoOFP(io) = IoIFP(io) = Nullfp;
a687059c
LW
97 }
98 if (*name == '+' && len > 1 && name[len-1] != '|') { /* scary */
99 mode[1] = *name++;
100 mode[2] = '\0';
101 --len;
102 writing = 1;
103 }
104 else {
105 mode[1] = '\0';
106 }
8990e307 107 IoTYPE(io) = *name;
a687059c 108 if (*name == '|') {
99b89507
LW
109 /*SUPPRESS 530*/
110 for (name++; isSPACE(*name); name++) ;
79072805
LW
111 if (strNE(name,"-"))
112 TAINT_ENV();
113 TAINT_PROPER("piped open");
a0d0e21e
LW
114 if (dowarn && name[strlen(name)-1] == '|')
115 warn("Can't do bidirectional pipe");
79072805 116 fp = my_popen(name,"w");
a687059c
LW
117 writing = 1;
118 }
a687059c 119 else if (*name == '>') {
79072805 120 TAINT_PROPER("open");
bf38876a
LW
121 name++;
122 if (*name == '>') {
8990e307 123 mode[0] = IoTYPE(io) = 'a';
bf38876a 124 name++;
a687059c 125 }
bf38876a 126 else
a687059c 127 mode[0] = 'w';
a687059c 128 writing = 1;
bf38876a
LW
129 if (*name == '&') {
130 duplicity:
a0d0e21e 131 dodup = 1;
bf38876a 132 name++;
a0d0e21e
LW
133 if (*name == '=') {
134 dodup = 0;
bf38876a 135 name++;
a0d0e21e
LW
136 }
137 if (!*name && supplied_fp)
138 fp = supplied_fp;
bf38876a 139 else {
a0d0e21e
LW
140 while (isSPACE(*name))
141 name++;
142 if (isDIGIT(*name))
143 fd = atoi(name);
144 else {
145 IO* thatio;
146 gv = gv_fetchpv(name,FALSE,SVt_PVIO);
147 thatio = GvIO(gv);
148 if (!thatio) {
6e21c824 149#ifdef EINVAL
748a9306 150 SETERRNO(EINVAL,SS$_IVCHAN);
6e21c824 151#endif
a0d0e21e
LW
152 goto say_false;
153 }
154 if (IoIFP(thatio)) {
155 fd = fileno(IoIFP(thatio));
156 if (IoTYPE(thatio) == 's')
157 IoTYPE(io) = 's';
158 }
159 else
160 fd = -1;
bf38876a 161 }
a0d0e21e
LW
162 if (dodup)
163 fd = dup(fd);
164 if (!(fp = fdopen(fd,mode)))
fec02dd3
AD
165 if (dodup)
166 close(fd);
fe14fcc3 167 }
bf38876a
LW
168 }
169 else {
99b89507 170 while (isSPACE(*name))
bf38876a
LW
171 name++;
172 if (strEQ(name,"-")) {
173 fp = stdout;
8990e307 174 IoTYPE(io) = '-';
bf38876a
LW
175 }
176 else {
177 fp = fopen(name,mode);
178 }
179 }
a687059c
LW
180 }
181 else {
182 if (*name == '<') {
bf38876a
LW
183 mode[0] = 'r';
184 name++;
99b89507 185 while (isSPACE(*name))
bf38876a
LW
186 name++;
187 if (*name == '&')
188 goto duplicity;
a687059c
LW
189 if (strEQ(name,"-")) {
190 fp = stdin;
8990e307 191 IoTYPE(io) = '-';
a687059c 192 }
bf38876a 193 else
a687059c 194 fp = fopen(name,mode);
a687059c
LW
195 }
196 else if (name[len-1] == '|') {
a687059c 197 name[--len] = '\0';
99b89507 198 while (len && isSPACE(name[len-1]))
a687059c 199 name[--len] = '\0';
99b89507
LW
200 /*SUPPRESS 530*/
201 for (; isSPACE(*name); name++) ;
79072805
LW
202 if (strNE(name,"-"))
203 TAINT_ENV();
204 TAINT_PROPER("piped open");
205 fp = my_popen(name,"r");
8990e307 206 IoTYPE(io) = '|';
a687059c
LW
207 }
208 else {
8990e307 209 IoTYPE(io) = '<';
99b89507
LW
210 /*SUPPRESS 530*/
211 for (; isSPACE(*name); name++) ;
a687059c
LW
212 if (strEQ(name,"-")) {
213 fp = stdin;
8990e307 214 IoTYPE(io) = '-';
a687059c
LW
215 }
216 else
217 fp = fopen(name,"r");
218 }
219 }
bee1dbe2 220 if (!fp) {
8990e307 221 if (dowarn && IoTYPE(io) == '<' && strchr(name, '\n'))
bee1dbe2 222 warn(warn_nl, "open");
6e21c824 223 goto say_false;
bee1dbe2 224 }
8990e307
LW
225 if (IoTYPE(io) &&
226 IoTYPE(io) != '|' && IoTYPE(io) != '-') {
a0d0e21e 227 if (Fstat(fileno(fp),&statbuf) < 0) {
a687059c 228 (void)fclose(fp);
6e21c824 229 goto say_false;
a687059c 230 }
1462b684 231 if (S_ISSOCK(statbuf.st_mode))
8990e307 232 IoTYPE(io) = 's'; /* in case a socket was passed in to us */
99b89507
LW
233#ifdef HAS_SOCKET
234 else if (
c623bd54 235#ifdef S_IFMT
99b89507
LW
236 !(statbuf.st_mode & S_IFMT)
237#else
238 !statbuf.st_mode
239#endif
240 ) {
a0d0e21e
LW
241 int buflen = sizeof tokenbuf;
242 if (getsockname(fileno(fp), (struct sockaddr *)tokenbuf, &buflen) >= 0
bee1dbe2 243 || errno != ENOTSOCK)
8990e307 244 IoTYPE(io) = 's'; /* some OS's return 0 on fstat()ed socket */
99b89507
LW
245 /* but some return 0 for streams too, sigh */
246 }
bf38876a 247#endif
a687059c 248 }
6e21c824
LW
249 if (saveifp) { /* must use old fp? */
250 fd = fileno(saveifp);
251 if (saveofp) {
252 fflush(saveofp); /* emulate fclose() */
253 if (saveofp != saveifp) { /* was a socket? */
254 fclose(saveofp);
99b89507
LW
255 if (fd > 2)
256 Safefree(saveofp);
6e21c824
LW
257 }
258 }
259 if (fd != fileno(fp)) {
bee1dbe2 260 int pid;
79072805 261 SV *sv;
bee1dbe2 262
6e21c824 263 dup2(fileno(fp), fd);
79072805 264 sv = *av_fetch(fdpid,fileno(fp),TRUE);
a0d0e21e 265 (void)SvUPGRADE(sv, SVt_IV);
463ee0b2
LW
266 pid = SvIVX(sv);
267 SvIVX(sv) = 0;
79072805 268 sv = *av_fetch(fdpid,fd,TRUE);
a0d0e21e 269 (void)SvUPGRADE(sv, SVt_IV);
463ee0b2 270 SvIVX(sv) = pid;
6e21c824 271 fclose(fp);
bee1dbe2 272
6e21c824
LW
273 }
274 fp = saveifp;
bee1dbe2 275 clearerr(fp);
6e21c824 276 }
a0d0e21e 277#if defined(HAS_FCNTL) && defined(F_SETFD)
1462b684 278 fd = fileno(fp);
a0d0e21e 279 fcntl(fd,F_SETFD,fd > maxsysfd);
1462b684 280#endif
8990e307 281 IoIFP(io) = fp;
bf38876a 282 if (writing) {
8990e307
LW
283 if (IoTYPE(io) == 's'
284 || (IoTYPE(io) == '>' && S_ISCHR(statbuf.st_mode)) ) {
285 if (!(IoOFP(io) = fdopen(fileno(fp),"w"))) {
fe14fcc3 286 fclose(fp);
8990e307 287 IoIFP(io) = Nullfp;
6e21c824 288 goto say_false;
fe14fcc3 289 }
1462b684
LW
290 }
291 else
8990e307 292 IoOFP(io) = fp;
bf38876a 293 }
a687059c 294 return TRUE;
6e21c824
LW
295
296say_false:
8990e307
LW
297 IoIFP(io) = saveifp;
298 IoOFP(io) = saveofp;
299 IoTYPE(io) = savetype;
6e21c824 300 return FALSE;
a687059c
LW
301}
302
303FILE *
79072805
LW
304nextargv(gv)
305register GV *gv;
a687059c 306{
79072805 307 register SV *sv;
99b89507 308#ifndef FLEXFILENAMES
c623bd54
LW
309 int filedev;
310 int fileino;
99b89507 311#endif
c623bd54
LW
312 int fileuid;
313 int filegid;
fe14fcc3 314
79072805 315 if (!argvoutgv)
85e6fe83 316 argvoutgv = gv_fetchpv("ARGVOUT",TRUE,SVt_PVIO);
fe14fcc3 317 if (filemode & (S_ISUID|S_ISGID)) {
a0d0e21e 318 fflush(IoIFP(GvIOn(argvoutgv))); /* chmod must follow last write */
fe14fcc3
LW
319#ifdef HAS_FCHMOD
320 (void)fchmod(lastfd,filemode);
321#else
322 (void)chmod(oldname,filemode);
323#endif
324 }
325 filemode = 0;
79072805 326 while (av_len(GvAV(gv)) >= 0) {
463ee0b2 327 STRLEN len;
79072805 328 sv = av_shift(GvAV(gv));
8990e307 329 SAVEFREESV(sv);
79072805
LW
330 sv_setsv(GvSV(gv),sv);
331 SvSETMAGIC(GvSV(gv));
463ee0b2 332 oldname = SvPVx(GvSV(gv), len);
a0d0e21e 333 if (do_open(gv,oldname,len,Nullfp)) {
a687059c 334 if (inplace) {
79072805 335 TAINT_PROPER("inplace open");
c623bd54 336 if (strEQ(oldname,"-")) {
85e6fe83 337 defoutgv = gv_fetchpv("STDOUT",TRUE,SVt_PVIO);
a0d0e21e 338 return IoIFP(GvIOp(gv));
c623bd54 339 }
99b89507 340#ifndef FLEXFILENAMES
c623bd54
LW
341 filedev = statbuf.st_dev;
342 fileino = statbuf.st_ino;
99b89507 343#endif
a687059c
LW
344 filemode = statbuf.st_mode;
345 fileuid = statbuf.st_uid;
346 filegid = statbuf.st_gid;
c623bd54
LW
347 if (!S_ISREG(filemode)) {
348 warn("Can't do inplace edit: %s is not a regular file",
349 oldname );
79072805 350 do_close(gv,FALSE);
c623bd54
LW
351 continue;
352 }
a687059c 353 if (*inplace) {
ff8e2863 354#ifdef SUFFIX
79072805 355 add_suffix(sv,inplace);
ff8e2863 356#else
79072805 357 sv_catpv(sv,inplace);
ff8e2863 358#endif
c623bd54 359#ifndef FLEXFILENAMES
a0d0e21e 360 if (Stat(SvPVX(sv),&statbuf) >= 0
c623bd54
LW
361 && statbuf.st_dev == filedev
362 && statbuf.st_ino == fileino ) {
363 warn("Can't do inplace edit: %s > 14 characters",
463ee0b2 364 SvPVX(sv) );
79072805 365 do_close(gv,FALSE);
c623bd54
LW
366 continue;
367 }
368#endif
fe14fcc3 369#ifdef HAS_RENAME
bee1dbe2 370#ifndef DOSISH
463ee0b2 371 if (rename(oldname,SvPVX(sv)) < 0) {
c623bd54 372 warn("Can't rename %s to %s: %s, skipping file",
2304df62 373 oldname, SvPVX(sv), Strerror(errno) );
79072805 374 do_close(gv,FALSE);
c623bd54
LW
375 continue;
376 }
a687059c 377#else
79072805 378 do_close(gv,FALSE);
463ee0b2
LW
379 (void)unlink(SvPVX(sv));
380 (void)rename(oldname,SvPVX(sv));
a0d0e21e 381 do_open(gv,SvPVX(sv),SvCUR(GvSV(gv)),Nullfp);
ff8e2863
LW
382#endif /* MSDOS */
383#else
463ee0b2
LW
384 (void)UNLINK(SvPVX(sv));
385 if (link(oldname,SvPVX(sv)) < 0) {
c623bd54 386 warn("Can't rename %s to %s: %s, skipping file",
2304df62 387 oldname, SvPVX(sv), Strerror(errno) );
79072805 388 do_close(gv,FALSE);
c623bd54
LW
389 continue;
390 }
a687059c
LW
391 (void)UNLINK(oldname);
392#endif
393 }
394 else {
bee1dbe2 395#ifndef DOSISH
fe14fcc3
LW
396 if (UNLINK(oldname) < 0) {
397 warn("Can't rename %s to %s: %s, skipping file",
2304df62 398 oldname, SvPVX(sv), Strerror(errno) );
79072805 399 do_close(gv,FALSE);
fe14fcc3
LW
400 continue;
401 }
ff8e2863 402#else
463ee0b2 403 croak("Can't do inplace edit without backup");
ff8e2863 404#endif
a687059c
LW
405 }
406
79072805
LW
407 sv_setpvn(sv,">",1);
408 sv_catpv(sv,oldname);
748a9306 409 SETERRNO(0,0); /* in case sprintf set errno */
a0d0e21e 410 if (!do_open(argvoutgv,SvPVX(sv),SvCUR(sv),Nullfp)) {
c623bd54 411 warn("Can't do inplace edit on %s: %s",
2304df62 412 oldname, Strerror(errno) );
79072805 413 do_close(gv,FALSE);
fe14fcc3
LW
414 continue;
415 }
79072805 416 defoutgv = argvoutgv;
a0d0e21e
LW
417 lastfd = fileno(IoIFP(GvIOp(argvoutgv)));
418 (void)Fstat(lastfd,&statbuf);
fe14fcc3
LW
419#ifdef HAS_FCHMOD
420 (void)fchmod(lastfd,filemode);
a687059c
LW
421#else
422 (void)chmod(oldname,filemode);
423#endif
fe14fcc3
LW
424 if (fileuid != statbuf.st_uid || filegid != statbuf.st_gid) {
425#ifdef HAS_FCHOWN
426 (void)fchown(lastfd,fileuid,filegid);
a687059c 427#else
fe14fcc3
LW
428#ifdef HAS_CHOWN
429 (void)chown(oldname,fileuid,filegid);
a687059c 430#endif
b1248f16 431#endif
fe14fcc3 432 }
a687059c 433 }
a0d0e21e 434 return IoIFP(GvIOp(gv));
a687059c
LW
435 }
436 else
2304df62 437 fprintf(stderr,"Can't open %s: %s\n",SvPV(sv, na), Strerror(errno));
a687059c
LW
438 }
439 if (inplace) {
79072805 440 (void)do_close(argvoutgv,FALSE);
85e6fe83 441 defoutgv = gv_fetchpv("STDOUT",TRUE,SVt_PVIO);
a687059c
LW
442 }
443 return Nullfp;
444}
445
fe14fcc3 446#ifdef HAS_PIPE
afd9f252 447void
79072805
LW
448do_pipe(sv, rgv, wgv)
449SV *sv;
450GV *rgv;
451GV *wgv;
afd9f252 452{
79072805
LW
453 register IO *rstio;
454 register IO *wstio;
afd9f252
LW
455 int fd[2];
456
79072805 457 if (!rgv)
afd9f252 458 goto badexit;
79072805 459 if (!wgv)
afd9f252
LW
460 goto badexit;
461
a0d0e21e
LW
462 rstio = GvIOn(rgv);
463 wstio = GvIOn(wgv);
afd9f252 464
a0d0e21e 465 if (IoIFP(rstio))
79072805 466 do_close(rgv,FALSE);
a0d0e21e 467 if (IoIFP(wstio))
79072805 468 do_close(wgv,FALSE);
afd9f252
LW
469
470 if (pipe(fd) < 0)
471 goto badexit;
8990e307
LW
472 IoIFP(rstio) = fdopen(fd[0], "r");
473 IoOFP(wstio) = fdopen(fd[1], "w");
474 IoIFP(wstio) = IoOFP(wstio);
475 IoTYPE(rstio) = '<';
476 IoTYPE(wstio) = '>';
477 if (!IoIFP(rstio) || !IoOFP(wstio)) {
478 if (IoIFP(rstio)) fclose(IoIFP(rstio));
fe14fcc3 479 else close(fd[0]);
8990e307 480 if (IoOFP(wstio)) fclose(IoOFP(wstio));
fe14fcc3
LW
481 else close(fd[1]);
482 goto badexit;
483 }
afd9f252 484
79072805 485 sv_setsv(sv,&sv_yes);
afd9f252
LW
486 return;
487
488badexit:
79072805 489 sv_setsv(sv,&sv_undef);
afd9f252
LW
490 return;
491}
b1248f16 492#endif
afd9f252 493
a687059c 494bool
a0d0e21e 495#ifndef CAN_PROTOTYPE
79072805
LW
496do_close(gv,explicit)
497GV *gv;
a687059c 498bool explicit;
8990e307
LW
499#else
500do_close(GV *gv, bool explicit)
a0d0e21e 501#endif /* CAN_PROTOTYPE */
a687059c
LW
502{
503 bool retval = FALSE;
79072805 504 register IO *io;
a687059c
LW
505 int status;
506
79072805
LW
507 if (!gv)
508 gv = argvgv;
a0d0e21e 509 if (!gv || SvTYPE(gv) != SVt_PVGV) {
748a9306 510 SETERRNO(EBADF,SS$_IVCHAN);
c2ab57d4 511 return FALSE;
99b89507 512 }
79072805
LW
513 io = GvIO(gv);
514 if (!io) { /* never opened */
a687059c 515 if (dowarn && explicit)
79072805 516 warn("Close on unopened file <%s>",GvENAME(gv));
a687059c
LW
517 return FALSE;
518 }
8990e307
LW
519 if (IoIFP(io)) {
520 if (IoTYPE(io) == '|') {
521 status = my_pclose(IoIFP(io));
c623bd54 522 retval = (status == 0);
748a9306 523 statusvalue = FIXSTATUS(status);
a687059c 524 }
8990e307 525 else if (IoTYPE(io) == '-')
a687059c
LW
526 retval = TRUE;
527 else {
8990e307
LW
528 if (IoOFP(io) && IoOFP(io) != IoIFP(io)) { /* a socket */
529 retval = (fclose(IoOFP(io)) != EOF);
530 fclose(IoIFP(io)); /* clear stdio, fd already closed */
c2ab57d4
LW
531 }
532 else
8990e307 533 retval = (fclose(IoIFP(io)) != EOF);
a687059c 534 }
8990e307 535 IoOFP(io) = IoIFP(io) = Nullfp;
79072805
LW
536 }
537 if (explicit) {
8990e307
LW
538 IoLINES(io) = 0;
539 IoPAGE(io) = 0;
540 IoLINES_LEFT(io) = IoPAGE_LEN(io);
a687059c 541 }
8990e307 542 IoTYPE(io) = ' ';
a687059c
LW
543 return retval;
544}
545
546bool
79072805
LW
547do_eof(gv)
548GV *gv;
a687059c 549{
79072805 550 register IO *io;
a687059c
LW
551 int ch;
552
79072805 553 io = GvIO(gv);
a687059c 554
79072805 555 if (!io)
a687059c
LW
556 return TRUE;
557
8990e307 558 while (IoIFP(io)) {
a687059c 559
85e6fe83 560#ifdef USE_STD_STDIO /* (the code works without this) */
8990e307 561 if (IoIFP(io)->_cnt > 0) /* cheat a little, since */
a687059c
LW
562 return FALSE; /* this is the most usual case */
563#endif
564
8990e307 565 ch = getc(IoIFP(io));
a687059c 566 if (ch != EOF) {
8990e307 567 (void)ungetc(ch, IoIFP(io));
a687059c
LW
568 return FALSE;
569 }
85e6fe83 570#ifdef USE_STD_STDIO
8990e307
LW
571 if (IoIFP(io)->_cnt < -1)
572 IoIFP(io)->_cnt = -1;
fe14fcc3 573#endif
8990e307 574 if (op->op_flags & OPf_SPECIAL) { /* not necessarily a real EOF yet? */
79072805 575 if (!nextargv(argvgv)) /* get another fp handy */
a687059c
LW
576 return TRUE;
577 }
578 else
579 return TRUE; /* normal fp, definitely end of file */
580 }
581 return TRUE;
582}
583
584long
79072805
LW
585do_tell(gv)
586GV *gv;
a687059c 587{
79072805 588 register IO *io;
a687059c 589
79072805 590 if (!gv)
a687059c
LW
591 goto phooey;
592
79072805 593 io = GvIO(gv);
8990e307 594 if (!io || !IoIFP(io))
a687059c
LW
595 goto phooey;
596
bee1dbe2 597#ifdef ULTRIX_STDIO_BOTCH
8990e307
LW
598 if (feof(IoIFP(io)))
599 (void)fseek (IoIFP(io), 0L, 2); /* ultrix 1.2 workaround */
bee1dbe2 600#endif
a687059c 601
8990e307 602 return ftell(IoIFP(io));
a687059c
LW
603
604phooey:
605 if (dowarn)
606 warn("tell() on unopened file");
748a9306 607 SETERRNO(EBADF,RMS$_IFI);
a687059c
LW
608 return -1L;
609}
610
611bool
79072805
LW
612do_seek(gv, pos, whence)
613GV *gv;
a687059c
LW
614long pos;
615int whence;
616{
79072805 617 register IO *io;
a687059c 618
79072805 619 if (!gv)
a687059c
LW
620 goto nuts;
621
79072805 622 io = GvIO(gv);
8990e307 623 if (!io || !IoIFP(io))
a687059c
LW
624 goto nuts;
625
bee1dbe2 626#ifdef ULTRIX_STDIO_BOTCH
8990e307
LW
627 if (feof(IoIFP(io)))
628 (void)fseek (IoIFP(io), 0L, 2); /* ultrix 1.2 workaround */
bee1dbe2 629#endif
a687059c 630
8990e307 631 return fseek(IoIFP(io), pos, whence) >= 0;
a687059c
LW
632
633nuts:
634 if (dowarn)
635 warn("seek() on unopened file");
748a9306 636 SETERRNO(EBADF,RMS$_IFI);
a687059c
LW
637 return FALSE;
638}
639
a0d0e21e 640#if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP)
c2ab57d4 641 /* code courtesy of William Kucharski */
fe14fcc3 642#define HAS_CHSIZE
6eb13c3b 643
79072805
LW
644I32 chsize(fd, length)
645I32 fd; /* file descriptor */
85e6fe83 646Off_t length; /* length to set file to */
6eb13c3b
LW
647{
648 extern long lseek();
649 struct flock fl;
650 struct stat filebuf;
651
a0d0e21e 652 if (Fstat(fd, &filebuf) < 0)
6eb13c3b
LW
653 return -1;
654
655 if (filebuf.st_size < length) {
656
657 /* extend file length */
658
659 if ((lseek(fd, (length - 1), 0)) < 0)
660 return -1;
661
662 /* write a "0" byte */
663
664 if ((write(fd, "", 1)) != 1)
665 return -1;
666 }
667 else {
668 /* truncate length */
669
670 fl.l_whence = 0;
671 fl.l_len = 0;
672 fl.l_start = length;
a0d0e21e 673 fl.l_type = F_WRLCK; /* write lock on file space */
6eb13c3b
LW
674
675 /*
a0d0e21e 676 * This relies on the UNDOCUMENTED F_FREESP argument to
6eb13c3b
LW
677 * fcntl(2), which truncates the file so that it ends at the
678 * position indicated by fl.l_start.
679 *
680 * Will minor miracles never cease?
681 */
682
a0d0e21e 683 if (fcntl(fd, F_FREESP, &fl) < 0)
6eb13c3b
LW
684 return -1;
685
686 }
687
688 return 0;
689}
a0d0e21e 690#endif /* F_FREESP */
ff8e2863 691
79072805
LW
692I32
693looks_like_number(sv)
694SV *sv;
a687059c
LW
695{
696 register char *s;
697 register char *send;
698
463ee0b2
LW
699 if (!SvPOK(sv)) {
700 STRLEN len;
701 if (!SvPOKp(sv))
702 return TRUE;
703 s = SvPV(sv, len);
704 send = s + len;
705 }
706 else {
707 s = SvPVX(sv);
708 send = s + SvCUR(sv);
709 }
99b89507 710 while (isSPACE(*s))
a687059c
LW
711 s++;
712 if (s >= send)
713 return FALSE;
714 if (*s == '+' || *s == '-')
715 s++;
99b89507 716 while (isDIGIT(*s))
a687059c
LW
717 s++;
718 if (s == send)
719 return TRUE;
720 if (*s == '.')
721 s++;
463ee0b2 722 else if (s == SvPVX(sv))
a687059c 723 return FALSE;
99b89507 724 while (isDIGIT(*s))
a687059c
LW
725 s++;
726 if (s == send)
727 return TRUE;
728 if (*s == 'e' || *s == 'E') {
729 s++;
730 if (*s == '+' || *s == '-')
731 s++;
99b89507 732 while (isDIGIT(*s))
a687059c
LW
733 s++;
734 }
99b89507 735 while (isSPACE(*s))
a687059c
LW
736 s++;
737 if (s >= send)
738 return TRUE;
739 return FALSE;
740}
741
742bool
79072805
LW
743do_print(sv,fp)
744register SV *sv;
a687059c
LW
745FILE *fp;
746{
747 register char *tmps;
463ee0b2 748 STRLEN len;
a687059c 749
79072805
LW
750 /* assuming fp is checked earlier */
751 if (!sv)
752 return TRUE;
753 if (ofmt) {
8990e307 754 if (SvGMAGICAL(sv))
79072805 755 mg_get(sv);
463ee0b2
LW
756 if (SvIOK(sv) && SvIVX(sv) != 0) {
757 fprintf(fp, ofmt, (double)SvIVX(sv));
79072805
LW
758 return !ferror(fp);
759 }
463ee0b2 760 if ( (SvNOK(sv) && SvNVX(sv) != 0.0)
79072805 761 || (looks_like_number(sv) && sv_2nv(sv) != 0.0) ) {
463ee0b2 762 fprintf(fp, ofmt, SvNVX(sv));
79072805
LW
763 return !ferror(fp);
764 }
a687059c 765 }
79072805
LW
766 switch (SvTYPE(sv)) {
767 case SVt_NULL:
8990e307
LW
768 if (dowarn)
769 warn(warn_uninit);
ff8e2863 770 return TRUE;
79072805 771 case SVt_IV:
a0d0e21e
LW
772 if (SvIOK(sv)) {
773 if (SvGMAGICAL(sv))
774 mg_get(sv);
775 fprintf(fp, "%ld", (long)SvIVX(sv));
776 return !ferror(fp);
777 }
778 /* FALL THROUGH */
79072805 779 default:
463ee0b2 780 tmps = SvPV(sv, len);
79072805 781 break;
ff8e2863 782 }
a0d0e21e 783 if (len && (fwrite1(tmps,1,len,fp) == 0 || ferror(fp)))
a687059c 784 return FALSE;
79072805 785 return TRUE;
a687059c
LW
786}
787
79072805
LW
788I32
789my_stat(ARGS)
790dARGS
a687059c 791{
79072805
LW
792 dSP;
793 IO *io;
748a9306 794 GV* tmpgv;
79072805 795
a0d0e21e 796 if (op->op_flags & OPf_REF) {
79072805 797 EXTEND(sp,1);
748a9306
LW
798 tmpgv = cGVOP->op_gv;
799 do_fstat:
800 io = GvIO(tmpgv);
8990e307 801 if (io && IoIFP(io)) {
748a9306 802 statgv = tmpgv;
79072805
LW
803 sv_setpv(statname,"");
804 laststype = OP_STAT;
a0d0e21e 805 return (laststatval = Fstat(fileno(IoIFP(io)), &statcache));
a687059c
LW
806 }
807 else {
748a9306 808 if (tmpgv == defgv)
57ebbfd0 809 return laststatval;
a687059c
LW
810 if (dowarn)
811 warn("Stat on unopened file <%s>",
748a9306 812 GvENAME(tmpgv));
79072805
LW
813 statgv = Nullgv;
814 sv_setpv(statname,"");
57ebbfd0 815 return (laststatval = -1);
a687059c
LW
816 }
817 }
818 else {
748a9306 819 SV* sv = POPs;
79072805 820 PUTBACK;
748a9306
LW
821 if (SvTYPE(sv) == SVt_PVGV) {
822 tmpgv = (GV*)sv;
823 goto do_fstat;
824 }
825 else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
826 tmpgv = (GV*)SvRV(sv);
827 goto do_fstat;
828 }
829
79072805 830 statgv = Nullgv;
463ee0b2 831 sv_setpv(statname,SvPV(sv, na));
79072805 832 laststype = OP_STAT;
a0d0e21e 833 laststatval = Stat(SvPV(sv, na),&statcache);
463ee0b2 834 if (laststatval < 0 && dowarn && strchr(SvPV(sv, na), '\n'))
bee1dbe2
LW
835 warn(warn_nl, "stat");
836 return laststatval;
a687059c
LW
837 }
838}
839
79072805
LW
840I32
841my_lstat(ARGS)
842dARGS
c623bd54 843{
79072805
LW
844 dSP;
845 SV *sv;
a0d0e21e 846 if (op->op_flags & OPf_REF) {
79072805
LW
847 EXTEND(sp,1);
848 if (cGVOP->op_gv == defgv) {
849 if (laststype != OP_LSTAT)
463ee0b2 850 croak("The stat preceding -l _ wasn't an lstat");
fe14fcc3
LW
851 return laststatval;
852 }
463ee0b2 853 croak("You can't use -l on a filehandle");
fe14fcc3 854 }
c623bd54 855
79072805
LW
856 laststype = OP_LSTAT;
857 statgv = Nullgv;
858 sv = POPs;
859 PUTBACK;
463ee0b2 860 sv_setpv(statname,SvPV(sv, na));
fe14fcc3 861#ifdef HAS_LSTAT
463ee0b2 862 laststatval = lstat(SvPV(sv, na),&statcache);
c623bd54 863#else
a0d0e21e 864 laststatval = Stat(SvPV(sv, na),&statcache);
c623bd54 865#endif
463ee0b2 866 if (laststatval < 0 && dowarn && strchr(SvPV(sv, na), '\n'))
bee1dbe2
LW
867 warn(warn_nl, "lstat");
868 return laststatval;
c623bd54
LW
869}
870
a687059c 871bool
79072805
LW
872do_aexec(really,mark,sp)
873SV *really;
874register SV **mark;
875register SV **sp;
a687059c 876{
a687059c 877 register char **a;
a687059c
LW
878 char *tmps;
879
79072805
LW
880 if (sp > mark) {
881 New(401,Argv, sp - mark + 1, char*);
bee1dbe2 882 a = Argv;
79072805
LW
883 while (++mark <= sp) {
884 if (*mark)
463ee0b2 885 *a++ = SvPVx(*mark, na);
a687059c
LW
886 else
887 *a++ = "";
888 }
889 *a = Nullch;
bee1dbe2 890 if (*Argv[0] != '/') /* will execvp use PATH? */
79072805 891 TAINT_ENV(); /* testing IFS here is overkill, probably */
463ee0b2 892 if (really && *(tmps = SvPV(really, na)))
bee1dbe2 893 execvp(tmps,Argv);
a687059c 894 else
bee1dbe2 895 execvp(Argv[0],Argv);
a0d0e21e
LW
896 if (dowarn)
897 warn("Can't exec \"%s\": %s", Argv[0], Strerror(errno));
a687059c 898 }
bee1dbe2 899 do_execfree();
a687059c
LW
900 return FALSE;
901}
902
fe14fcc3 903void
ff8e2863
LW
904do_execfree()
905{
906 if (Argv) {
907 Safefree(Argv);
908 Argv = Null(char **);
909 }
910 if (Cmd) {
911 Safefree(Cmd);
912 Cmd = Nullch;
913 }
914}
915
a687059c
LW
916bool
917do_exec(cmd)
918char *cmd;
919{
920 register char **a;
921 register char *s;
a687059c
LW
922 char flags[10];
923
748a9306
LW
924 while (*cmd && isSPACE(*cmd))
925 cmd++;
926
a687059c
LW
927 /* save an extra exec if possible */
928
bf38876a
LW
929#ifdef CSH
930 if (strnEQ(cmd,cshname,cshlen) && strnEQ(cmd+cshlen," -c",3)) {
a687059c 931 strcpy(flags,"-c");
bf38876a 932 s = cmd+cshlen+3;
a687059c
LW
933 if (*s == 'f') {
934 s++;
935 strcat(flags,"f");
936 }
937 if (*s == ' ')
938 s++;
939 if (*s++ == '\'') {
940 char *ncmd = s;
941
942 while (*s)
943 s++;
944 if (s[-1] == '\n')
945 *--s = '\0';
946 if (s[-1] == '\'') {
947 *--s = '\0';
bf38876a 948 execl(cshname,"csh", flags,ncmd,(char*)0);
a687059c
LW
949 *s = '\'';
950 return FALSE;
951 }
952 }
953 }
bf38876a 954#endif /* CSH */
a687059c
LW
955
956 /* see if there are shell metacharacters in it */
957
748a9306
LW
958 if (*cmd == '.' && isSPACE(cmd[1]))
959 goto doshell;
960
961 if (strnEQ(cmd,"exec",4) && isSPACE(cmd[4]))
962 goto doshell;
963
99b89507 964 for (s = cmd; *s && isALPHA(*s); s++) ; /* catch VAR=val gizmo */
63f2c1e1
LW
965 if (*s == '=')
966 goto doshell;
748a9306 967
a687059c 968 for (s = cmd; *s; s++) {
93a17b20 969 if (*s != ' ' && !isALPHA(*s) && strchr("$&*(){}[]'\";\\|?<>~`\n",*s)) {
a687059c
LW
970 if (*s == '\n' && !s[1]) {
971 *s = '\0';
972 break;
973 }
974 doshell:
975 execl("/bin/sh","sh","-c",cmd,(char*)0);
976 return FALSE;
977 }
978 }
748a9306 979
ff8e2863 980 New(402,Argv, (s - cmd) / 2 + 2, char*);
a0d0e21e 981 Cmd = savepvn(cmd, s-cmd);
ff8e2863
LW
982 a = Argv;
983 for (s = Cmd; *s;) {
99b89507 984 while (*s && isSPACE(*s)) s++;
a687059c
LW
985 if (*s)
986 *(a++) = s;
99b89507 987 while (*s && !isSPACE(*s)) s++;
a687059c
LW
988 if (*s)
989 *s++ = '\0';
990 }
991 *a = Nullch;
ff8e2863
LW
992 if (Argv[0]) {
993 execvp(Argv[0],Argv);
b1248f16 994 if (errno == ENOEXEC) { /* for system V NIH syndrome */
ff8e2863 995 do_execfree();
a687059c 996 goto doshell;
b1248f16 997 }
a0d0e21e
LW
998 if (dowarn)
999 warn("Can't exec \"%s\": %s", Argv[0], Strerror(errno));
a687059c 1000 }
ff8e2863 1001 do_execfree();
a687059c
LW
1002 return FALSE;
1003}
1004
79072805
LW
1005I32
1006apply(type,mark,sp)
1007I32 type;
1008register SV **mark;
1009register SV **sp;
a687059c 1010{
79072805
LW
1011 register I32 val;
1012 register I32 val2;
1013 register I32 tot = 0;
a687059c 1014 char *s;
79072805 1015 SV **oldmark = mark;
a687059c 1016
463ee0b2
LW
1017 if (tainting) {
1018 while (++mark <= sp) {
748a9306
LW
1019 MAGIC *mg;
1020 if (SvMAGICAL(*mark) && (mg = mg_find(*mark, 't')) && mg->mg_len & 1)
463ee0b2
LW
1021 tainted = TRUE;
1022 }
1023 mark = oldmark;
1024 }
a687059c 1025 switch (type) {
79072805
LW
1026 case OP_CHMOD:
1027 TAINT_PROPER("chmod");
1028 if (++mark <= sp) {
1029 tot = sp - mark;
463ee0b2 1030 val = SvIVx(*mark);
79072805 1031 while (++mark <= sp) {
463ee0b2 1032 if (chmod(SvPVx(*mark, na),val))
a687059c
LW
1033 tot--;
1034 }
1035 }
1036 break;
fe14fcc3 1037#ifdef HAS_CHOWN
79072805
LW
1038 case OP_CHOWN:
1039 TAINT_PROPER("chown");
1040 if (sp - mark > 2) {
463ee0b2
LW
1041 val = SvIVx(*++mark);
1042 val2 = SvIVx(*++mark);
a0d0e21e 1043 tot = sp - mark;
79072805 1044 while (++mark <= sp) {
463ee0b2 1045 if (chown(SvPVx(*mark, na),val,val2))
a687059c
LW
1046 tot--;
1047 }
1048 }
1049 break;
b1248f16 1050#endif
fe14fcc3 1051#ifdef HAS_KILL
79072805
LW
1052 case OP_KILL:
1053 TAINT_PROPER("kill");
463ee0b2 1054 s = SvPVx(*++mark, na);
79072805
LW
1055 tot = sp - mark;
1056 if (isUPPER(*s)) {
1057 if (*s == 'S' && s[1] == 'I' && s[2] == 'G')
1058 s += 3;
1059 if (!(val = whichsig(s)))
463ee0b2 1060 croak("Unrecognized signal name \"%s\"",s);
79072805
LW
1061 }
1062 else
463ee0b2 1063 val = SvIVx(*mark);
79072805
LW
1064 if (val < 0) {
1065 val = -val;
1066 while (++mark <= sp) {
463ee0b2 1067 I32 proc = SvIVx(*mark);
fe14fcc3 1068#ifdef HAS_KILLPG
79072805 1069 if (killpg(proc,val)) /* BSD */
a687059c 1070#else
79072805 1071 if (kill(-proc,val)) /* SYSV */
a687059c 1072#endif
79072805 1073 tot--;
a687059c 1074 }
79072805
LW
1075 }
1076 else {
1077 while (++mark <= sp) {
463ee0b2 1078 if (kill(SvIVx(*mark),val))
79072805 1079 tot--;
a687059c
LW
1080 }
1081 }
1082 break;
b1248f16 1083#endif
79072805
LW
1084 case OP_UNLINK:
1085 TAINT_PROPER("unlink");
1086 tot = sp - mark;
1087 while (++mark <= sp) {
463ee0b2 1088 s = SvPVx(*mark, na);
a687059c
LW
1089 if (euid || unsafe) {
1090 if (UNLINK(s))
1091 tot--;
1092 }
1093 else { /* don't let root wipe out directories without -U */
fe14fcc3 1094#ifdef HAS_LSTAT
c623bd54 1095 if (lstat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode))
a687059c 1096#else
a0d0e21e 1097 if (Stat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode))
a687059c 1098#endif
a687059c
LW
1099 tot--;
1100 else {
1101 if (UNLINK(s))
1102 tot--;
1103 }
1104 }
1105 }
1106 break;
a0d0e21e 1107#ifdef HAS_UTIME
79072805
LW
1108 case OP_UTIME:
1109 TAINT_PROPER("utime");
1110 if (sp - mark > 2) {
748a9306 1111#if defined(I_UTIME) || defined(VMS)
663a0e37
LW
1112 struct utimbuf utbuf;
1113#else
a687059c 1114 struct {
663a0e37
LW
1115 long actime;
1116 long modtime;
a687059c 1117 } utbuf;
663a0e37 1118#endif
a687059c 1119
afd9f252 1120 Zero(&utbuf, sizeof utbuf, char);
463ee0b2
LW
1121 utbuf.actime = SvIVx(*++mark); /* time accessed */
1122 utbuf.modtime = SvIVx(*++mark); /* time modified */
79072805
LW
1123 tot = sp - mark;
1124 while (++mark <= sp) {
463ee0b2 1125 if (utime(SvPVx(*mark, na),&utbuf))
a687059c
LW
1126 tot--;
1127 }
a687059c
LW
1128 }
1129 else
79072805 1130 tot = 0;
a687059c 1131 break;
a0d0e21e 1132#endif
a687059c
LW
1133 }
1134 return tot;
1135}
1136
1137/* Do the permissions allow some operation? Assumes statcache already set. */
a0d0e21e 1138#ifndef VMS /* VMS' cando is in vms.c */
79072805 1139I32
a687059c 1140cando(bit, effective, statbufp)
79072805
LW
1141I32 bit;
1142I32 effective;
a687059c
LW
1143register struct stat *statbufp;
1144{
bee1dbe2 1145#ifdef DOSISH
fe14fcc3
LW
1146 /* [Comments and code from Len Reed]
1147 * MS-DOS "user" is similar to UNIX's "superuser," but can't write
1148 * to write-protected files. The execute permission bit is set
1149 * by the Miscrosoft C library stat() function for the following:
1150 * .exe files
1151 * .com files
1152 * .bat files
1153 * directories
1154 * All files and directories are readable.
1155 * Directories and special files, e.g. "CON", cannot be
1156 * write-protected.
1157 * [Comment by Tom Dinger -- a directory can have the write-protect
1158 * bit set in the file system, but DOS permits changes to
1159 * the directory anyway. In addition, all bets are off
1160 * here for networked software, such as Novell and
1161 * Sun's PC-NFS.]
1162 */
1163
bee1dbe2
LW
1164 /* Atari stat() does pretty much the same thing. we set x_bit_set_in_stat
1165 * too so it will actually look into the files for magic numbers
1166 */
fe14fcc3
LW
1167 return (bit & statbufp->st_mode) ? TRUE : FALSE;
1168
1169#else /* ! MSDOS */
a687059c 1170 if ((effective ? euid : uid) == 0) { /* root is special */
c623bd54
LW
1171 if (bit == S_IXUSR) {
1172 if (statbufp->st_mode & 0111 || S_ISDIR(statbufp->st_mode))
a687059c
LW
1173 return TRUE;
1174 }
1175 else
1176 return TRUE; /* root reads and writes anything */
1177 return FALSE;
1178 }
1179 if (statbufp->st_uid == (effective ? euid : uid) ) {
1180 if (statbufp->st_mode & bit)
1181 return TRUE; /* ok as "user" */
1182 }
79072805 1183 else if (ingroup((I32)statbufp->st_gid,effective)) {
a687059c
LW
1184 if (statbufp->st_mode & bit >> 3)
1185 return TRUE; /* ok as "group" */
1186 }
1187 else if (statbufp->st_mode & bit >> 6)
1188 return TRUE; /* ok as "other" */
1189 return FALSE;
fe14fcc3 1190#endif /* ! MSDOS */
a687059c 1191}
a0d0e21e 1192#endif /* ! VMS */
a687059c 1193
79072805 1194I32
a687059c 1195ingroup(testgid,effective)
79072805
LW
1196I32 testgid;
1197I32 effective;
a687059c
LW
1198{
1199 if (testgid == (effective ? egid : gid))
1200 return TRUE;
fe14fcc3 1201#ifdef HAS_GETGROUPS
a687059c
LW
1202#ifndef NGROUPS
1203#define NGROUPS 32
1204#endif
1205 {
a0d0e21e 1206 Groups_t gary[NGROUPS];
79072805 1207 I32 anum;
a687059c
LW
1208
1209 anum = getgroups(NGROUPS,gary);
1210 while (--anum >= 0)
1211 if (gary[anum] == testgid)
1212 return TRUE;
1213 }
1214#endif
1215 return FALSE;
1216}
c2ab57d4 1217
fe14fcc3 1218#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
c2ab57d4 1219
79072805
LW
1220I32
1221do_ipcget(optype, mark, sp)
1222I32 optype;
1223SV **mark;
1224SV **sp;
c2ab57d4 1225{
c2ab57d4 1226 key_t key;
79072805 1227 I32 n, flags;
c2ab57d4 1228
463ee0b2
LW
1229 key = (key_t)SvNVx(*++mark);
1230 n = (optype == OP_MSGGET) ? 0 : SvIVx(*++mark);
1231 flags = SvIVx(*++mark);
748a9306 1232 SETERRNO(0,0);
c2ab57d4
LW
1233 switch (optype)
1234 {
fe14fcc3 1235#ifdef HAS_MSG
79072805 1236 case OP_MSGGET:
c2ab57d4 1237 return msgget(key, flags);
e5d73d77 1238#endif
fe14fcc3 1239#ifdef HAS_SEM
79072805 1240 case OP_SEMGET:
c2ab57d4 1241 return semget(key, n, flags);
e5d73d77 1242#endif
fe14fcc3 1243#ifdef HAS_SHM
79072805 1244 case OP_SHMGET:
c2ab57d4 1245 return shmget(key, n, flags);
e5d73d77 1246#endif
fe14fcc3 1247#if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM)
e5d73d77 1248 default:
463ee0b2 1249 croak("%s not implemented", op_name[optype]);
e5d73d77 1250#endif
c2ab57d4
LW
1251 }
1252 return -1; /* should never happen */
1253}
1254
79072805
LW
1255I32
1256do_ipcctl(optype, mark, sp)
1257I32 optype;
1258SV **mark;
1259SV **sp;
c2ab57d4 1260{
79072805 1261 SV *astr;
c2ab57d4 1262 char *a;
a0d0e21e
LW
1263 I32 id, n, cmd, infosize, getinfo;
1264 I32 ret = -1;
c2ab57d4 1265
463ee0b2
LW
1266 id = SvIVx(*++mark);
1267 n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0;
1268 cmd = SvIVx(*++mark);
79072805 1269 astr = *++mark;
c2ab57d4
LW
1270 infosize = 0;
1271 getinfo = (cmd == IPC_STAT);
1272
1273 switch (optype)
1274 {
fe14fcc3 1275#ifdef HAS_MSG
79072805 1276 case OP_MSGCTL:
c2ab57d4
LW
1277 if (cmd == IPC_STAT || cmd == IPC_SET)
1278 infosize = sizeof(struct msqid_ds);
1279 break;
e5d73d77 1280#endif
fe14fcc3 1281#ifdef HAS_SHM
79072805 1282 case OP_SHMCTL:
c2ab57d4
LW
1283 if (cmd == IPC_STAT || cmd == IPC_SET)
1284 infosize = sizeof(struct shmid_ds);
1285 break;
e5d73d77 1286#endif
fe14fcc3 1287#ifdef HAS_SEM
79072805 1288 case OP_SEMCTL:
c2ab57d4
LW
1289 if (cmd == IPC_STAT || cmd == IPC_SET)
1290 infosize = sizeof(struct semid_ds);
1291 else if (cmd == GETALL || cmd == SETALL)
1292 {
1293 struct semid_ds semds;
1294 if (semctl(id, 0, IPC_STAT, &semds) == -1)
1295 return -1;
1296 getinfo = (cmd == GETALL);
6e21c824
LW
1297 infosize = semds.sem_nsems * sizeof(short);
1298 /* "short" is technically wrong but much more portable
1299 than guessing about u_?short(_t)? */
c2ab57d4
LW
1300 }
1301 break;
e5d73d77 1302#endif
fe14fcc3 1303#if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM)
e5d73d77 1304 default:
463ee0b2 1305 croak("%s not implemented", op_name[optype]);
e5d73d77 1306#endif
c2ab57d4
LW
1307 }
1308
1309 if (infosize)
1310 {
a0d0e21e 1311 STRLEN len;
c2ab57d4
LW
1312 if (getinfo)
1313 {
a0d0e21e
LW
1314 SvPV_force(astr, len);
1315 a = SvGROW(astr, infosize+1);
c2ab57d4
LW
1316 }
1317 else
1318 {
463ee0b2
LW
1319 a = SvPV(astr, len);
1320 if (len != infosize)
1321 croak("Bad arg length for %s, is %d, should be %d",
1322 op_name[optype], len, infosize);
c2ab57d4
LW
1323 }
1324 }
1325 else
1326 {
463ee0b2 1327 I32 i = SvIV(astr);
c2ab57d4
LW
1328 a = (char *)i; /* ouch */
1329 }
748a9306 1330 SETERRNO(0,0);
c2ab57d4
LW
1331 switch (optype)
1332 {
fe14fcc3 1333#ifdef HAS_MSG
79072805 1334 case OP_MSGCTL:
bee1dbe2 1335 ret = msgctl(id, cmd, (struct msqid_ds *)a);
c2ab57d4 1336 break;
e5d73d77 1337#endif
fe14fcc3 1338#ifdef HAS_SEM
79072805
LW
1339 case OP_SEMCTL:
1340 ret = semctl(id, n, cmd, (struct semid_ds *)a);
c2ab57d4 1341 break;
e5d73d77 1342#endif
fe14fcc3 1343#ifdef HAS_SHM
79072805 1344 case OP_SHMCTL:
bee1dbe2 1345 ret = shmctl(id, cmd, (struct shmid_ds *)a);
c2ab57d4 1346 break;
e5d73d77 1347#endif
c2ab57d4
LW
1348 }
1349 if (getinfo && ret >= 0) {
79072805
LW
1350 SvCUR_set(astr, infosize);
1351 *SvEND(astr) = '\0';
a0d0e21e 1352 SvSETMAGIC(astr);
c2ab57d4
LW
1353 }
1354 return ret;
1355}
1356
79072805
LW
1357I32
1358do_msgsnd(mark, sp)
1359SV **mark;
1360SV **sp;
c2ab57d4 1361{
fe14fcc3 1362#ifdef HAS_MSG
79072805 1363 SV *mstr;
c2ab57d4 1364 char *mbuf;
79072805 1365 I32 id, msize, flags;
463ee0b2 1366 STRLEN len;
c2ab57d4 1367
463ee0b2 1368 id = SvIVx(*++mark);
79072805 1369 mstr = *++mark;
463ee0b2
LW
1370 flags = SvIVx(*++mark);
1371 mbuf = SvPV(mstr, len);
1372 if ((msize = len - sizeof(long)) < 0)
1373 croak("Arg too short for msgsnd");
748a9306 1374 SETERRNO(0,0);
bee1dbe2 1375 return msgsnd(id, (struct msgbuf *)mbuf, msize, flags);
e5d73d77 1376#else
463ee0b2 1377 croak("msgsnd not implemented");
e5d73d77 1378#endif
c2ab57d4
LW
1379}
1380
79072805
LW
1381I32
1382do_msgrcv(mark, sp)
1383SV **mark;
1384SV **sp;
c2ab57d4 1385{
fe14fcc3 1386#ifdef HAS_MSG
79072805 1387 SV *mstr;
c2ab57d4
LW
1388 char *mbuf;
1389 long mtype;
79072805 1390 I32 id, msize, flags, ret;
463ee0b2 1391 STRLEN len;
79072805 1392
463ee0b2 1393 id = SvIVx(*++mark);
79072805 1394 mstr = *++mark;
463ee0b2
LW
1395 msize = SvIVx(*++mark);
1396 mtype = (long)SvIVx(*++mark);
1397 flags = SvIVx(*++mark);
ed6116ce
LW
1398 if (SvTHINKFIRST(mstr)) {
1399 if (SvREADONLY(mstr))
1400 croak("Can't msgrcv to readonly var");
1401 if (SvROK(mstr))
1402 sv_unref(mstr);
1403 }
a0d0e21e
LW
1404 SvPV_force(mstr, len);
1405 mbuf = SvGROW(mstr, sizeof(long)+msize+1);
1406
748a9306 1407 SETERRNO(0,0);
bee1dbe2 1408 ret = msgrcv(id, (struct msgbuf *)mbuf, msize, mtype, flags);
c2ab57d4 1409 if (ret >= 0) {
79072805
LW
1410 SvCUR_set(mstr, sizeof(long)+ret);
1411 *SvEND(mstr) = '\0';
c2ab57d4
LW
1412 }
1413 return ret;
e5d73d77 1414#else
463ee0b2 1415 croak("msgrcv not implemented");
e5d73d77 1416#endif
c2ab57d4
LW
1417}
1418
79072805
LW
1419I32
1420do_semop(mark, sp)
1421SV **mark;
1422SV **sp;
c2ab57d4 1423{
fe14fcc3 1424#ifdef HAS_SEM
79072805 1425 SV *opstr;
c2ab57d4 1426 char *opbuf;
463ee0b2
LW
1427 I32 id;
1428 STRLEN opsize;
c2ab57d4 1429
463ee0b2 1430 id = SvIVx(*++mark);
79072805 1431 opstr = *++mark;
463ee0b2 1432 opbuf = SvPV(opstr, opsize);
c2ab57d4
LW
1433 if (opsize < sizeof(struct sembuf)
1434 || (opsize % sizeof(struct sembuf)) != 0) {
748a9306 1435 SETERRNO(EINVAL,LIB$_INVARG);
c2ab57d4
LW
1436 return -1;
1437 }
748a9306 1438 SETERRNO(0,0);
6e21c824 1439 return semop(id, (struct sembuf *)opbuf, opsize/sizeof(struct sembuf));
e5d73d77 1440#else
463ee0b2 1441 croak("semop not implemented");
e5d73d77 1442#endif
c2ab57d4
LW
1443}
1444
79072805
LW
1445I32
1446do_shmio(optype, mark, sp)
1447I32 optype;
1448SV **mark;
1449SV **sp;
c2ab57d4 1450{
fe14fcc3 1451#ifdef HAS_SHM
79072805 1452 SV *mstr;
c2ab57d4 1453 char *mbuf, *shm;
79072805 1454 I32 id, mpos, msize;
463ee0b2 1455 STRLEN len;
c2ab57d4 1456 struct shmid_ds shmds;
c2ab57d4 1457
463ee0b2 1458 id = SvIVx(*++mark);
79072805 1459 mstr = *++mark;
463ee0b2
LW
1460 mpos = SvIVx(*++mark);
1461 msize = SvIVx(*++mark);
748a9306 1462 SETERRNO(0,0);
c2ab57d4
LW
1463 if (shmctl(id, IPC_STAT, &shmds) == -1)
1464 return -1;
1465 if (mpos < 0 || msize < 0 || mpos + msize > shmds.shm_segsz) {
748a9306 1466 SETERRNO(EFAULT,SS$_ACCVIO); /* can't do as caller requested */
c2ab57d4
LW
1467 return -1;
1468 }
a0d0e21e 1469 shm = (Shmat_t)shmat(id, (char*)NULL, (optype == OP_SHMREAD) ? SHM_RDONLY : 0);
c2ab57d4
LW
1470 if (shm == (char *)-1) /* I hate System V IPC, I really do */
1471 return -1;
79072805 1472 if (optype == OP_SHMREAD) {
a0d0e21e
LW
1473 SvPV_force(mstr, len);
1474 mbuf = SvGROW(mstr, msize+1);
1475
bee1dbe2 1476 Copy(shm + mpos, mbuf, msize, char);
79072805
LW
1477 SvCUR_set(mstr, msize);
1478 *SvEND(mstr) = '\0';
a0d0e21e 1479 SvSETMAGIC(mstr);
c2ab57d4
LW
1480 }
1481 else {
79072805 1482 I32 n;
c2ab57d4 1483
a0d0e21e 1484 mbuf = SvPV(mstr, len);
463ee0b2 1485 if ((n = len) > msize)
c2ab57d4 1486 n = msize;
bee1dbe2 1487 Copy(mbuf, shm + mpos, n, char);
c2ab57d4 1488 if (n < msize)
bee1dbe2 1489 memzero(shm + mpos + n, msize - n);
c2ab57d4
LW
1490 }
1491 return shmdt(shm);
e5d73d77 1492#else
463ee0b2 1493 croak("shm I/O not implemented");
e5d73d77 1494#endif
c2ab57d4
LW
1495}
1496
fe14fcc3 1497#endif /* SYSV IPC */