This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
This is my patch patch.1m for perl5.001.
[perl5.git] / pp_sys.c
CommitLineData
a0d0e21e
LW		 1/* pp_sys.c
2 *
3 * Copyright (c) 1991-1994, Larry Wall
4 *
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.
7 *
8 */
9
10/*
11 * But only a short way ahead its floor and the walls on either side were
12 * cloven by a great fissure, out of which the red glare came, now leaping
13 * up, now dying down into darkness; and all the while far below there was
14 * a rumour and a trouble as of great engines throbbing and labouring.
15 */
16
17#include "EXTERN.h"
18#include "perl.h"
19
16d20bd9
AD		 20/* XXX Omit this -- it causes too much grief on mixed systems.
21 Next time, I should force broken systems to unset i_unistd in
22 hint files.
a0d0e21e 23*/
16d20bd9
AD		 24#if 0
25# ifdef I_UNISTD
26# include <unistd.h>
27# endif
28#endif
a0d0e21e 29
94b6baf5
AD		 30/* Put this after #includes because fork and vfork prototypes may
31 conflict.
32*/
33#ifndef HAS_VFORK
34# define vfork fork
35#endif
36
a0d0e21e
LW		 37#if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */
38# include <sys/socket.h>
39# include <netdb.h>
40# ifndef ENOTSOCK
41# ifdef I_NET_ERRNO
42# include <net/errno.h>
43# endif
44# endif
45#endif
46
47#ifdef HAS_SELECT
48#ifdef I_SYS_SELECT
49#ifndef I_SYS_TIME
50#include <sys/select.h>
51#endif
52#endif
53#endif
54
55#ifdef HOST_NOT_FOUND
56extern int h_errno;
57#endif
58
59#ifdef HAS_PASSWD
60# ifdef I_PWD
61# include <pwd.h>
62# else
63 struct passwd *getpwnam _((char *));
64 struct passwd *getpwuid _((Uid_t));
65# endif
66 struct passwd *getpwent _((void));
67#endif
68
69#ifdef HAS_GROUP
70# ifdef I_GRP
71# include <grp.h>
72# else
73 struct group *getgrnam _((char *));
74 struct group *getgrgid _((Gid_t));
75# endif
76 struct group *getgrent _((void));
77#endif
78
79#ifdef I_UTIME
80#include <utime.h>
81#endif
82#ifdef I_FCNTL
83#include <fcntl.h>
84#endif
85#ifdef I_SYS_FILE
86#include <sys/file.h>
87#endif
88
89#ifdef HAS_GETPGRP2
90# define getpgrp getpgrp2
91#endif
92
93#ifdef HAS_SETPGRP2
94# define setpgrp setpgrp2
95#endif
96
97#if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
98static int dooneliner _((char *cmd, char *filename));
99#endif
100/* Pushy I/O. */
101
102PP(pp_backtick)
103{
104 dSP; dTARGET;
105 FILE *fp;
106 char *tmps = POPp;
107 TAINT_PROPER("``");
108 fp = my_popen(tmps, "r");
109 if (fp) {
110 sv_setpv(TARG, ""); /* note that this preserves previous buffer */
111 if (GIMME == G_SCALAR) {
112 while (sv_gets(TARG, fp, SvCUR(TARG)) != Nullch)
113 /*SUPPRESS 530*/
114 ;
115 XPUSHs(TARG);
116 }
117 else {
118 SV *sv;
119
120 for (;;) {
121 sv = NEWSV(56, 80);
122 if (sv_gets(sv, fp, 0) == Nullch) {
123 SvREFCNT_dec(sv);
124 break;
125 }
126 XPUSHs(sv_2mortal(sv));
127 if (SvLEN(sv) - SvCUR(sv) > 20) {
128 SvLEN_set(sv, SvCUR(sv)+1);
129 Renew(SvPVX(sv), SvLEN(sv), char);
130 }
131 }
132 }
133 statusvalue = my_pclose(fp);
134 }
135 else {
136 statusvalue = -1;
137 if (GIMME == G_SCALAR)
138 RETPUSHUNDEF;
139 }
140
141 RETURN;
142}
143
144PP(pp_glob)
145{
146 OP *result;
147 ENTER;
148 SAVEINT(rschar);
149 SAVEINT(rslen);
150
151 SAVESPTR(last_in_gv); /* We don't want this to be permanent. */
152 last_in_gv = (GV*)*stack_sp--;
153
154 rslen = 1;
155#ifdef DOSISH
156 rschar = 0;
157#else
158#ifdef CSH
159 rschar = 0;
160#else
161 rschar = '\n';
162#endif /* !CSH */
163#endif /* !MSDOS */
164 result = do_readline();
165 LEAVE;
166 return result;
167}
168
169PP(pp_indread)
170{
171 last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*stack_sp--)), na), TRUE,SVt_PVIO);
172 return do_readline();
173}
174
175PP(pp_rcatline)
176{
177 last_in_gv = cGVOP->op_gv;
178 return do_readline();
179}
180
181PP(pp_warn)
182{
183 dSP; dMARK;
184 char *tmps;
185 if (SP - MARK != 1) {
186 dTARGET;
187 do_join(TARG, &sv_no, MARK, SP);
188 tmps = SvPV(TARG, na);
189 SP = MARK + 1;
190 }
191 else {
192 tmps = SvPV(TOPs, na);
193 }
194 if (!tmps || !*tmps) {
195 SV *error = GvSV(gv_fetchpv("@", TRUE, SVt_PV));
196 (void)SvUPGRADE(error, SVt_PV);
197 if (SvPOK(error) && SvCUR(error))
198 sv_catpv(error, "\t...caught");
199 tmps = SvPV(error, na);
200 }
201 if (!tmps || !*tmps)
202 tmps = "Warning: something's wrong";
203 warn("%s", tmps);
204 RETSETYES;
205}
206
207PP(pp_die)
208{
209 dSP; dMARK;
210 char *tmps;
211 if (SP - MARK != 1) {
212 dTARGET;
213 do_join(TARG, &sv_no, MARK, SP);
214 tmps = SvPV(TARG, na);
215 SP = MARK + 1;
216 }
217 else {
218 tmps = SvPV(TOPs, na);
219 }
220 if (!tmps || !*tmps) {
221 SV *error = GvSV(gv_fetchpv("@", TRUE, SVt_PV));
222 (void)SvUPGRADE(error, SVt_PV);
223 if (SvPOK(error) && SvCUR(error))
224 sv_catpv(error, "\t...propagated");
225 tmps = SvPV(error, na);
226 }
227 if (!tmps || !*tmps)
228 tmps = "Died";
229 DIE("%s", tmps);
230}
231
232/* I/O. */
233
234PP(pp_open)
235{
236 dSP; dTARGET;
237 GV *gv;
238 SV *sv;
239 char *tmps;
240 STRLEN len;
241
242 if (MAXARG > 1)
243 sv = POPs;
244 else
245 sv = GvSV(TOPs);
246 gv = (GV*)POPs;
247 tmps = SvPV(sv, len);
248 if (do_open(gv, tmps, len,Nullfp)) {
249 IoLINES(GvIOp(gv)) = 0;
250 PUSHi( (I32)forkprocess );
251 }
252 else if (forkprocess == 0) /* we are a new child */
253 PUSHi(0);
254 else
255 RETPUSHUNDEF;
256 RETURN;
257}
258
259PP(pp_close)
260{
261 dSP;
262 GV *gv;
263
264 if (MAXARG == 0)
265 gv = defoutgv;
266 else
267 gv = (GV*)POPs;
268 EXTEND(SP, 1);
269 PUSHs( do_close(gv, TRUE) ? &sv_yes : &sv_no );
270 RETURN;
271}
272
273PP(pp_pipe_op)
274{
275 dSP;
276#ifdef HAS_PIPE
277 GV *rgv;
278 GV *wgv;
279 register IO *rstio;
280 register IO *wstio;
281 int fd[2];
282
283 wgv = (GV*)POPs;
284 rgv = (GV*)POPs;
285
286 if (!rgv || !wgv)
287 goto badexit;
288
289 rstio = GvIOn(rgv);
290 wstio = GvIOn(wgv);
291
292 if (IoIFP(rstio))
293 do_close(rgv, FALSE);
294 if (IoIFP(wstio))
295 do_close(wgv, FALSE);
296
297 if (pipe(fd) < 0)
298 goto badexit;
299
300 IoIFP(rstio) = fdopen(fd[0], "r");
301 IoOFP(wstio) = fdopen(fd[1], "w");
302 IoIFP(wstio) = IoOFP(wstio);
303 IoTYPE(rstio) = '<';
304 IoTYPE(wstio) = '>';
305
306 if (!IoIFP(rstio) || !IoOFP(wstio)) {
307 if (IoIFP(rstio)) fclose(IoIFP(rstio));
308 else close(fd[0]);
309 if (IoOFP(wstio)) fclose(IoOFP(wstio));
310 else close(fd[1]);
311 goto badexit;
312 }
313
314 RETPUSHYES;
315
316badexit:
317 RETPUSHUNDEF;
318#else
319 DIE(no_func, "pipe");
320#endif
321}
322
323PP(pp_fileno)
324{
325 dSP; dTARGET;
326 GV *gv;
327 IO *io;
328 FILE *fp;
329 if (MAXARG < 1)
330 RETPUSHUNDEF;
331 gv = (GV*)POPs;
332 if (!gv || !(io = GvIO(gv)) || !(fp = IoIFP(io)))
333 RETPUSHUNDEF;
334 PUSHi(fileno(fp));
335 RETURN;
336}
337
338PP(pp_umask)
339{
340 dSP; dTARGET;
341 int anum;
342
343#ifdef HAS_UMASK
344 if (MAXARG < 1) {
345 anum = umask(0);
346 (void)umask(anum);
347 }
348 else
349 anum = umask(POPi);
350 TAINT_PROPER("umask");
351 XPUSHi(anum);
352#else
353 DIE(no_func, "Unsupported function umask");
354#endif
355 RETURN;
356}
357
358PP(pp_binmode)
359{
360 dSP;
361 GV *gv;
362 IO *io;
363 FILE *fp;
364
365 if (MAXARG < 1)
366 RETPUSHUNDEF;
367
368 gv = (GV*)POPs;
369
370 EXTEND(SP, 1);
371 if (!(io = GvIO(gv)) || !(fp = IoIFP(io)))
372 RETSETUNDEF;
373
374#ifdef DOSISH
375#ifdef atarist
376 if (!fflush(fp) && (fp->_flag |= _IOBIN))
377 RETPUSHYES;
378 else
379 RETPUSHUNDEF;
380#else
381 if (setmode(fileno(fp), OP_BINARY) != -1)
382 RETPUSHYES;
383 else
384 RETPUSHUNDEF;
385#endif
386#else
387 RETPUSHYES;
388#endif
389}
390
391PP(pp_tie)
392{
393 dSP;
394 SV *varsv;
395 HV* stash;
396 GV *gv;
397 BINOP myop;
398 SV *sv;
399 SV **mark = stack_base + ++*markstack_ptr; /* reuse in entersub */
400 I32 markoff = mark - stack_base - 1;
401 char *methname;
402
403 varsv = mark[0];
404 if (SvTYPE(varsv) == SVt_PVHV)
405 methname = "TIEHASH";
406 else if (SvTYPE(varsv) == SVt_PVAV)
407 methname = "TIEARRAY";
408 else if (SvTYPE(varsv) == SVt_PVGV)
409 methname = "TIEHANDLE";
410 else
411 methname = "TIESCALAR";
412
413 stash = gv_stashsv(mark[1], FALSE);
414 if (!stash || !(gv = gv_fetchmethod(stash, methname)) || !GvCV(gv))
415 DIE("Can't locate object method \"%s\" via package \"%s\"",
416 methname, SvPV(mark[1],na));
417
418 Zero(&myop, 1, BINOP);
419 myop.op_last = (OP *) &myop;
420 myop.op_next = Nullop;
421 myop.op_flags = OPf_KNOW|OPf_STACKED;
422
423 ENTER;
424 SAVESPTR(op);
425 op = (OP *) &myop;
426
427 XPUSHs(gv);
428 PUTBACK;
429
430 if (op = pp_entersub())
431 run();
432 SPAGAIN;
433
434 sv = TOPs;
435 if (sv_isobject(sv)) {
436 if (SvTYPE(varsv) == SVt_PVHV || SvTYPE(varsv) == SVt_PVAV) {
437 sv_unmagic(varsv, 'P');
438 sv_magic(varsv, sv, 'P', Nullch, 0);
439 }
440 else {
441 sv_unmagic(varsv, 'q');
442 sv_magic(varsv, sv, 'q', Nullch, 0);
443 }
444 }
445 LEAVE;
446 SP = stack_base + markoff;
447 PUSHs(sv);
448 RETURN;
449}
450
451PP(pp_untie)
452{
453 dSP;
454 if (SvTYPE(TOPs) == SVt_PVHV || SvTYPE(TOPs) == SVt_PVAV)
455 sv_unmagic(TOPs, 'P');
456 else
457 sv_unmagic(TOPs, 'q');
458 RETSETYES;
459}
460
461PP(pp_dbmopen)
462{
463 dSP;
464 HV *hv;
465 dPOPPOPssrl;
466 HV* stash;
467 GV *gv;
468 BINOP myop;
469 SV *sv;
470
471 hv = (HV*)POPs;
472
473 sv = sv_mortalcopy(&sv_no);
474 sv_setpv(sv, "AnyDBM_File");
475 stash = gv_stashsv(sv, FALSE);
476 if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH")) || !GvCV(gv)) {
477 PUTBACK;
478 perl_requirepv("AnyDBM_File.pm");
479 SPAGAIN;
480 if (!(gv = gv_fetchmethod(stash, "TIEHASH")) || !GvCV(gv))
481 DIE("No dbm on this machine");
482 }
483
484 Zero(&myop, 1, BINOP);
485 myop.op_last = (OP *) &myop;
486 myop.op_next = Nullop;
487 myop.op_flags = OPf_KNOW|OPf_STACKED;
488
489 ENTER;
490 SAVESPTR(op);
491 op = (OP *) &myop;
492 PUTBACK;
493 pp_pushmark();
494
495 EXTEND(sp, 5);
496 PUSHs(sv);
497 PUSHs(left);
498 if (SvIV(right))
499 PUSHs(sv_2mortal(newSViv(O_RDWR|O_CREAT)));
500 else
501 PUSHs(sv_2mortal(newSViv(O_RDWR)));
502 PUSHs(right);
503 PUSHs(gv);
504 PUTBACK;
505
506 if (op = pp_entersub())
507 run();
508 SPAGAIN;
509
510 if (!sv_isobject(TOPs)) {
511 sp--;
512 op = (OP *) &myop;
513 PUTBACK;
514 pp_pushmark();
515
516 PUSHs(sv);
517 PUSHs(left);
518 PUSHs(sv_2mortal(newSViv(O_RDONLY)));
519 PUSHs(right);
520 PUSHs(gv);
521 PUTBACK;
522
523 if (op = pp_entersub())
524 run();
525 SPAGAIN;
526 }
527
528 if (sv_isobject(TOPs))
529 sv_magic((SV*)hv, TOPs, 'P', Nullch, 0);
530 LEAVE;
531 RETURN;
532}
533
534PP(pp_dbmclose)
535{
536 return pp_untie(ARGS);
537}
538
539PP(pp_sselect)
540{
541 dSP; dTARGET;
542#ifdef HAS_SELECT
543 register I32 i;
544 register I32 j;
545 register char *s;
546 register SV *sv;
547 double value;
548 I32 maxlen = 0;
549 I32 nfound;
550 struct timeval timebuf;
551 struct timeval *tbuf = &timebuf;
552 I32 growsize;
553 char *fd_sets[4];
554#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
555 I32 masksize;
556 I32 offset;
557 I32 k;
558
559# if BYTEORDER & 0xf0000
560# define ORDERBYTE (0x88888888 - BYTEORDER)
561# else
562# define ORDERBYTE (0x4444 - BYTEORDER)
563# endif
564
565#endif
566
567 SP -= 4;
568 for (i = 1; i <= 3; i++) {
569 if (!SvPOK(SP[i]))
570 continue;
571 j = SvCUR(SP[i]);
572 if (maxlen < j)
573 maxlen = j;
574 }
575
576#if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
577 growsize = maxlen; /* little endians can use vecs directly */
578#else
579#ifdef NFDBITS
580
581#ifndef NBBY
582#define NBBY 8
583#endif
584
585 masksize = NFDBITS / NBBY;
586#else
587 masksize = sizeof(long); /* documented int, everyone seems to use long */
588#endif
589 growsize = maxlen + (masksize - (maxlen % masksize));
590 Zero(&fd_sets[0], 4, char*);
591#endif
592
593 sv = SP[4];
594 if (SvOK(sv)) {
595 value = SvNV(sv);
596 if (value < 0.0)
597 value = 0.0;
598 timebuf.tv_sec = (long)value;
599 value -= (double)timebuf.tv_sec;
600 timebuf.tv_usec = (long)(value * 1000000.0);
601 }
602 else
603 tbuf = Null(struct timeval*);
604
605 for (i = 1; i <= 3; i++) {
606 sv = SP[i];
607 if (!SvOK(sv)) {
608 fd_sets[i] = 0;
609 continue;
610 }
611 else if (!SvPOK(sv))
612 SvPV_force(sv,na); /* force string conversion */
613 j = SvLEN(sv);
614 if (j < growsize) {
615 Sv_Grow(sv, growsize);
616 s = SvPVX(sv) + j;
617 while (++j <= growsize) {
618 *s++ = '\0';
619 }
620 }
621#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
622 s = SvPVX(sv);
623 New(403, fd_sets[i], growsize, char);
624 for (offset = 0; offset < growsize; offset += masksize) {
625 for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4))
626 fd_sets[i][j+offset] = s[(k % masksize) + offset];
627 }
628#else
629 fd_sets[i] = SvPVX(sv);
630#endif
631 }
632
633 nfound = select(
634 maxlen * 8,
635 (Select_fd_set_t) fd_sets[1],
636 (Select_fd_set_t) fd_sets[2],
637 (Select_fd_set_t) fd_sets[3],
638 tbuf);
639 for (i = 1; i <= 3; i++) {
640 if (fd_sets[i]) {
641 sv = SP[i];
642#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
643 s = SvPVX(sv);
644 for (offset = 0; offset < growsize; offset += masksize) {
645 for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4))
646 s[(k % masksize) + offset] = fd_sets[i][j+offset];
647 }
648 Safefree(fd_sets[i]);
649#endif
650 SvSETMAGIC(sv);
651 }
652 }
653
654 PUSHi(nfound);
655 if (GIMME == G_ARRAY && tbuf) {
656 value = (double)(timebuf.tv_sec) +
657 (double)(timebuf.tv_usec) / 1000000.0;
658 PUSHs(sv = sv_mortalcopy(&sv_no));
659 sv_setnv(sv, value);
660 }
661 RETURN;
662#else
663 DIE("select not implemented");
664#endif
665}
666
667PP(pp_select)
668{
669 dSP; dTARGET;
670 GV *oldgv = defoutgv;
671 if (op->op_private > 0) {
672 defoutgv = (GV*)POPs;
673 if (!GvIO(defoutgv))
674 gv_IOadd(defoutgv);
675 }
676 gv_efullname(TARG, oldgv);
677 XPUSHTARG;
678 RETURN;
679}
680
681PP(pp_getc)
682{
683 dSP; dTARGET;
684 GV *gv;
685
686 if (MAXARG <= 0)
687 gv = stdingv;
688 else
689 gv = (GV*)POPs;
690 if (!gv)
691 gv = argvgv;
692 if (!gv || do_eof(gv)) /* make sure we have fp with something */
693 RETPUSHUNDEF;
694 TAINT_IF(1);
695 sv_setpv(TARG, " ");
696 *SvPVX(TARG) = getc(IoIFP(GvIOp(gv))); /* should never be EOF */
697 PUSHTARG;
698 RETURN;
699}
700
701PP(pp_read)
702{
703 return pp_sysread(ARGS);
704}
705
706static OP *
707doform(cv,gv,retop)
708CV *cv;
709GV *gv;
710OP *retop;
711{
712 register CONTEXT *cx;
713 I32 gimme = GIMME;
714 AV* padlist = CvPADLIST(cv);
715 SV** svp = AvARRAY(padlist);
716
717 ENTER;
718 SAVETMPS;
719
720 push_return(retop);
721 PUSHBLOCK(cx, CXt_SUB, stack_sp);
722 PUSHFORMAT(cx);
723 SAVESPTR(curpad);
724 curpad = AvARRAY((AV*)svp[1]);
725
726 defoutgv = gv; /* locally select filehandle so $% et al work */
727 return CvSTART(cv);
728}
729
730PP(pp_enterwrite)
731{
732 dSP;
733 register GV *gv;
734 register IO *io;
735 GV *fgv;
736 CV *cv;
737
738 if (MAXARG == 0)
739 gv = defoutgv;
740 else {
741 gv = (GV*)POPs;
742 if (!gv)
743 gv = defoutgv;
744 }
745 EXTEND(SP, 1);
746 io = GvIO(gv);
747 if (!io) {
748 RETPUSHNO;
749 }
750 if (IoFMT_GV(io))
751 fgv = IoFMT_GV(io);
752 else
753 fgv = gv;
754
755 cv = GvFORM(fgv);
756
757 if (!cv) {
758 if (fgv) {
748a9306
LW		 759 SV *tmpsv = sv_newmortal();
760 gv_efullname(tmpsv, gv);
761 DIE("Undefined format \"%s\" called",SvPVX(tmpsv));
a0d0e21e
LW		 762 }
763 DIE("Not a format reference");
764 }
748a9306 765 IoFLAGS(io) &= ~IOf_DIDTOP;
a0d0e21e
LW		 766
767 return doform(cv,gv,op->op_next);
768}
769
770PP(pp_leavewrite)
771{
772 dSP;
773 GV *gv = cxstack[cxstack_ix].blk_sub.gv;
774 register IO *io = GvIOp(gv);
775 FILE *ofp = IoOFP(io);
776 FILE *fp;
777 SV **newsp;
778 I32 gimme;
779 register CONTEXT *cx;
780
781 DEBUG_f(fprintf(stderr,"left=%ld, todo=%ld\n",
782 (long)IoLINES_LEFT(io), (long)FmLINES(formtarget)));
783 if (IoLINES_LEFT(io) < FmLINES(formtarget) &&
784 formtarget != toptarget)
785 {
786 if (!IoTOP_GV(io)) {
787 GV *topgv;
788 char tmpbuf[256];
789
790 if (!IoTOP_NAME(io)) {
791 if (!IoFMT_NAME(io))
792 IoFMT_NAME(io) = savepv(GvNAME(gv));
793 sprintf(tmpbuf, "%s_TOP", IoFMT_NAME(io));
794 topgv = gv_fetchpv(tmpbuf,FALSE, SVt_PVFM);
748a9306 795 if ((topgv && GvFORM(topgv)) ||
a0d0e21e
LW		 796 !gv_fetchpv("top",FALSE,SVt_PVFM))
797 IoTOP_NAME(io) = savepv(tmpbuf);
798 else
799 IoTOP_NAME(io) = savepv("top");
800 }
801 topgv = gv_fetchpv(IoTOP_NAME(io),FALSE, SVt_PVFM);
802 if (!topgv || !GvFORM(topgv)) {
803 IoLINES_LEFT(io) = 100000000;
804 goto forget_top;
805 }
806 IoTOP_GV(io) = topgv;
807 }
748a9306
LW		 808 if (IoFLAGS(io) & IOf_DIDTOP) { /* Oh dear. It still doesn't fit. */
809 I32 lines = IoLINES_LEFT(io);
810 char *s = SvPVX(formtarget);
811 while (lines-- > 0) {
812 s = strchr(s, '\n');
813 if (!s)
814 break;
815 s++;
816 }
817 if (s) {
818 fwrite1(SvPVX(formtarget), s - SvPVX(formtarget), 1, ofp);
819 sv_chop(formtarget, s);
820 FmLINES(formtarget) -= IoLINES_LEFT(io);
821 }
822 }
a0d0e21e
LW		 823 if (IoLINES_LEFT(io) >= 0 && IoPAGE(io) > 0)
824 fwrite1(SvPVX(formfeed), SvCUR(formfeed), 1, ofp);
825 IoLINES_LEFT(io) = IoPAGE_LEN(io);
826 IoPAGE(io)++;
827 formtarget = toptarget;
748a9306 828 IoFLAGS(io) |= IOf_DIDTOP;
a0d0e21e
LW		 829 return doform(GvFORM(IoTOP_GV(io)),gv,op);
830 }
831
832 forget_top:
833 POPBLOCK(cx,curpm);
834 POPFORMAT(cx);
835 LEAVE;
836
837 fp = IoOFP(io);
838 if (!fp) {
839 if (dowarn) {
840 if (IoIFP(io))
841 warn("Filehandle only opened for input");
842 else
843 warn("Write on closed filehandle");
844 }
845 PUSHs(&sv_no);
846 }
847 else {
848 if ((IoLINES_LEFT(io) -= FmLINES(formtarget)) < 0) {
849 if (dowarn)
850 warn("page overflow");
851 }
852 if (!fwrite1(SvPVX(formtarget), 1, SvCUR(formtarget), ofp) ||
853 ferror(fp))
854 PUSHs(&sv_no);
855 else {
856 FmLINES(formtarget) = 0;
857 SvCUR_set(formtarget, 0);
748a9306 858 *SvEND(formtarget) = '\0';
a0d0e21e
LW		 859 if (IoFLAGS(io) & IOf_FLUSH)
860 (void)fflush(fp);
861 PUSHs(&sv_yes);
862 }
863 }
864 formtarget = bodytarget;
865 PUTBACK;
866 return pop_return();
867}
868
869PP(pp_prtf)
870{
871 dSP; dMARK; dORIGMARK;
872 GV *gv;
873 IO *io;
874 FILE *fp;
875 SV *sv = NEWSV(0,0);
876
877 if (op->op_flags & OPf_STACKED)
878 gv = (GV*)*++MARK;
879 else
880 gv = defoutgv;
881 if (!(io = GvIO(gv))) {
748a9306
LW		 882 if (dowarn) {
883 gv_fullname(sv,gv);
884 warn("Filehandle %s never opened", SvPV(sv,na));
885 }
886 SETERRNO(EBADF,RMS$_IFI);
a0d0e21e
LW		 887 goto just_say_no;
888 }
889 else if (!(fp = IoOFP(io))) {
890 if (dowarn) {
748a9306 891 gv_fullname(sv,gv);
a0d0e21e 892 if (IoIFP(io))
748a9306 893 warn("Filehandle %s opened only for input", SvPV(sv,na));
a0d0e21e 894 else
748a9306 895 warn("printf on closed filehandle %s", SvPV(sv,na));
a0d0e21e 896 }
748a9306 897 SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
a0d0e21e
LW		 898 goto just_say_no;
899 }
900 else {
901 do_sprintf(sv, SP - MARK, MARK + 1);
902 if (!do_print(sv, fp))
903 goto just_say_no;
904
905 if (IoFLAGS(io) & IOf_FLUSH)
906 if (fflush(fp) == EOF)
907 goto just_say_no;
908 }
909 SvREFCNT_dec(sv);
910 SP = ORIGMARK;
911 PUSHs(&sv_yes);
912 RETURN;
913
914 just_say_no:
915 SvREFCNT_dec(sv);
916 SP = ORIGMARK;
917 PUSHs(&sv_undef);
918 RETURN;
919}
920
921PP(pp_sysread)
922{
923 dSP; dMARK; dORIGMARK; dTARGET;
924 int offset;
925 GV *gv;
926 IO *io;
927 char *buffer;
928 int length;
929 int bufsize;
748a9306 930 SV *bufsv;
a0d0e21e
LW		 931 STRLEN blen;
932
933 gv = (GV*)*++MARK;
934 if (!gv)
935 goto say_undef;
748a9306
LW		 936 bufsv = *++MARK;
937 buffer = SvPV_force(bufsv, blen);
a0d0e21e
LW		 938 length = SvIVx(*++MARK);
939 if (length < 0)
940 DIE("Negative length");
748a9306 941 SETERRNO(0,0);
a0d0e21e
LW		 942 if (MARK < SP)
943 offset = SvIVx(*++MARK);
944 else
945 offset = 0;
946 io = GvIO(gv);
947 if (!io || !IoIFP(io))
948 goto say_undef;
949#ifdef HAS_SOCKET
950 if (op->op_type == OP_RECV) {
951 bufsize = sizeof buf;
748a9306 952 buffer = SvGROW(bufsv, length+1);
a0d0e21e
LW		 953 length = recvfrom(fileno(IoIFP(io)), buffer, length, offset,
954 (struct sockaddr *)buf, &bufsize);
955 if (length < 0)
956 RETPUSHUNDEF;
748a9306
LW		 957 SvCUR_set(bufsv, length);
958 *SvEND(bufsv) = '\0';
959 (void)SvPOK_only(bufsv);
960 SvSETMAGIC(bufsv);
a0d0e21e 961 if (tainting)
748a9306 962 sv_magic(bufsv, Nullsv, 't', Nullch, 0);
a0d0e21e
LW		 963 SP = ORIGMARK;
964 sv_setpvn(TARG, buf, bufsize);
965 PUSHs(TARG);
966 RETURN;
967 }
968#else
969 if (op->op_type == OP_RECV)
970 DIE(no_sock_func, "recv");
971#endif
748a9306 972 buffer = SvGROW(bufsv, length+offset+1);
a0d0e21e
LW		 973 if (op->op_type == OP_SYSREAD) {
974 length = read(fileno(IoIFP(io)), buffer+offset, length);
975 }
976 else
977#ifdef HAS_SOCKET__bad_code_maybe
978 if (IoTYPE(io) == 's') {
979 bufsize = sizeof buf;
980 length = recvfrom(fileno(IoIFP(io)), buffer+offset, length, 0,
981 (struct sockaddr *)buf, &bufsize);
982 }
983 else
984#endif
985 length = fread(buffer+offset, 1, length, IoIFP(io));
986 if (length < 0)
987 goto say_undef;
748a9306
LW		 988 SvCUR_set(bufsv, length+offset);
989 *SvEND(bufsv) = '\0';
990 (void)SvPOK_only(bufsv);
991 SvSETMAGIC(bufsv);
a0d0e21e 992 if (tainting)
748a9306 993 sv_magic(bufsv, Nullsv, 't', Nullch, 0);
a0d0e21e
LW		 994 SP = ORIGMARK;
995 PUSHi(length);
996 RETURN;
997
998 say_undef:
999 SP = ORIGMARK;
1000 RETPUSHUNDEF;
1001}
1002
1003PP(pp_syswrite)
1004{
1005 return pp_send(ARGS);
1006}
1007
1008PP(pp_send)
1009{
1010 dSP; dMARK; dORIGMARK; dTARGET;
1011 GV *gv;
1012 IO *io;
1013 int offset;
748a9306 1014 SV *bufsv;
a0d0e21e
LW		 1015 char *buffer;
1016 int length;
1017 STRLEN blen;
1018
1019 gv = (GV*)*++MARK;
1020 if (!gv)
1021 goto say_undef;
748a9306
LW		 1022 bufsv = *++MARK;
1023 buffer = SvPV(bufsv, blen);
a0d0e21e
LW		 1024 length = SvIVx(*++MARK);
1025 if (length < 0)
1026 DIE("Negative length");
748a9306 1027 SETERRNO(0,0);
a0d0e21e
LW		 1028 io = GvIO(gv);
1029 if (!io || !IoIFP(io)) {
1030 length = -1;
1031 if (dowarn) {
1032 if (op->op_type == OP_SYSWRITE)
1033 warn("Syswrite on closed filehandle");
1034 else
1035 warn("Send on closed socket");
1036 }
1037 }
1038 else if (op->op_type == OP_SYSWRITE) {
1039 if (MARK < SP)
1040 offset = SvIVx(*++MARK);
1041 else
1042 offset = 0;
1043 if (length > blen - offset)
1044 length = blen - offset;
1045 length = write(fileno(IoIFP(io)), buffer+offset, length);
1046 }
1047#ifdef HAS_SOCKET
1048 else if (SP > MARK) {
1049 char *sockbuf;
1050 STRLEN mlen;
1051 sockbuf = SvPVx(*++MARK, mlen);
1052 length = sendto(fileno(IoIFP(io)), buffer, blen, length,
1053 (struct sockaddr *)sockbuf, mlen);
1054 }
1055 else
1056 length = send(fileno(IoIFP(io)), buffer, blen, length);
1057#else
1058 else
1059 DIE(no_sock_func, "send");
1060#endif
1061 if (length < 0)
1062 goto say_undef;
1063 SP = ORIGMARK;
1064 PUSHi(length);
1065 RETURN;
1066
1067 say_undef:
1068 SP = ORIGMARK;
1069 RETPUSHUNDEF;
1070}
1071
1072PP(pp_recv)
1073{
1074 return pp_sysread(ARGS);
1075}
1076
1077PP(pp_eof)
1078{
1079 dSP;
1080 GV *gv;
1081
1082 if (MAXARG <= 0)
1083 gv = last_in_gv;
1084 else
1085 gv = last_in_gv = (GV*)POPs;
1086 PUSHs(!gv || do_eof(gv) ? &sv_yes : &sv_no);
1087 RETURN;
1088}
1089
1090PP(pp_tell)
1091{
1092 dSP; dTARGET;
1093 GV *gv;
1094
1095 if (MAXARG <= 0)
1096 gv = last_in_gv;
1097 else
1098 gv = last_in_gv = (GV*)POPs;
1099 PUSHi( do_tell(gv) );
1100 RETURN;
1101}
1102
1103PP(pp_seek)
1104{
1105 dSP;
1106 GV *gv;
1107 int whence = POPi;
1108 long offset = POPl;
1109
1110 gv = last_in_gv = (GV*)POPs;
1111 PUSHs( do_seek(gv, offset, whence) ? &sv_yes : &sv_no );
1112 RETURN;
1113}
1114
1115PP(pp_truncate)
1116{
1117 dSP;
1118 Off_t len = (Off_t)POPn;
1119 int result = 1;
1120 GV *tmpgv;
1121
748a9306 1122 SETERRNO(0,0);
5d94fbed 1123#if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE) || defined(F_FREESP)
a0d0e21e
LW		 1124#ifdef HAS_TRUNCATE
1125 if (op->op_flags & OPf_SPECIAL) {
1126 tmpgv = gv_fetchpv(POPp,FALSE, SVt_PVIO);
1127 if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
1128 ftruncate(fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
1129 result = 0;
1130 }
1131 else if (truncate(POPp, len) < 0)
1132 result = 0;
1133#else
1134 if (op->op_flags & OPf_SPECIAL) {
1135 tmpgv = gv_fetchpv(POPp,FALSE, SVt_PVIO);
1136 if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
1137 chsize(fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
1138 result = 0;
1139 }
1140 else {
1141 int tmpfd;
1142
1143 if ((tmpfd = open(POPp, 0)) < 0)
1144 result = 0;
1145 else {
1146 if (chsize(tmpfd, len) < 0)
1147 result = 0;
1148 close(tmpfd);
1149 }
1150 }
1151#endif
1152
1153 if (result)
1154 RETPUSHYES;
1155 if (!errno)
748a9306 1156 SETERRNO(EBADF,RMS$_IFI);
a0d0e21e
LW		 1157 RETPUSHUNDEF;
1158#else
1159 DIE("truncate not implemented");
1160#endif
1161}
1162
1163PP(pp_fcntl)
1164{
1165 return pp_ioctl(ARGS);
1166}
1167
1168PP(pp_ioctl)
1169{
1170 dSP; dTARGET;
748a9306 1171 SV *argsv = POPs;
a0d0e21e
LW		 1172 unsigned int func = U_I(POPn);
1173 int optype = op->op_type;
1174 char *s;
1175 int retval;
1176 GV *gv = (GV*)POPs;
1177 IO *io = GvIOn(gv);
1178
748a9306
LW		 1179 if (!io || !argsv || !IoIFP(io)) {
1180 SETERRNO(EBADF,RMS$_IFI); /* well, sort of... */
a0d0e21e
LW		 1181 RETPUSHUNDEF;
1182 }
1183
748a9306 1184 if (SvPOK(argsv) || !SvNIOK(argsv)) {
a0d0e21e 1185 STRLEN len;
748a9306 1186 s = SvPV_force(argsv, len);
a0d0e21e
LW		 1187 retval = IOCPARM_LEN(func);
1188 if (len < retval) {
748a9306
LW		 1189 s = Sv_Grow(argsv, retval+1);
1190 SvCUR_set(argsv, retval);
a0d0e21e
LW		 1191 }
1192
748a9306 1193 s[SvCUR(argsv)] = 17; /* a little sanity check here */
a0d0e21e
LW		 1194 }
1195 else {
748a9306 1196 retval = SvIV(argsv);
a0d0e21e
LW		 1197#ifdef DOSISH
1198 s = (char*)(long)retval; /* ouch */
1199#else
1200 s = (char*)retval; /* ouch */
1201#endif
1202 }
1203
1204 TAINT_PROPER(optype == OP_IOCTL ? "ioctl" : "fcntl");
1205
1206 if (optype == OP_IOCTL)
1207#ifdef HAS_IOCTL
1208 retval = ioctl(fileno(IoIFP(io)), func, s);
1209#else
1210 DIE("ioctl is not implemented");
1211#endif
1212 else
1213#ifdef DOSISH
1214 DIE("fcntl is not implemented");
1215#else
1216# ifdef HAS_FCNTL
1217 retval = fcntl(fileno(IoIFP(io)), func, s);
1218# else
1219 DIE("fcntl is not implemented");
1220# endif
1221#endif
1222
748a9306
LW		 1223 if (SvPOK(argsv)) {
1224 if (s[SvCUR(argsv)] != 17)
a0d0e21e
LW		 1225 DIE("Possible memory corruption: %s overflowed 3rd argument",
1226 op_name[optype]);
748a9306
LW		 1227 s[SvCUR(argsv)] = 0; /* put our null back */
1228 SvSETMAGIC(argsv); /* Assume it has changed */
a0d0e21e
LW		 1229 }
1230
1231 if (retval == -1)
1232 RETPUSHUNDEF;
1233 if (retval != 0) {
1234 PUSHi(retval);
1235 }
1236 else {
1237 PUSHp("0 but true", 10);
1238 }
1239 RETURN;
1240}
1241
1242PP(pp_flock)
1243{
1244 dSP; dTARGET;
1245 I32 value;
1246 int argtype;
1247 GV *gv;
1248 FILE *fp;
16d20bd9
AD		 1249
1250#if !defined(HAS_FLOCK) && defined(HAS_LOCKF)
1251# define flock lockf_emulate_flock
1252#endif
1253
1254#if defined(HAS_FLOCK) || defined(flock)
a0d0e21e
LW		 1255 argtype = POPi;
1256 if (MAXARG <= 0)
1257 gv = last_in_gv;
1258 else
1259 gv = (GV*)POPs;
1260 if (gv && GvIO(gv))
1261 fp = IoIFP(GvIOp(gv));
1262 else
1263 fp = Nullfp;
1264 if (fp) {
1265 value = (I32)(flock(fileno(fp), argtype) >= 0);
1266 }
1267 else
1268 value = 0;
1269 PUSHi(value);
1270 RETURN;
1271#else
a0d0e21e 1272 DIE(no_func, "flock()");
a0d0e21e
LW		 1273#endif
1274}
1275
1276/* Sockets. */
1277
1278PP(pp_socket)
1279{
1280 dSP;
1281#ifdef HAS_SOCKET
1282 GV *gv;
1283 register IO *io;
1284 int protocol = POPi;
1285 int type = POPi;
1286 int domain = POPi;
1287 int fd;
1288
1289 gv = (GV*)POPs;
1290
1291 if (!gv) {
748a9306 1292 SETERRNO(EBADF,LIB$_INVARG);
a0d0e21e
LW		 1293 RETPUSHUNDEF;
1294 }
1295
1296 io = GvIOn(gv);
1297 if (IoIFP(io))
1298 do_close(gv, FALSE);
1299
1300 TAINT_PROPER("socket");
1301 fd = socket(domain, type, protocol);
1302 if (fd < 0)
1303 RETPUSHUNDEF;
1304 IoIFP(io) = fdopen(fd, "r"); /* stdio gets confused about sockets */
1305 IoOFP(io) = fdopen(fd, "w");
1306 IoTYPE(io) = 's';
1307 if (!IoIFP(io) || !IoOFP(io)) {
1308 if (IoIFP(io)) fclose(IoIFP(io));
1309 if (IoOFP(io)) fclose(IoOFP(io));
1310 if (!IoIFP(io) && !IoOFP(io)) close(fd);
1311 RETPUSHUNDEF;
1312 }
1313
1314 RETPUSHYES;
1315#else
1316 DIE(no_sock_func, "socket");
1317#endif
1318}
1319
1320PP(pp_sockpair)
1321{
1322 dSP;
1323#ifdef HAS_SOCKETPAIR
1324 GV *gv1;
1325 GV *gv2;
1326 register IO *io1;
1327 register IO *io2;
1328 int protocol = POPi;
1329 int type = POPi;
1330 int domain = POPi;
1331 int fd[2];
1332
1333 gv2 = (GV*)POPs;
1334 gv1 = (GV*)POPs;
1335 if (!gv1 || !gv2)
1336 RETPUSHUNDEF;
1337
1338 io1 = GvIOn(gv1);
1339 io2 = GvIOn(gv2);
1340 if (IoIFP(io1))
1341 do_close(gv1, FALSE);
1342 if (IoIFP(io2))
1343 do_close(gv2, FALSE);
1344
1345 TAINT_PROPER("socketpair");
1346 if (socketpair(domain, type, protocol, fd) < 0)
1347 RETPUSHUNDEF;
1348 IoIFP(io1) = fdopen(fd[0], "r");
1349 IoOFP(io1) = fdopen(fd[0], "w");
1350 IoTYPE(io1) = 's';
1351 IoIFP(io2) = fdopen(fd[1], "r");
1352 IoOFP(io2) = fdopen(fd[1], "w");
1353 IoTYPE(io2) = 's';
1354 if (!IoIFP(io1) || !IoOFP(io1) || !IoIFP(io2) || !IoOFP(io2)) {
1355 if (IoIFP(io1)) fclose(IoIFP(io1));
1356 if (IoOFP(io1)) fclose(IoOFP(io1));
1357 if (!IoIFP(io1) && !IoOFP(io1)) close(fd[0]);
1358 if (IoIFP(io2)) fclose(IoIFP(io2));
1359 if (IoOFP(io2)) fclose(IoOFP(io2));
1360 if (!IoIFP(io2) && !IoOFP(io2)) close(fd[1]);
1361 RETPUSHUNDEF;
1362 }
1363
1364 RETPUSHYES;
1365#else
1366 DIE(no_sock_func, "socketpair");
1367#endif
1368}
1369
1370PP(pp_bind)
1371{
1372 dSP;
1373#ifdef HAS_SOCKET
748a9306 1374 SV *addrsv = POPs;
a0d0e21e
LW		 1375 char *addr;
1376 GV *gv = (GV*)POPs;
1377 register IO *io = GvIOn(gv);
1378 STRLEN len;
1379
1380 if (!io || !IoIFP(io))
1381 goto nuts;
1382
748a9306 1383 addr = SvPV(addrsv, len);
a0d0e21e
LW		 1384 TAINT_PROPER("bind");
1385 if (bind(fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
1386 RETPUSHYES;
1387 else
1388 RETPUSHUNDEF;
1389
1390nuts:
1391 if (dowarn)
1392 warn("bind() on closed fd");
748a9306 1393 SETERRNO(EBADF,SS$_IVCHAN);
a0d0e21e
LW		 1394 RETPUSHUNDEF;
1395#else
1396 DIE(no_sock_func, "bind");
1397#endif
1398}
1399
1400PP(pp_connect)
1401{
1402 dSP;
1403#ifdef HAS_SOCKET
748a9306 1404 SV *addrsv = POPs;
a0d0e21e
LW		 1405 char *addr;
1406 GV *gv = (GV*)POPs;
1407 register IO *io = GvIOn(gv);
1408 STRLEN len;
1409
1410 if (!io || !IoIFP(io))
1411 goto nuts;
1412
748a9306 1413 addr = SvPV(addrsv, len);
a0d0e21e
LW		 1414 TAINT_PROPER("connect");
1415 if (connect(fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
1416 RETPUSHYES;
1417 else
1418 RETPUSHUNDEF;
1419
1420nuts:
1421 if (dowarn)
1422 warn("connect() on closed fd");
748a9306 1423 SETERRNO(EBADF,SS$_IVCHAN);
a0d0e21e
LW		 1424 RETPUSHUNDEF;
1425#else
1426 DIE(no_sock_func, "connect");
1427#endif
1428}
1429
1430PP(pp_listen)
1431{
1432 dSP;
1433#ifdef HAS_SOCKET
1434 int backlog = POPi;
1435 GV *gv = (GV*)POPs;
1436 register IO *io = GvIOn(gv);
1437
1438 if (!io || !IoIFP(io))
1439 goto nuts;
1440
1441 if (listen(fileno(IoIFP(io)), backlog) >= 0)
1442 RETPUSHYES;
1443 else
1444 RETPUSHUNDEF;
1445
1446nuts:
1447 if (dowarn)
1448 warn("listen() on closed fd");
748a9306 1449 SETERRNO(EBADF,SS$_IVCHAN);
a0d0e21e
LW		 1450 RETPUSHUNDEF;
1451#else
1452 DIE(no_sock_func, "listen");
1453#endif
1454}
1455
1456PP(pp_accept)
1457{
748a9306 1458 struct sockaddr_in saddr; /* use a struct to avoid alignment problems */
a0d0e21e
LW		 1459 dSP; dTARGET;
1460#ifdef HAS_SOCKET
1461 GV *ngv;
1462 GV *ggv;
1463 register IO *nstio;
1464 register IO *gstio;
748a9306 1465 int len = sizeof saddr;
a0d0e21e
LW		 1466 int fd;
1467
1468 ggv = (GV*)POPs;
1469 ngv = (GV*)POPs;
1470
1471 if (!ngv)
1472 goto badexit;
1473 if (!ggv)
1474 goto nuts;
1475
1476 gstio = GvIO(ggv);
1477 if (!gstio || !IoIFP(gstio))
1478 goto nuts;
1479
1480 nstio = GvIOn(ngv);
1481 if (IoIFP(nstio))
1482 do_close(ngv, FALSE);
1483
748a9306 1484 fd = accept(fileno(IoIFP(gstio)), (struct sockaddr *)&saddr, &len);
a0d0e21e
LW		 1485 if (fd < 0)
1486 goto badexit;
1487 IoIFP(nstio) = fdopen(fd, "r");
1488 IoOFP(nstio) = fdopen(fd, "w");
1489 IoTYPE(nstio) = 's';
1490 if (!IoIFP(nstio) || !IoOFP(nstio)) {
1491 if (IoIFP(nstio)) fclose(IoIFP(nstio));
1492 if (IoOFP(nstio)) fclose(IoOFP(nstio));
1493 if (!IoIFP(nstio) && !IoOFP(nstio)) close(fd);
1494 goto badexit;
1495 }
1496
748a9306 1497 PUSHp((char *)&saddr, len);
a0d0e21e
LW		 1498 RETURN;
1499
1500nuts:
1501 if (dowarn)
1502 warn("accept() on closed fd");
748a9306 1503 SETERRNO(EBADF,SS$_IVCHAN);
a0d0e21e
LW		 1504
1505badexit:
1506 RETPUSHUNDEF;
1507
1508#else
1509 DIE(no_sock_func, "accept");
1510#endif
1511}
1512
1513PP(pp_shutdown)
1514{
1515 dSP; dTARGET;
1516#ifdef HAS_SOCKET
1517 int how = POPi;
1518 GV *gv = (GV*)POPs;
1519 register IO *io = GvIOn(gv);
1520
1521 if (!io || !IoIFP(io))
1522 goto nuts;
1523
1524 PUSHi( shutdown(fileno(IoIFP(io)), how) >= 0 );
1525 RETURN;
1526
1527nuts:
1528 if (dowarn)
1529 warn("shutdown() on closed fd");
748a9306 1530 SETERRNO(EBADF,SS$_IVCHAN);
a0d0e21e
LW		 1531 RETPUSHUNDEF;
1532#else
1533 DIE(no_sock_func, "shutdown");
1534#endif
1535}
1536
1537PP(pp_gsockopt)
1538{
1539#ifdef HAS_SOCKET
1540 return pp_ssockopt(ARGS);
1541#else
1542 DIE(no_sock_func, "getsockopt");
1543#endif
1544}
1545
1546PP(pp_ssockopt)
1547{
1548 dSP;
1549#ifdef HAS_SOCKET
1550 int optype = op->op_type;
1551 SV *sv;
1552 int fd;
1553 unsigned int optname;
1554 unsigned int lvl;
1555 GV *gv;
1556 register IO *io;
748a9306 1557 int aint;
a0d0e21e
LW		 1558
1559 if (optype == OP_GSOCKOPT)
1560 sv = sv_2mortal(NEWSV(22, 257));
1561 else
1562 sv = POPs;
1563 optname = (unsigned int) POPi;
1564 lvl = (unsigned int) POPi;
1565
1566 gv = (GV*)POPs;
1567 io = GvIOn(gv);
1568 if (!io || !IoIFP(io))
1569 goto nuts;
1570
1571 fd = fileno(IoIFP(io));
1572 switch (optype) {
1573 case OP_GSOCKOPT:
748a9306 1574 SvGROW(sv, 257);
a0d0e21e 1575 (void)SvPOK_only(sv);
748a9306
LW		 1576 SvCUR_set(sv,256);
1577 *SvEND(sv) ='\0';
1578 aint = SvCUR(sv);
1579 if (getsockopt(fd, lvl, optname, SvPVX(sv), &aint) < 0)
a0d0e21e 1580 goto nuts2;
748a9306
LW		 1581 SvCUR_set(sv,aint);
1582 *SvEND(sv) ='\0';
a0d0e21e
LW		 1583 PUSHs(sv);
1584 break;
1585 case OP_SSOCKOPT: {
a0d0e21e
LW		 1586 STRLEN len = 0;
1587 char *buf = 0;
1588 if (SvPOKp(sv))
1589 buf = SvPV(sv, len);
1590 else if (SvOK(sv)) {
1591 aint = (int)SvIV(sv);
1592 buf = (char*)&aint;
1593 len = sizeof(int);
1594 }
1595 if (setsockopt(fd, lvl, optname, buf, (int)len) < 0)
1596 goto nuts2;
1597 PUSHs(&sv_yes);
1598 }
1599 break;
1600 }
1601 RETURN;
1602
1603nuts:
1604 if (dowarn)
1605 warn("[gs]etsockopt() on closed fd");
748a9306 1606 SETERRNO(EBADF,SS$_IVCHAN);
a0d0e21e
LW		 1607nuts2:
1608 RETPUSHUNDEF;
1609
1610#else
1611 DIE(no_sock_func, "setsockopt");
1612#endif
1613}
1614
1615PP(pp_getsockname)
1616{
1617#ifdef HAS_SOCKET
1618 return pp_getpeername(ARGS);
1619#else
1620 DIE(no_sock_func, "getsockname");
1621#endif
1622}
1623
1624PP(pp_getpeername)
1625{
1626 dSP;
1627#ifdef HAS_SOCKET
1628 int optype = op->op_type;
1629 SV *sv;
1630 int fd;
1631 GV *gv = (GV*)POPs;
1632 register IO *io = GvIOn(gv);
748a9306 1633 int aint;
a0d0e21e
LW		 1634
1635 if (!io || !IoIFP(io))
1636 goto nuts;
1637
1638 sv = sv_2mortal(NEWSV(22, 257));
748a9306
LW		 1639 (void)SvPOK_only(sv);
1640 SvCUR_set(sv,256);
1641 *SvEND(sv) ='\0';
1642 aint = SvCUR(sv);
a0d0e21e
LW		 1643 fd = fileno(IoIFP(io));
1644 switch (optype) {
1645 case OP_GETSOCKNAME:
748a9306 1646 if (getsockname(fd, (struct sockaddr *)SvPVX(sv), &aint) < 0)
a0d0e21e
LW		 1647 goto nuts2;
1648 break;
1649 case OP_GETPEERNAME:
748a9306 1650 if (getpeername(fd, (struct sockaddr *)SvPVX(sv), &aint) < 0)
a0d0e21e
LW		 1651 goto nuts2;
1652 break;
1653 }
748a9306
LW		 1654 SvCUR_set(sv,aint);
1655 *SvEND(sv) ='\0';
a0d0e21e
LW		 1656 PUSHs(sv);
1657 RETURN;
1658
1659nuts:
1660 if (dowarn)
1661 warn("get{sock, peer}name() on closed fd");
748a9306 1662 SETERRNO(EBADF,SS$_IVCHAN);
a0d0e21e
LW		 1663nuts2:
1664 RETPUSHUNDEF;
1665
1666#else
1667 DIE(no_sock_func, "getpeername");
1668#endif
1669}
1670
1671/* Stat calls. */
1672
1673PP(pp_lstat)
1674{
1675 return pp_stat(ARGS);
1676}
1677
1678PP(pp_stat)
1679{
1680 dSP;
1681 GV *tmpgv;
1682 I32 max = 13;
1683
1684 if (op->op_flags & OPf_REF) {
1685 tmpgv = cGVOP->op_gv;
748a9306 1686 do_fstat:
a0d0e21e
LW		 1687 if (tmpgv != defgv) {
1688 laststype = OP_STAT;
1689 statgv = tmpgv;
1690 sv_setpv(statname, "");
1691 if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
1692 Fstat(fileno(IoIFP(GvIOn(tmpgv))), &statcache) < 0) {
1693 max = 0;
1694 laststatval = -1;
1695 }
1696 }
1697 else if (laststatval < 0)
1698 max = 0;
1699 }
1700 else {
748a9306
LW		 1701 SV* sv = POPs;
1702 if (SvTYPE(sv) == SVt_PVGV) {
1703 tmpgv = (GV*)sv;
1704 goto do_fstat;
1705 }
1706 else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
1707 tmpgv = (GV*)SvRV(sv);
1708 goto do_fstat;
1709 }
1710 sv_setpv(statname, SvPV(sv,na));
a0d0e21e
LW		 1711 statgv = Nullgv;
1712#ifdef HAS_LSTAT
1713 laststype = op->op_type;
1714 if (op->op_type == OP_LSTAT)
1715 laststatval = lstat(SvPV(statname, na), &statcache);
1716 else
1717#endif
1718 laststatval = Stat(SvPV(statname, na), &statcache);
1719 if (laststatval < 0) {
1720 if (dowarn && strchr(SvPV(statname, na), '\n'))
1721 warn(warn_nl, "stat");
1722 max = 0;
1723 }
1724 }
1725
1726 EXTEND(SP, 13);
1727 if (GIMME != G_ARRAY) {
1728 if (max)
1729 RETPUSHYES;
1730 else
1731 RETPUSHUNDEF;
1732 }
1733 if (max) {
1734 PUSHs(sv_2mortal(newSViv((I32)statcache.st_dev)));
1735 PUSHs(sv_2mortal(newSViv((I32)statcache.st_ino)));
1736 PUSHs(sv_2mortal(newSViv((I32)statcache.st_mode)));
1737 PUSHs(sv_2mortal(newSViv((I32)statcache.st_nlink)));
1738 PUSHs(sv_2mortal(newSViv((I32)statcache.st_uid)));
1739 PUSHs(sv_2mortal(newSViv((I32)statcache.st_gid)));
1740 PUSHs(sv_2mortal(newSViv((I32)statcache.st_rdev)));
1741 PUSHs(sv_2mortal(newSViv((I32)statcache.st_size)));
1742 PUSHs(sv_2mortal(newSViv((I32)statcache.st_atime)));
1743 PUSHs(sv_2mortal(newSViv((I32)statcache.st_mtime)));
1744 PUSHs(sv_2mortal(newSViv((I32)statcache.st_ctime)));
1745#ifdef USE_STAT_BLOCKS
1746 PUSHs(sv_2mortal(newSViv((I32)statcache.st_blksize)));
1747 PUSHs(sv_2mortal(newSViv((I32)statcache.st_blocks)));
1748#else
1749 PUSHs(sv_2mortal(newSVpv("", 0)));
1750 PUSHs(sv_2mortal(newSVpv("", 0)));
1751#endif
1752 }
1753 RETURN;
1754}
1755
1756PP(pp_ftrread)
1757{
1758 I32 result = my_stat(ARGS);
1759 dSP;
1760 if (result < 0)
1761 RETPUSHUNDEF;
1762 if (cando(S_IRUSR, 0, &statcache))
1763 RETPUSHYES;
1764 RETPUSHNO;
1765}
1766
1767PP(pp_ftrwrite)
1768{
1769 I32 result = my_stat(ARGS);
1770 dSP;
1771 if (result < 0)
1772 RETPUSHUNDEF;
1773 if (cando(S_IWUSR, 0, &statcache))
1774 RETPUSHYES;
1775 RETPUSHNO;
1776}
1777
1778PP(pp_ftrexec)
1779{
1780 I32 result = my_stat(ARGS);
1781 dSP;
1782 if (result < 0)
1783 RETPUSHUNDEF;
1784 if (cando(S_IXUSR, 0, &statcache))
1785 RETPUSHYES;
1786 RETPUSHNO;
1787}
1788
1789PP(pp_fteread)
1790{
1791 I32 result = my_stat(ARGS);
1792 dSP;
1793 if (result < 0)
1794 RETPUSHUNDEF;
1795 if (cando(S_IRUSR, 1, &statcache))
1796 RETPUSHYES;
1797 RETPUSHNO;
1798}
1799
1800PP(pp_ftewrite)
1801{
1802 I32 result = my_stat(ARGS);
1803 dSP;
1804 if (result < 0)
1805 RETPUSHUNDEF;
1806 if (cando(S_IWUSR, 1, &statcache))
1807 RETPUSHYES;
1808 RETPUSHNO;
1809}
1810
1811PP(pp_fteexec)
1812{
1813 I32 result = my_stat(ARGS);
1814 dSP;
1815 if (result < 0)
1816 RETPUSHUNDEF;
1817 if (cando(S_IXUSR, 1, &statcache))
1818 RETPUSHYES;
1819 RETPUSHNO;
1820}
1821
1822PP(pp_ftis)
1823{
1824 I32 result = my_stat(ARGS);
1825 dSP;
1826 if (result < 0)
1827 RETPUSHUNDEF;
1828 RETPUSHYES;
1829}
1830
1831PP(pp_fteowned)
1832{
1833 return pp_ftrowned(ARGS);
1834}
1835
1836PP(pp_ftrowned)
1837{
1838 I32 result = my_stat(ARGS);
1839 dSP;
1840 if (result < 0)
1841 RETPUSHUNDEF;
1842 if (statcache.st_uid == (op->op_type == OP_FTEOWNED ? euid : uid) )
1843 RETPUSHYES;
1844 RETPUSHNO;
1845}
1846
1847PP(pp_ftzero)
1848{
1849 I32 result = my_stat(ARGS);
1850 dSP;
1851 if (result < 0)
1852 RETPUSHUNDEF;
1853 if (!statcache.st_size)
1854 RETPUSHYES;
1855 RETPUSHNO;
1856}
1857
1858PP(pp_ftsize)
1859{
1860 I32 result = my_stat(ARGS);
1861 dSP; dTARGET;
1862 if (result < 0)
1863 RETPUSHUNDEF;
1864 PUSHi(statcache.st_size);
1865 RETURN;
1866}
1867
1868PP(pp_ftmtime)
1869{
1870 I32 result = my_stat(ARGS);
1871 dSP; dTARGET;
1872 if (result < 0)
1873 RETPUSHUNDEF;
1874 PUSHn( (basetime - statcache.st_mtime) / 86400.0 );
1875 RETURN;
1876}
1877
1878PP(pp_ftatime)
1879{
1880 I32 result = my_stat(ARGS);
1881 dSP; dTARGET;
1882 if (result < 0)
1883 RETPUSHUNDEF;
1884 PUSHn( (basetime - statcache.st_atime) / 86400.0 );
1885 RETURN;
1886}
1887
1888PP(pp_ftctime)
1889{
1890 I32 result = my_stat(ARGS);
1891 dSP; dTARGET;
1892 if (result < 0)
1893 RETPUSHUNDEF;
1894 PUSHn( (basetime - statcache.st_ctime) / 86400.0 );
1895 RETURN;
1896}
1897
1898PP(pp_ftsock)
1899{
1900 I32 result = my_stat(ARGS);
1901 dSP;
1902 if (result < 0)
1903 RETPUSHUNDEF;
1904 if (S_ISSOCK(statcache.st_mode))
1905 RETPUSHYES;
1906 RETPUSHNO;
1907}
1908
1909PP(pp_ftchr)
1910{
1911 I32 result = my_stat(ARGS);
1912 dSP;
1913 if (result < 0)
1914 RETPUSHUNDEF;
1915 if (S_ISCHR(statcache.st_mode))
1916 RETPUSHYES;
1917 RETPUSHNO;
1918}
1919
1920PP(pp_ftblk)
1921{
1922 I32 result = my_stat(ARGS);
1923 dSP;
1924 if (result < 0)
1925 RETPUSHUNDEF;
1926 if (S_ISBLK(statcache.st_mode))
1927 RETPUSHYES;
1928 RETPUSHNO;
1929}
1930
1931PP(pp_ftfile)
1932{
1933 I32 result = my_stat(ARGS);
1934 dSP;
1935 if (result < 0)
1936 RETPUSHUNDEF;
1937 if (S_ISREG(statcache.st_mode))
1938 RETPUSHYES;
1939 RETPUSHNO;
1940}
1941
1942PP(pp_ftdir)
1943{
1944 I32 result = my_stat(ARGS);
1945 dSP;
1946 if (result < 0)
1947 RETPUSHUNDEF;
1948 if (S_ISDIR(statcache.st_mode))
1949 RETPUSHYES;
1950 RETPUSHNO;
1951}
1952
1953PP(pp_ftpipe)
1954{
1955 I32 result = my_stat(ARGS);
1956 dSP;
1957 if (result < 0)
1958 RETPUSHUNDEF;
1959 if (S_ISFIFO(statcache.st_mode))
1960 RETPUSHYES;
1961 RETPUSHNO;
1962}
1963
1964PP(pp_ftlink)
1965{
1966 I32 result = my_lstat(ARGS);
1967 dSP;
1968 if (result < 0)
1969 RETPUSHUNDEF;
1970 if (S_ISLNK(statcache.st_mode))
1971 RETPUSHYES;
1972 RETPUSHNO;
1973}
1974
1975PP(pp_ftsuid)
1976{
1977 dSP;
1978#ifdef S_ISUID
1979 I32 result = my_stat(ARGS);
1980 SPAGAIN;
1981 if (result < 0)
1982 RETPUSHUNDEF;
1983 if (statcache.st_mode & S_ISUID)
1984 RETPUSHYES;
1985#endif
1986 RETPUSHNO;
1987}
1988
1989PP(pp_ftsgid)
1990{
1991 dSP;
1992#ifdef S_ISGID
1993 I32 result = my_stat(ARGS);
1994 SPAGAIN;
1995 if (result < 0)
1996 RETPUSHUNDEF;
1997 if (statcache.st_mode & S_ISGID)
1998 RETPUSHYES;
1999#endif
2000 RETPUSHNO;
2001}
2002
2003PP(pp_ftsvtx)
2004{
2005 dSP;
2006#ifdef S_ISVTX
2007 I32 result = my_stat(ARGS);
2008 SPAGAIN;
2009 if (result < 0)
2010 RETPUSHUNDEF;
2011 if (statcache.st_mode & S_ISVTX)
2012 RETPUSHYES;
2013#endif
2014 RETPUSHNO;
2015}
2016
2017PP(pp_fttty)
2018{
2019 dSP;
2020 int fd;
2021 GV *gv;
2022 char *tmps;
2023 if (op->op_flags & OPf_REF) {
2024 gv = cGVOP->op_gv;
2025 tmps = "";
2026 }
2027 else
2028 gv = gv_fetchpv(tmps = POPp, FALSE, SVt_PVIO);
2029 if (GvIO(gv) && IoIFP(GvIOp(gv)))
2030 fd = fileno(IoIFP(GvIOp(gv)));
2031 else if (isDIGIT(*tmps))
2032 fd = atoi(tmps);
2033 else
2034 RETPUSHUNDEF;
2035 if (isatty(fd))
2036 RETPUSHYES;
2037 RETPUSHNO;
2038}
2039
16d20bd9
AD		 2040#if defined(atarist) /* this will work with atariST. Configure will
2041 make guesses for other systems. */
2042# define FILE_base(f) ((f)->_base)
2043# define FILE_ptr(f) ((f)->_ptr)
2044# define FILE_cnt(f) ((f)->_cnt)
2045# define FILE_bufsiz(f) ((f)->_cnt + ((f)->_ptr - (f)->_base))
a0d0e21e
LW		 2046#endif
2047
2048PP(pp_fttext)
2049{
2050 dSP;
2051 I32 i;
2052 I32 len;
2053 I32 odd = 0;
2054 STDCHAR tbuf[512];
2055 register STDCHAR *s;
2056 register IO *io;
2057 SV *sv;
2058
2059 if (op->op_flags & OPf_REF) {
2060 EXTEND(SP, 1);
2061 if (cGVOP->op_gv == defgv) {
2062 if (statgv)
2063 io = GvIO(statgv);
2064 else {
2065 sv = statname;
2066 goto really_filename;
2067 }
2068 }
2069 else {
2070 statgv = cGVOP->op_gv;
2071 sv_setpv(statname, "");
2072 io = GvIO(statgv);
2073 }
2074 if (io && IoIFP(io)) {
16d20bd9 2075#ifdef FILE_base
a0d0e21e
LW		 2076 Fstat(fileno(IoIFP(io)), &statcache);
2077 if (S_ISDIR(statcache.st_mode)) /* handle NFS glitch */
2078 if (op->op_type == OP_FTTEXT)
2079 RETPUSHNO;
2080 else
2081 RETPUSHYES;
16d20bd9 2082 if (FILE_cnt(IoIFP(io)) <= 0) {
a0d0e21e
LW		 2083 i = getc(IoIFP(io));
2084 if (i != EOF)
2085 (void)ungetc(i, IoIFP(io));
2086 }
16d20bd9 2087 if (FILE_cnt(IoIFP(io)) <= 0) /* null file is anything */
a0d0e21e 2088 RETPUSHYES;
16d20bd9
AD		 2089 len = FILE_bufsiz(IoIFP(io));
2090 s = FILE_base(IoIFP(io));
a0d0e21e
LW		 2091#else
2092 DIE("-T and -B not implemented on filehandles");
2093#endif
2094 }
2095 else {
2096 if (dowarn)
2097 warn("Test on unopened file <%s>",
2098 GvENAME(cGVOP->op_gv));
748a9306 2099 SETERRNO(EBADF,RMS$_IFI);
a0d0e21e
LW		 2100 RETPUSHUNDEF;
2101 }
2102 }
2103 else {
2104 sv = POPs;
2105 statgv = Nullgv;
2106 sv_setpv(statname, SvPV(sv, na));
2107 really_filename:
2108#ifdef HAS_OPEN3
2109 i = open(SvPV(sv, na), O_RDONLY, 0);
2110#else
2111 i = open(SvPV(sv, na), 0);
2112#endif
2113 if (i < 0) {
2114 if (dowarn && strchr(SvPV(sv, na), '\n'))
2115 warn(warn_nl, "open");
2116 RETPUSHUNDEF;
2117 }
2118 Fstat(i, &statcache);
2119 len = read(i, tbuf, 512);
2120 (void)close(i);
2121 if (len <= 0) {
2122 if (S_ISDIR(statcache.st_mode) && op->op_type == OP_FTTEXT)
2123 RETPUSHNO; /* special case NFS directories */
2124 RETPUSHYES; /* null file is anything */
2125 }
2126 s = tbuf;
2127 }
2128
2129 /* now scan s to look for textiness */
2130
2131 for (i = 0; i < len; i++, s++) {
2132 if (!*s) { /* null never allowed in text */
2133 odd += len;
2134 break;
2135 }
2136 else if (*s & 128)
2137 odd++;
2138 else if (*s < 32 &&
2139 *s != '\n' && *s != '\r' && *s != '\b' &&
2140 *s != '\t' && *s != '\f' && *s != 27)
2141 odd++;
2142 }
2143
2144 if ((odd * 30 > len) == (op->op_type == OP_FTTEXT)) /* allow 30% odd */
2145 RETPUSHNO;
2146 else
2147 RETPUSHYES;
2148}
2149
2150PP(pp_ftbinary)
2151{
2152 return pp_fttext(ARGS);
2153}
2154
2155/* File calls. */
2156
2157PP(pp_chdir)
2158{
2159 dSP; dTARGET;
2160 char *tmps;
2161 SV **svp;
2162
2163 if (MAXARG < 1)
2164 tmps = Nullch;
2165 else
2166 tmps = POPp;
2167 if (!tmps || !*tmps) {
2168 svp = hv_fetch(GvHVn(envgv), "HOME", 4, FALSE);
2169 if (svp)
2170 tmps = SvPV(*svp, na);
2171 }
2172 if (!tmps || !*tmps) {
2173 svp = hv_fetch(GvHVn(envgv), "LOGDIR", 6, FALSE);
2174 if (svp)
2175 tmps = SvPV(*svp, na);
2176 }
2177 TAINT_PROPER("chdir");
2178 PUSHi( chdir(tmps) >= 0 );
748a9306
LW		 2179#ifdef VMS
2180 /* Clear the DEFAULT element of ENV so we'll get the new value
2181 * in the future. */
2182 hv_delete(GvHVn(envgv),"DEFAULT",7);
2183#endif
a0d0e21e
LW		 2184 RETURN;
2185}
2186
2187PP(pp_chown)
2188{
2189 dSP; dMARK; dTARGET;
2190 I32 value;
2191#ifdef HAS_CHOWN
2192 value = (I32)apply(op->op_type, MARK, SP);
2193 SP = MARK;
2194 PUSHi(value);
2195 RETURN;
2196#else
2197 DIE(no_func, "Unsupported function chown");
2198#endif
2199}
2200
2201PP(pp_chroot)
2202{
2203 dSP; dTARGET;
2204 char *tmps;
2205#ifdef HAS_CHROOT
2206 tmps = POPp;
2207 TAINT_PROPER("chroot");
2208 PUSHi( chroot(tmps) >= 0 );
2209 RETURN;
2210#else
2211 DIE(no_func, "chroot");
2212#endif
2213}
2214
2215PP(pp_unlink)
2216{
2217 dSP; dMARK; dTARGET;
2218 I32 value;
2219 value = (I32)apply(op->op_type, MARK, SP);
2220 SP = MARK;
2221 PUSHi(value);
2222 RETURN;
2223}
2224
2225PP(pp_chmod)
2226{
2227 dSP; dMARK; dTARGET;
2228 I32 value;
2229 value = (I32)apply(op->op_type, MARK, SP);
2230 SP = MARK;
2231 PUSHi(value);
2232 RETURN;
2233}
2234
2235PP(pp_utime)
2236{
2237 dSP; dMARK; dTARGET;
2238 I32 value;
2239 value = (I32)apply(op->op_type, MARK, SP);
2240 SP = MARK;
2241 PUSHi(value);
2242 RETURN;
2243}
2244
2245PP(pp_rename)
2246{
2247 dSP; dTARGET;
2248 int anum;
2249
2250 char *tmps2 = POPp;
2251 char *tmps = SvPV(TOPs, na);
2252 TAINT_PROPER("rename");
2253#ifdef HAS_RENAME
2254 anum = rename(tmps, tmps2);
2255#else
2256 if (same_dirent(tmps2, tmps)) /* can always rename to same name */
2257 anum = 1;
2258 else {
2259 if (euid || Stat(tmps2, &statbuf) < 0 || !S_ISDIR(statbuf.st_mode))
2260 (void)UNLINK(tmps2);
2261 if (!(anum = link(tmps, tmps2)))
2262 anum = UNLINK(tmps);
2263 }
2264#endif
2265 SETi( anum >= 0 );
2266 RETURN;
2267}
2268
2269PP(pp_link)
2270{
2271 dSP; dTARGET;
2272#ifdef HAS_LINK
2273 char *tmps2 = POPp;
2274 char *tmps = SvPV(TOPs, na);
2275 TAINT_PROPER("link");
2276 SETi( link(tmps, tmps2) >= 0 );
2277#else
2278 DIE(no_func, "Unsupported function link");
2279#endif
2280 RETURN;
2281}
2282
2283PP(pp_symlink)
2284{
2285 dSP; dTARGET;
2286#ifdef HAS_SYMLINK
2287 char *tmps2 = POPp;
2288 char *tmps = SvPV(TOPs, na);
2289 TAINT_PROPER("symlink");
2290 SETi( symlink(tmps, tmps2) >= 0 );
2291 RETURN;
2292#else
2293 DIE(no_func, "symlink");
2294#endif
2295}
2296
2297PP(pp_readlink)
2298{
2299 dSP; dTARGET;
2300#ifdef HAS_SYMLINK
2301 char *tmps;
2302 int len;
2303 tmps = POPp;
2304 len = readlink(tmps, buf, sizeof buf);
2305 EXTEND(SP, 1);
2306 if (len < 0)
2307 RETPUSHUNDEF;
2308 PUSHp(buf, len);
2309 RETURN;
2310#else
2311 EXTEND(SP, 1);
2312 RETSETUNDEF; /* just pretend it's a normal file */
2313#endif
2314}
2315
2316#if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
2317static int
2318dooneliner(cmd, filename)
2319char *cmd;
2320char *filename;
2321{
2322 char mybuf[8192];
16d20bd9 2323 char *s,
5d94fbed 2324 *save_filename = filename;
a0d0e21e
LW		 2325 int anum = 1;
2326 FILE *myfp;
2327
2328 strcpy(mybuf, cmd);
2329 strcat(mybuf, " ");
2330 for (s = mybuf+strlen(mybuf); *filename; ) {
2331 *s++ = '\\';
2332 *s++ = *filename++;
2333 }
2334 strcpy(s, " 2>&1");
2335 myfp = my_popen(mybuf, "r");
2336 if (myfp) {
2337 *mybuf = '\0';
2338 s = fgets(mybuf, sizeof mybuf, myfp);
2339 (void)my_pclose(myfp);
2340 if (s != Nullch) {
2341 for (errno = 1; errno < sys_nerr; errno++) {
2342#ifdef HAS_SYS_ERRLIST
2343 if (instr(mybuf, sys_errlist[errno])) /* you don't see this */
2344 return 0;
2345#else
2346 char *errmsg; /* especially if it isn't there */
2347
2348 if (instr(mybuf,
2349 (errmsg = strerror(errno)) ? errmsg : "NoErRoR"))
2350 return 0;
2351#endif
2352 }
748a9306 2353 SETERRNO(0,0);
a0d0e21e
LW		 2354#ifndef EACCES
2355#define EACCES EPERM
2356#endif
2357 if (instr(mybuf, "cannot make"))
748a9306 2358 SETERRNO(EEXIST,RMS$_FEX);
a0d0e21e 2359 else if (instr(mybuf, "existing file"))
748a9306 2360 SETERRNO(EEXIST,RMS$_FEX);
a0d0e21e 2361 else if (instr(mybuf, "ile exists"))
748a9306 2362 SETERRNO(EEXIST,RMS$_FEX);
a0d0e21e 2363 else if (instr(mybuf, "non-exist"))
748a9306 2364 SETERRNO(ENOENT,RMS$_FNF);
a0d0e21e 2365 else if (instr(mybuf, "does not exist"))
748a9306 2366 SETERRNO(ENOENT,RMS$_FNF);
a0d0e21e 2367 else if (instr(mybuf, "not empty"))
748a9306 2368 SETERRNO(EBUSY,SS$_DEVOFFLINE);
a0d0e21e 2369 else if (instr(mybuf, "cannot access"))
748a9306 2370 SETERRNO(EACCES,RMS$_PRV);
a0d0e21e 2371 else
748a9306 2372 SETERRNO(EPERM,RMS$_PRV);
a0d0e21e
LW		 2373 return 0;
2374 }
2375 else { /* some mkdirs return no failure indication */
5d94fbed 2376 anum = (Stat(save_filename, &statbuf) >= 0);
a0d0e21e
LW		 2377 if (op->op_type == OP_RMDIR)
2378 anum = !anum;
2379 if (anum)
748a9306 2380 SETERRNO(0,0);
a0d0e21e 2381 else
748a9306 2382 SETERRNO(EACCES,RMS$_PRV); /* a guess */
a0d0e21e
LW		 2383 }
2384 return anum;
2385 }
2386 else
2387 return 0;
2388}
2389#endif
2390
2391PP(pp_mkdir)
2392{
2393 dSP; dTARGET;
2394 int mode = POPi;
2395#ifndef HAS_MKDIR
2396 int oldumask;
2397#endif
2398 char *tmps = SvPV(TOPs, na);
2399
2400 TAINT_PROPER("mkdir");
2401#ifdef HAS_MKDIR
2402 SETi( mkdir(tmps, mode) >= 0 );
2403#else
2404 SETi( dooneliner("mkdir", tmps) );
2405 oldumask = umask(0);
2406 umask(oldumask);
2407 chmod(tmps, (mode & ~oldumask) & 0777);
2408#endif
2409 RETURN;
2410}
2411
2412PP(pp_rmdir)
2413{
2414 dSP; dTARGET;
2415 char *tmps;
2416
2417 tmps = POPp;
2418 TAINT_PROPER("rmdir");
2419#ifdef HAS_RMDIR
2420 XPUSHi( rmdir(tmps) >= 0 );
2421#else
2422 XPUSHi( dooneliner("rmdir", tmps) );
2423#endif
2424 RETURN;
2425}
2426
2427/* Directory calls. */
2428
2429PP(pp_open_dir)
2430{
2431 dSP;
2432#if defined(Direntry_t) && defined(HAS_READDIR)
2433 char *dirname = POPp;
2434 GV *gv = (GV*)POPs;
2435 register IO *io = GvIOn(gv);
2436
2437 if (!io)
2438 goto nope;
2439
2440 if (IoDIRP(io))
2441 closedir(IoDIRP(io));
2442 if (!(IoDIRP(io) = opendir(dirname)))
2443 goto nope;
2444
2445 RETPUSHYES;
2446nope:
2447 if (!errno)
748a9306 2448 SETERRNO(EBADF,RMS$_DIR);
a0d0e21e
LW		 2449 RETPUSHUNDEF;
2450#else
2451 DIE(no_dir_func, "opendir");
2452#endif
2453}
2454
2455PP(pp_readdir)
2456{
2457 dSP;
2458#if defined(Direntry_t) && defined(HAS_READDIR)
2459#ifndef I_DIRENT
2460 Direntry_t *readdir _((DIR *));
2461#endif
2462 register Direntry_t *dp;
2463 GV *gv = (GV*)POPs;
2464 register IO *io = GvIOn(gv);
2465
2466 if (!io || !IoDIRP(io))
2467 goto nope;
2468
2469 if (GIMME == G_ARRAY) {
2470 /*SUPPRESS 560*/
2471 while (dp = (Direntry_t *)readdir(IoDIRP(io))) {
2472#ifdef DIRNAMLEN
2473 XPUSHs(sv_2mortal(newSVpv(dp->d_name, dp->d_namlen)));
2474#else
2475 XPUSHs(sv_2mortal(newSVpv(dp->d_name, 0)));
2476#endif
2477 }
2478 }
2479 else {
2480 if (!(dp = (Direntry_t *)readdir(IoDIRP(io))))
2481 goto nope;
2482#ifdef DIRNAMLEN
2483 XPUSHs(sv_2mortal(newSVpv(dp->d_name, dp->d_namlen)));
2484#else
2485 XPUSHs(sv_2mortal(newSVpv(dp->d_name, 0)));
2486#endif
2487 }
2488 RETURN;
2489
2490nope:
2491 if (!errno)
748a9306 2492 SETERRNO(EBADF,RMS$_ISI);
a0d0e21e
LW		 2493 if (GIMME == G_ARRAY)
2494 RETURN;
2495 else
2496 RETPUSHUNDEF;
2497#else
2498 DIE(no_dir_func, "readdir");
2499#endif
2500}
2501
2502PP(pp_telldir)
2503{
2504 dSP; dTARGET;
2505#if defined(HAS_TELLDIR) || defined(telldir)
2506#if !defined(telldir) && !defined(HAS_TELLDIR_PROTOTYPE)
2507 long telldir _((DIR *));
2508#endif
2509 GV *gv = (GV*)POPs;
2510 register IO *io = GvIOn(gv);
2511
2512 if (!io || !IoDIRP(io))
2513 goto nope;
2514
2515 PUSHi( telldir(IoDIRP(io)) );
2516 RETURN;
2517nope:
2518 if (!errno)
748a9306 2519 SETERRNO(EBADF,RMS$_ISI);
a0d0e21e
LW		 2520 RETPUSHUNDEF;
2521#else
2522 DIE(no_dir_func, "telldir");
2523#endif
2524}
2525
2526PP(pp_seekdir)
2527{
2528 dSP;
2529#if defined(HAS_SEEKDIR) || defined(seekdir)
2530 long along = POPl;
2531 GV *gv = (GV*)POPs;
2532 register IO *io = GvIOn(gv);
2533
2534 if (!io || !IoDIRP(io))
2535 goto nope;
2536
2537 (void)seekdir(IoDIRP(io), along);
2538
2539 RETPUSHYES;
2540nope:
2541 if (!errno)
748a9306 2542 SETERRNO(EBADF,RMS$_ISI);
a0d0e21e
LW		 2543 RETPUSHUNDEF;
2544#else
2545 DIE(no_dir_func, "seekdir");
2546#endif
2547}
2548
2549PP(pp_rewinddir)
2550{
2551 dSP;
2552#if defined(HAS_REWINDDIR) || defined(rewinddir)
2553 GV *gv = (GV*)POPs;
2554 register IO *io = GvIOn(gv);
2555
2556 if (!io || !IoDIRP(io))
2557 goto nope;
2558
2559 (void)rewinddir(IoDIRP(io));
2560 RETPUSHYES;
2561nope:
2562 if (!errno)
748a9306 2563 SETERRNO(EBADF,RMS$_ISI);
a0d0e21e
LW		 2564 RETPUSHUNDEF;
2565#else
2566 DIE(no_dir_func, "rewinddir");
2567#endif
2568}
2569
2570PP(pp_closedir)
2571{
2572 dSP;
2573#if defined(Direntry_t) && defined(HAS_READDIR)
2574 GV *gv = (GV*)POPs;
2575 register IO *io = GvIOn(gv);
2576
2577 if (!io || !IoDIRP(io))
2578 goto nope;
2579
2580#ifdef VOID_CLOSEDIR
2581 closedir(IoDIRP(io));
2582#else
748a9306
LW		 2583 if (closedir(IoDIRP(io)) < 0) {
2584 IoDIRP(io) = 0; /* Don't try to close again--coredumps on SysV */
a0d0e21e 2585 goto nope;
748a9306 2586 }
a0d0e21e
LW		 2587#endif
2588 IoDIRP(io) = 0;
2589
2590 RETPUSHYES;
2591nope:
2592 if (!errno)
748a9306 2593 SETERRNO(EBADF,RMS$_IFI);
a0d0e21e
LW		 2594 RETPUSHUNDEF;
2595#else
2596 DIE(no_dir_func, "closedir");
2597#endif
2598}
2599
2600/* Process control. */
2601
2602PP(pp_fork)
2603{
2604 dSP; dTARGET;
2605 int childpid;
2606 GV *tmpgv;
2607
2608 EXTEND(SP, 1);
2609#ifdef HAS_FORK
2610 childpid = fork();
2611 if (childpid < 0)
2612 RETSETUNDEF;
2613 if (!childpid) {
2614 /*SUPPRESS 560*/
2615 if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
2616 sv_setiv(GvSV(tmpgv), (I32)getpid());
2617 hv_clear(pidstatus); /* no kids, so don't wait for 'em */
2618 }
2619 PUSHi(childpid);
2620 RETURN;
2621#else
2622 DIE(no_func, "Unsupported function fork");
2623#endif
2624}
2625
2626PP(pp_wait)
2627{
2628 dSP; dTARGET;
2629 int childpid;
2630 int argflags;
2631 I32 value;
2632
2633 EXTEND(SP, 1);
2634#ifdef HAS_WAIT
2635 childpid = wait(&argflags);
2636 if (childpid > 0)
2637 pidgone(childpid, argflags);
2638 value = (I32)childpid;
748a9306 2639 statusvalue = FIXSTATUS(argflags);
a0d0e21e
LW		 2640 PUSHi(value);
2641 RETURN;
2642#else
2643 DIE(no_func, "Unsupported function wait");
2644#endif
2645}
2646
2647PP(pp_waitpid)
2648{
2649 dSP; dTARGET;
2650 int childpid;
2651 int optype;
2652 int argflags;
2653 I32 value;
2654
2655#ifdef HAS_WAIT
2656 optype = POPi;
2657 childpid = TOPi;
2658 childpid = wait4pid(childpid, &argflags, optype);
2659 value = (I32)childpid;
748a9306 2660 statusvalue = FIXSTATUS(argflags);
a0d0e21e
LW		 2661 SETi(value);
2662 RETURN;
2663#else
2664 DIE(no_func, "Unsupported function wait");
2665#endif
2666}
2667
2668PP(pp_system)
2669{
2670 dSP; dMARK; dORIGMARK; dTARGET;
2671 I32 value;
2672 int childpid;
2673 int result;
2674 int status;
ecfc5424
AD		 2675 Signal_t (*ihand)(); /* place to save signal during system() */
2676 Signal_t (*qhand)(); /* place to save signal during system() */
a0d0e21e
LW		 2677
2678#if defined(HAS_FORK) && !defined(VMS)
2679 if (SP - MARK == 1) {
2680 if (tainting) {
2681 char *junk = SvPV(TOPs, na);
2682 TAINT_ENV();
2683 TAINT_PROPER("system");
2684 }
2685 }
2686 while ((childpid = vfork()) == -1) {
2687 if (errno != EAGAIN) {
2688 value = -1;
2689 SP = ORIGMARK;
2690 PUSHi(value);
2691 RETURN;
2692 }
2693 sleep(5);
2694 }
2695 if (childpid > 0) {
2696 ihand = signal(SIGINT, SIG_IGN);
2697 qhand = signal(SIGQUIT, SIG_IGN);
748a9306
LW		 2698 do {
2699 result = wait4pid(childpid, &status, 0);
2700 } while (result == -1 && errno == EINTR);
a0d0e21e
LW		 2701 (void)signal(SIGINT, ihand);
2702 (void)signal(SIGQUIT, qhand);
748a9306 2703 statusvalue = FIXSTATUS(status);
a0d0e21e
LW		 2704 if (result < 0)
2705 value = -1;
2706 else {
2707 value = (I32)((unsigned int)status & 0xffff);
2708 }
2709 do_execfree(); /* free any memory child malloced on vfork */
2710 SP = ORIGMARK;
2711 PUSHi(value);
2712 RETURN;
2713 }
2714 if (op->op_flags & OPf_STACKED) {
2715 SV *really = *++MARK;
2716 value = (I32)do_aexec(really, MARK, SP);
2717 }
2718 else if (SP - MARK != 1)
2719 value = (I32)do_aexec(Nullsv, MARK, SP);
2720 else {
2721 value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), na));
2722 }
2723 _exit(-1);
2724#else /* ! FORK or VMS */
2725 if (op->op_flags & OPf_STACKED) {
2726 SV *really = *++MARK;
2727 value = (I32)do_aspawn(really, MARK, SP);
2728 }
2729 else if (SP - MARK != 1)
2730 value = (I32)do_aspawn(Nullsv, MARK, SP);
2731 else {
2732 value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), na));
2733 }
2734 do_execfree();
2735 SP = ORIGMARK;
2736 PUSHi(value);
2737#endif /* !FORK or VMS */
2738 RETURN;
2739}
2740
2741PP(pp_exec)
2742{
2743 dSP; dMARK; dORIGMARK; dTARGET;
2744 I32 value;
2745
2746 if (op->op_flags & OPf_STACKED) {
2747 SV *really = *++MARK;
2748 value = (I32)do_aexec(really, MARK, SP);
2749 }
2750 else if (SP - MARK != 1)
2751#ifdef VMS
2752 value = (I32)vms_do_aexec(Nullsv, MARK, SP);
2753#else
2754 value = (I32)do_aexec(Nullsv, MARK, SP);
2755#endif
2756 else {
2757 if (tainting) {
2758 char *junk = SvPV(*SP, na);
2759 TAINT_ENV();
2760 TAINT_PROPER("exec");
2761 }
2762#ifdef VMS
2763 value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), na));
2764#else
2765 value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), na));
2766#endif
2767 }
2768 SP = ORIGMARK;
2769 PUSHi(value);
2770 RETURN;
2771}
2772
2773PP(pp_kill)
2774{
2775 dSP; dMARK; dTARGET;
2776 I32 value;
2777#ifdef HAS_KILL
2778 value = (I32)apply(op->op_type, MARK, SP);
2779 SP = MARK;
2780 PUSHi(value);
2781 RETURN;
2782#else
2783 DIE(no_func, "Unsupported function kill");
2784#endif
2785}
2786
2787PP(pp_getppid)
2788{
2789#ifdef HAS_GETPPID
2790 dSP; dTARGET;
2791 XPUSHi( getppid() );
2792 RETURN;
2793#else
2794 DIE(no_func, "getppid");
2795#endif
2796}
2797
2798PP(pp_getpgrp)
2799{
2800#ifdef HAS_GETPGRP
2801 dSP; dTARGET;
2802 int pid;
2803 I32 value;
2804
2805 if (MAXARG < 1)
2806 pid = 0;
2807 else
2808 pid = SvIVx(POPs);
2809#ifdef USE_BSDPGRP
2810 value = (I32)getpgrp(pid);
2811#else
2812 if (pid != 0)
2813 DIE("POSIX getpgrp can't take an argument");
2814 value = (I32)getpgrp();
2815#endif
2816 XPUSHi(value);
2817 RETURN;
2818#else
2819 DIE(no_func, "getpgrp()");
2820#endif
2821}
2822
2823PP(pp_setpgrp)
2824{
2825#ifdef HAS_SETPGRP
2826 dSP; dTARGET;
2827 int pgrp;
2828 int pid;
2829 if (MAXARG < 2) {
2830 pgrp = 0;
2831 pid = 0;
2832 }
2833 else {
2834 pgrp = POPi;
2835 pid = TOPi;
2836 }
2837
2838 TAINT_PROPER("setpgrp");
2839#ifdef USE_BSDPGRP
2840 SETi( setpgrp(pid, pgrp) >= 0 );
2841#else
2842 if ((pgrp != 0) || (pid != 0)) {
2843 DIE("POSIX setpgrp can't take an argument");
2844 }
2845 SETi( setpgrp() >= 0 );
2846#endif /* USE_BSDPGRP */
2847 RETURN;
2848#else
2849 DIE(no_func, "setpgrp()");
2850#endif
2851}
2852
2853PP(pp_getpriority)
2854{
2855 dSP; dTARGET;
2856 int which;
2857 int who;
2858#ifdef HAS_GETPRIORITY
2859 who = POPi;
2860 which = TOPi;
2861 SETi( getpriority(which, who) );
2862 RETURN;
2863#else
2864 DIE(no_func, "getpriority()");
2865#endif
2866}
2867
2868PP(pp_setpriority)
2869{
2870 dSP; dTARGET;
2871 int which;
2872 int who;
2873 int niceval;
2874#ifdef HAS_SETPRIORITY
2875 niceval = POPi;
2876 who = POPi;
2877 which = TOPi;
2878 TAINT_PROPER("setpriority");
2879 SETi( setpriority(which, who, niceval) >= 0 );
2880 RETURN;
2881#else
2882 DIE(no_func, "setpriority()");
2883#endif
2884}
2885
2886/* Time calls. */
2887
2888PP(pp_time)
2889{
2890 dSP; dTARGET;
2891 XPUSHi( time(Null(Time_t*)) );
2892 RETURN;
2893}
2894
2895#ifndef HZ
2896#define HZ 60
2897#endif
2898
2899PP(pp_tms)
2900{
2901 dSP;
2902
2903#if defined(MSDOS) || !defined(HAS_TIMES)
2904 DIE("times not implemented");
2905#else
2906 EXTEND(SP, 4);
2907
2908#ifndef VMS
2909 (void)times(&timesbuf);
2910#else
2911 (void)times((tbuffer_t *)&timesbuf); /* time.h uses different name for */
2912 /* struct tms, though same data */
2913 /* is returned. */
2914#endif
2915
2916 PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_utime)/HZ)));
2917 if (GIMME == G_ARRAY) {
2918 PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_stime)/HZ)));
2919 PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_cutime)/HZ)));
2920 PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_cstime)/HZ)));
2921 }
2922 RETURN;
2923#endif /* MSDOS */
2924}
2925
2926PP(pp_localtime)
2927{
2928 return pp_gmtime(ARGS);
2929}
2930
2931PP(pp_gmtime)
2932{
2933 dSP;
2934 Time_t when;
2935 struct tm *tmbuf;
2936 static char *dayname[] = {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"};
2937 static char *monname[] = {"Jan", "Feb", "Mar", "Apr", "May", "Jun",
2938 "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"};
2939
2940 if (MAXARG < 1)
2941 (void)time(&when);
2942 else
2943 when = (Time_t)SvIVx(POPs);
2944
2945 if (op->op_type == OP_LOCALTIME)
2946 tmbuf = localtime(&when);
2947 else
2948 tmbuf = gmtime(&when);
2949
2950 EXTEND(SP, 9);
2951 if (GIMME != G_ARRAY) {
2952 dTARGET;
2953 char mybuf[30];
2954 if (!tmbuf)
2955 RETPUSHUNDEF;
2956 sprintf(mybuf, "%s %s %2d %02d:%02d:%02d %d",
2957 dayname[tmbuf->tm_wday],
2958 monname[tmbuf->tm_mon],
2959 tmbuf->tm_mday,
2960 tmbuf->tm_hour,
2961 tmbuf->tm_min,
2962 tmbuf->tm_sec,
2963 tmbuf->tm_year + 1900);
2964 PUSHp(mybuf, strlen(mybuf));
2965 }
2966 else if (tmbuf) {
2967 PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_sec)));
2968 PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_min)));
2969 PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_hour)));
2970 PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_mday)));
2971 PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_mon)));
2972 PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_year)));
2973 PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_wday)));
2974 PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_yday)));
2975 PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_isdst)));
2976 }
2977 RETURN;
2978}
2979
2980PP(pp_alarm)
2981{
2982 dSP; dTARGET;
2983 int anum;
2984#ifdef HAS_ALARM
2985 anum = POPi;
2986 anum = alarm((unsigned int)anum);
2987 EXTEND(SP, 1);
2988 if (anum < 0)
2989 RETPUSHUNDEF;
2990 PUSHi((I32)anum);
2991 RETURN;
2992#else
2993 DIE(no_func, "Unsupported function alarm");
a0d0e21e
LW		 2994#endif
2995}
2996
2997PP(pp_sleep)
2998{
2999 dSP; dTARGET;
3000 I32 duration;
3001 Time_t lasttime;
3002 Time_t when;
3003
3004 (void)time(&lasttime);
3005 if (MAXARG < 1)
3006 pause();
3007 else {
3008 duration = POPi;
3009 sleep((unsigned int)duration);
3010 }
3011 (void)time(&when);
3012 XPUSHi(when - lasttime);
3013 RETURN;
3014}
3015
3016/* Shared memory. */
3017
3018PP(pp_shmget)
3019{
3020 return pp_semget(ARGS);
3021}
3022
3023PP(pp_shmctl)
3024{
3025 return pp_semctl(ARGS);
3026}
3027
3028PP(pp_shmread)
3029{
3030 return pp_shmwrite(ARGS);
3031}
3032
3033PP(pp_shmwrite)
3034{
3035#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
3036 dSP; dMARK; dTARGET;
3037 I32 value = (I32)(do_shmio(op->op_type, MARK, SP) >= 0);
3038 SP = MARK;
3039 PUSHi(value);
3040 RETURN;
3041#else
748a9306 3042 return pp_semget(ARGS);
a0d0e21e
LW		 3043#endif
3044}
3045
3046/* Message passing. */
3047
3048PP(pp_msgget)
3049{
3050 return pp_semget(ARGS);
3051}
3052
3053PP(pp_msgctl)
3054{
3055 return pp_semctl(ARGS);
3056}
3057
3058PP(pp_msgsnd)
3059{
3060#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
3061 dSP; dMARK; dTARGET;
3062 I32 value = (I32)(do_msgsnd(MARK, SP) >= 0);
3063 SP = MARK;
3064 PUSHi(value);
3065 RETURN;
3066#else
748a9306 3067 return pp_semget(ARGS);
a0d0e21e
LW		 3068#endif
3069}
3070
3071PP(pp_msgrcv)
3072{
3073#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
3074 dSP; dMARK; dTARGET;
3075 I32 value = (I32)(do_msgrcv(MARK, SP) >= 0);
3076 SP = MARK;
3077 PUSHi(value);
3078 RETURN;
3079#else
748a9306 3080 return pp_semget(ARGS);
a0d0e21e
LW		 3081#endif
3082}
3083
3084/* Semaphores. */
3085
3086PP(pp_semget)
3087{
3088#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
3089 dSP; dMARK; dTARGET;
3090 int anum = do_ipcget(op->op_type, MARK, SP);
3091 SP = MARK;
3092 if (anum == -1)
3093 RETPUSHUNDEF;
3094 PUSHi(anum);
3095 RETURN;
3096#else
3097 DIE("System V IPC is not implemented on this machine");
3098#endif
3099}
3100
3101PP(pp_semctl)
3102{
3103#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
3104 dSP; dMARK; dTARGET;
3105 int anum = do_ipcctl(op->op_type, MARK, SP);
3106 SP = MARK;
3107 if (anum == -1)
3108 RETSETUNDEF;
3109 if (anum != 0) {
3110 PUSHi(anum);
3111 }
3112 else {
3113 PUSHp("0 but true",10);
3114 }
3115 RETURN;
3116#else
748a9306 3117 return pp_semget(ARGS);
a0d0e21e
LW		 3118#endif
3119}
3120
3121PP(pp_semop)
3122{
3123#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
3124 dSP; dMARK; dTARGET;
3125 I32 value = (I32)(do_semop(MARK, SP) >= 0);
3126 SP = MARK;
3127 PUSHi(value);
3128 RETURN;
3129#else
748a9306 3130 return pp_semget(ARGS);
a0d0e21e
LW		 3131#endif
3132}
3133
3134/* Get system info. */
3135
3136PP(pp_ghbyname)
3137{
3138#ifdef HAS_SOCKET
3139 return pp_ghostent(ARGS);
3140#else
3141 DIE(no_sock_func, "gethostbyname");
3142#endif
3143}
3144
3145PP(pp_ghbyaddr)
3146{
3147#ifdef HAS_SOCKET
3148 return pp_ghostent(ARGS);
3149#else
3150 DIE(no_sock_func, "gethostbyaddr");
3151#endif
3152}
3153
3154PP(pp_ghostent)
3155{
3156 dSP;
3157#ifdef HAS_SOCKET
3158 I32 which = op->op_type;
3159 register char **elem;
3160 register SV *sv;
3161 struct hostent *gethostbyname();
3162 struct hostent *gethostbyaddr();
3163#ifdef HAS_GETHOSTENT
3164 struct hostent *gethostent();
3165#endif
3166 struct hostent *hent;
3167 unsigned long len;
3168
3169 EXTEND(SP, 10);
3170 if (which == OP_GHBYNAME) {
3171 hent = gethostbyname(POPp);
3172 }
3173 else if (which == OP_GHBYADDR) {
3174 int addrtype = POPi;
748a9306 3175 SV *addrsv = POPs;
a0d0e21e 3176 STRLEN addrlen;
748a9306 3177 char *addr = SvPV(addrsv, addrlen);
a0d0e21e
LW		 3178
3179 hent = gethostbyaddr(addr, addrlen, addrtype);
3180 }
3181 else
3182#ifdef HAS_GETHOSTENT
3183 hent = gethostent();
3184#else
3185 DIE("gethostent not implemented");
3186#endif
3187
3188#ifdef HOST_NOT_FOUND
3189 if (!hent)
748a9306 3190 statusvalue = FIXSTATUS(h_errno);
a0d0e21e
LW		 3191#endif
3192
3193 if (GIMME != G_ARRAY) {
3194 PUSHs(sv = sv_newmortal());
3195 if (hent) {
3196 if (which == OP_GHBYNAME) {
3197 sv_setpvn(sv, hent->h_addr, hent->h_length);
3198 }
3199 else
3200 sv_setpv(sv, (char*)hent->h_name);
3201 }
3202 RETURN;
3203 }
3204
3205 if (hent) {
3206 PUSHs(sv = sv_mortalcopy(&sv_no));
3207 sv_setpv(sv, (char*)hent->h_name);
3208 PUSHs(sv = sv_mortalcopy(&sv_no));
3209 for (elem = hent->h_aliases; elem && *elem; elem++) {
3210 sv_catpv(sv, *elem);
3211 if (elem[1])
3212 sv_catpvn(sv, " ", 1);
3213 }
3214 PUSHs(sv = sv_mortalcopy(&sv_no));
3215 sv_setiv(sv, (I32)hent->h_addrtype);
3216 PUSHs(sv = sv_mortalcopy(&sv_no));
3217 len = hent->h_length;
3218 sv_setiv(sv, (I32)len);
3219#ifdef h_addr
3220 for (elem = hent->h_addr_list; elem && *elem; elem++) {
3221 XPUSHs(sv = sv_mortalcopy(&sv_no));
3222 sv_setpvn(sv, *elem, len);
3223 }
3224#else
3225 PUSHs(sv = sv_mortalcopy(&sv_no));
3226 sv_setpvn(sv, hent->h_addr, len);
3227#endif /* h_addr */
3228 }
3229 RETURN;
3230#else
3231 DIE(no_sock_func, "gethostent");
3232#endif
3233}
3234
3235PP(pp_gnbyname)
3236{
3237#ifdef HAS_SOCKET
3238 return pp_gnetent(ARGS);
3239#else
3240 DIE(no_sock_func, "getnetbyname");
3241#endif
3242}
3243
3244PP(pp_gnbyaddr)
3245{
3246#ifdef HAS_SOCKET
3247 return pp_gnetent(ARGS);
3248#else
3249 DIE(no_sock_func, "getnetbyaddr");
3250#endif
3251}
3252
3253PP(pp_gnetent)
3254{
3255 dSP;
3256#ifdef HAS_SOCKET
3257 I32 which = op->op_type;
3258 register char **elem;
3259 register SV *sv;
3260 struct netent *getnetbyname();
3261 struct netent *getnetbyaddr();
3262 struct netent *getnetent();
3263 struct netent *nent;
3264
3265 if (which == OP_GNBYNAME)
3266 nent = getnetbyname(POPp);
3267 else if (which == OP_GNBYADDR) {
3268 int addrtype = POPi;
3269 unsigned long addr = U_L(POPn);
3270 nent = getnetbyaddr((long)addr, addrtype);
3271 }
3272 else
3273 nent = getnetent();
3274
3275 EXTEND(SP, 4);
3276 if (GIMME != G_ARRAY) {
3277 PUSHs(sv = sv_newmortal());
3278 if (nent) {
3279 if (which == OP_GNBYNAME)
3280 sv_setiv(sv, (I32)nent->n_net);
3281 else
3282 sv_setpv(sv, nent->n_name);
3283 }
3284 RETURN;
3285 }
3286
3287 if (nent) {
3288 PUSHs(sv = sv_mortalcopy(&sv_no));
3289 sv_setpv(sv, nent->n_name);
3290 PUSHs(sv = sv_mortalcopy(&sv_no));
3291 for (elem = nent->n_aliases; *elem; elem++) {
3292 sv_catpv(sv, *elem);
3293 if (elem[1])
3294 sv_catpvn(sv, " ", 1);
3295 }
3296 PUSHs(sv = sv_mortalcopy(&sv_no));
3297 sv_setiv(sv, (I32)nent->n_addrtype);
3298 PUSHs(sv = sv_mortalcopy(&sv_no));
3299 sv_setiv(sv, (I32)nent->n_net);
3300 }
3301
3302 RETURN;
3303#else
3304 DIE(no_sock_func, "getnetent");
3305#endif
3306}
3307
3308PP(pp_gpbyname)
3309{
3310#ifdef HAS_SOCKET
3311 return pp_gprotoent(ARGS);
3312#else
3313 DIE(no_sock_func, "getprotobyname");
3314#endif
3315}
3316
3317PP(pp_gpbynumber)
3318{
3319#ifdef HAS_SOCKET
3320 return pp_gprotoent(ARGS);
3321#else
3322 DIE(no_sock_func, "getprotobynumber");
3323#endif
3324}
3325
3326PP(pp_gprotoent)
3327{
3328 dSP;
3329#ifdef HAS_SOCKET
3330 I32 which = op->op_type;
3331 register char **elem;
3332 register SV *sv;
3333 struct protoent *getprotobyname();
3334 struct protoent *getprotobynumber();
3335 struct protoent *getprotoent();
3336 struct protoent *pent;
3337
3338 if (which == OP_GPBYNAME)
3339 pent = getprotobyname(POPp);
3340 else if (which == OP_GPBYNUMBER)
3341 pent = getprotobynumber(POPi);
3342 else
3343 pent = getprotoent();
3344
3345 EXTEND(SP, 3);
3346 if (GIMME != G_ARRAY) {
3347 PUSHs(sv = sv_newmortal());
3348 if (pent) {
3349 if (which == OP_GPBYNAME)
3350 sv_setiv(sv, (I32)pent->p_proto);
3351 else
3352 sv_setpv(sv, pent->p_name);
3353 }
3354 RETURN;
3355 }
3356
3357 if (pent) {
3358 PUSHs(sv = sv_mortalcopy(&sv_no));
3359 sv_setpv(sv, pent->p_name);
3360 PUSHs(sv = sv_mortalcopy(&sv_no));
3361 for (elem = pent->p_aliases; *elem; elem++) {
3362 sv_catpv(sv, *elem);
3363 if (elem[1])
3364 sv_catpvn(sv, " ", 1);
3365 }
3366 PUSHs(sv = sv_mortalcopy(&sv_no));
3367 sv_setiv(sv, (I32)pent->p_proto);
3368 }
3369
3370 RETURN;
3371#else
3372 DIE(no_sock_func, "getprotoent");
3373#endif
3374}
3375
3376PP(pp_gsbyname)
3377{
3378#ifdef HAS_SOCKET
3379 return pp_gservent(ARGS);
3380#else
3381 DIE(no_sock_func, "getservbyname");
3382#endif
3383}
3384
3385PP(pp_gsbyport)
3386{
3387#ifdef HAS_SOCKET
3388 return pp_gservent(ARGS);
3389#else
3390 DIE(no_sock_func, "getservbyport");
3391#endif
3392}
3393
3394PP(pp_gservent)
3395{
3396 dSP;
3397#ifdef HAS_SOCKET
3398 I32 which = op->op_type;
3399 register char **elem;
3400 register SV *sv;
3401 struct servent *getservbyname();
3402 struct servent *getservbynumber();
3403 struct servent *getservent();
3404 struct servent *sent;
3405
3406 if (which == OP_GSBYNAME) {
3407 char *proto = POPp;
3408 char *name = POPp;
3409
3410 if (proto && !*proto)
3411 proto = Nullch;
3412
3413 sent = getservbyname(name, proto);
3414 }
3415 else if (which == OP_GSBYPORT) {
3416 char *proto = POPp;
3417 int port = POPi;
3418
3419 sent = getservbyport(port, proto);
3420 }
3421 else
3422 sent = getservent();
3423
3424 EXTEND(SP, 4);
3425 if (GIMME != G_ARRAY) {
3426 PUSHs(sv = sv_newmortal());
3427 if (sent) {
3428 if (which == OP_GSBYNAME) {
3429#ifdef HAS_NTOHS
3430 sv_setiv(sv, (I32)ntohs(sent->s_port));
3431#else
3432 sv_setiv(sv, (I32)(sent->s_port));
3433#endif
3434 }
3435 else
3436 sv_setpv(sv, sent->s_name);
3437 }
3438 RETURN;
3439 }
3440
3441 if (sent) {
3442 PUSHs(sv = sv_mortalcopy(&sv_no));
3443 sv_setpv(sv, sent->s_name);
3444 PUSHs(sv = sv_mortalcopy(&sv_no));
3445 for (elem = sent->s_aliases; *elem; elem++) {
3446 sv_catpv(sv, *elem);
3447 if (elem[1])
3448 sv_catpvn(sv, " ", 1);
3449 }
3450 PUSHs(sv = sv_mortalcopy(&sv_no));
3451#ifdef HAS_NTOHS
3452 sv_setiv(sv, (I32)ntohs(sent->s_port));
3453#else
3454 sv_setiv(sv, (I32)(sent->s_port));
3455#endif
3456 PUSHs(sv = sv_mortalcopy(&sv_no));
3457 sv_setpv(sv, sent->s_proto);
3458 }
3459
3460 RETURN;
3461#else
3462 DIE(no_sock_func, "getservent");
3463#endif
3464}
3465
3466PP(pp_shostent)
3467{
3468 dSP;
3469#ifdef HAS_SOCKET
3470 sethostent(TOPi);
3471 RETSETYES;
3472#else
3473 DIE(no_sock_func, "sethostent");
3474#endif
3475}
3476
3477PP(pp_snetent)
3478{
3479 dSP;
3480#ifdef HAS_SOCKET
3481 setnetent(TOPi);
3482 RETSETYES;
3483#else
3484 DIE(no_sock_func, "setnetent");
3485#endif
3486}
3487
3488PP(pp_sprotoent)
3489{
3490 dSP;
3491#ifdef HAS_SOCKET
3492 setprotoent(TOPi);
3493 RETSETYES;
3494#else
3495 DIE(no_sock_func, "setprotoent");
3496#endif
3497}
3498
3499PP(pp_sservent)
3500{
3501 dSP;
3502#ifdef HAS_SOCKET
3503 setservent(TOPi);
3504 RETSETYES;
3505#else
3506 DIE(no_sock_func, "setservent");
3507#endif
3508}
3509
3510PP(pp_ehostent)
3511{
3512 dSP;
3513#ifdef HAS_SOCKET
3514 endhostent();
3515 EXTEND(sp,1);
3516 RETPUSHYES;
3517#else
3518 DIE(no_sock_func, "endhostent");
3519#endif
3520}
3521
3522PP(pp_enetent)
3523{
3524 dSP;
3525#ifdef HAS_SOCKET
3526 endnetent();
3527 EXTEND(sp,1);
3528 RETPUSHYES;
3529#else
3530 DIE(no_sock_func, "endnetent");
3531#endif
3532}
3533
3534PP(pp_eprotoent)
3535{
3536 dSP;
3537#ifdef HAS_SOCKET
3538 endprotoent();
3539 EXTEND(sp,1);
3540 RETPUSHYES;
3541#else
3542 DIE(no_sock_func, "endprotoent");
3543#endif
3544}
3545
3546PP(pp_eservent)
3547{
3548 dSP;
3549#ifdef HAS_SOCKET
3550 endservent();
3551 EXTEND(sp,1);
3552 RETPUSHYES;
3553#else
3554 DIE(no_sock_func, "endservent");
3555#endif
3556}
3557
3558PP(pp_gpwnam)
3559{
3560#ifdef HAS_PASSWD
3561 return pp_gpwent(ARGS);
3562#else
3563 DIE(no_func, "getpwnam");
3564#endif
3565}
3566
3567PP(pp_gpwuid)
3568{
3569#ifdef HAS_PASSWD
3570 return pp_gpwent(ARGS);
3571#else
3572 DIE(no_func, "getpwuid");
3573#endif
3574}
3575
3576PP(pp_gpwent)
3577{
3578 dSP;
3579#ifdef HAS_PASSWD
3580 I32 which = op->op_type;
3581 register SV *sv;
3582 struct passwd *pwent;
3583
3584 if (which == OP_GPWNAM)
3585 pwent = getpwnam(POPp);
3586 else if (which == OP_GPWUID)
3587 pwent = getpwuid(POPi);
3588 else
3589 pwent = (struct passwd *)getpwent();
3590
3591 EXTEND(SP, 10);
3592 if (GIMME != G_ARRAY) {
3593 PUSHs(sv = sv_newmortal());
3594 if (pwent) {
3595 if (which == OP_GPWNAM)
3596 sv_setiv(sv, (I32)pwent->pw_uid);
3597 else
3598 sv_setpv(sv, pwent->pw_name);
3599 }
3600 RETURN;
3601 }
3602
3603 if (pwent) {
3604 PUSHs(sv = sv_mortalcopy(&sv_no));
3605 sv_setpv(sv, pwent->pw_name);
3606 PUSHs(sv = sv_mortalcopy(&sv_no));
3607 sv_setpv(sv, pwent->pw_passwd);
3608 PUSHs(sv = sv_mortalcopy(&sv_no));
3609 sv_setiv(sv, (I32)pwent->pw_uid);
3610 PUSHs(sv = sv_mortalcopy(&sv_no));
3611 sv_setiv(sv, (I32)pwent->pw_gid);
3612 PUSHs(sv = sv_mortalcopy(&sv_no));
3613#ifdef PWCHANGE
3614 sv_setiv(sv, (I32)pwent->pw_change);
3615#else
3616#ifdef PWQUOTA
3617 sv_setiv(sv, (I32)pwent->pw_quota);
3618#else
3619#ifdef PWAGE
3620 sv_setpv(sv, pwent->pw_age);
3621#endif
3622#endif
3623#endif
3624 PUSHs(sv = sv_mortalcopy(&sv_no));
3625#ifdef PWCLASS
3626 sv_setpv(sv, pwent->pw_class);
3627#else
3628#ifdef PWCOMMENT
3629 sv_setpv(sv, pwent->pw_comment);
3630#endif
3631#endif
3632 PUSHs(sv = sv_mortalcopy(&sv_no));
3633 sv_setpv(sv, pwent->pw_gecos);
3634 PUSHs(sv = sv_mortalcopy(&sv_no));
3635 sv_setpv(sv, pwent->pw_dir);
3636 PUSHs(sv = sv_mortalcopy(&sv_no));
3637 sv_setpv(sv, pwent->pw_shell);
3638#ifdef PWEXPIRE
3639 PUSHs(sv = sv_mortalcopy(&sv_no));
3640 sv_setiv(sv, (I32)pwent->pw_expire);
3641#endif
3642 }
3643 RETURN;
3644#else
3645 DIE(no_func, "getpwent");
3646#endif
3647}
3648
3649PP(pp_spwent)
3650{
3651 dSP;
3652#ifdef HAS_PASSWD
3653 setpwent();
3654 RETPUSHYES;
3655#else
3656 DIE(no_func, "setpwent");
3657#endif
3658}
3659
3660PP(pp_epwent)
3661{
3662 dSP;
3663#ifdef HAS_PASSWD
3664 endpwent();
3665 RETPUSHYES;
3666#else
3667 DIE(no_func, "endpwent");
3668#endif
3669}
3670
3671PP(pp_ggrnam)
3672{
3673#ifdef HAS_GROUP
3674 return pp_ggrent(ARGS);
3675#else
3676 DIE(no_func, "getgrnam");
3677#endif
3678}
3679
3680PP(pp_ggrgid)
3681{
3682#ifdef HAS_GROUP
3683 return pp_ggrent(ARGS);
3684#else
3685 DIE(no_func, "getgrgid");
3686#endif
3687}
3688
3689PP(pp_ggrent)
3690{
3691 dSP;
3692#ifdef HAS_GROUP
3693 I32 which = op->op_type;
3694 register char **elem;
3695 register SV *sv;
3696 struct group *grent;
3697
3698 if (which == OP_GGRNAM)
3699 grent = (struct group *)getgrnam(POPp);
3700 else if (which == OP_GGRGID)
3701 grent = (struct group *)getgrgid(POPi);
3702 else
3703 grent = (struct group *)getgrent();
3704
3705 EXTEND(SP, 4);
3706 if (GIMME != G_ARRAY) {
3707 PUSHs(sv = sv_newmortal());
3708 if (grent) {
3709 if (which == OP_GGRNAM)
3710 sv_setiv(sv, (I32)grent->gr_gid);
3711 else
3712 sv_setpv(sv, grent->gr_name);
3713 }
3714 RETURN;
3715 }
3716
3717 if (grent) {
3718 PUSHs(sv = sv_mortalcopy(&sv_no));
3719 sv_setpv(sv, grent->gr_name);
3720 PUSHs(sv = sv_mortalcopy(&sv_no));
3721 sv_setpv(sv, grent->gr_passwd);
3722 PUSHs(sv = sv_mortalcopy(&sv_no));
3723 sv_setiv(sv, (I32)grent->gr_gid);
3724 PUSHs(sv = sv_mortalcopy(&sv_no));
3725 for (elem = grent->gr_mem; *elem; elem++) {
3726 sv_catpv(sv, *elem);
3727 if (elem[1])
3728 sv_catpvn(sv, " ", 1);
3729 }
3730 }
3731
3732 RETURN;
3733#else
3734 DIE(no_func, "getgrent");
3735#endif
3736}
3737
3738PP(pp_sgrent)
3739{
3740 dSP;
3741#ifdef HAS_GROUP
3742 setgrent();
3743 RETPUSHYES;
3744#else
3745 DIE(no_func, "setgrent");
3746#endif
3747}
3748
3749PP(pp_egrent)
3750{
3751 dSP;
3752#ifdef HAS_GROUP
3753 endgrent();
3754 RETPUSHYES;
3755#else
3756 DIE(no_func, "endgrent");
3757#endif
3758}
3759
3760PP(pp_getlogin)
3761{
3762 dSP; dTARGET;
3763#ifdef HAS_GETLOGIN
3764 char *tmps;
3765 EXTEND(SP, 1);
3766 if (!(tmps = getlogin()))
3767 RETPUSHUNDEF;
3768 PUSHp(tmps, strlen(tmps));
3769 RETURN;
3770#else
3771 DIE(no_func, "getlogin");
3772#endif
3773}
3774
3775/* Miscellaneous. */
3776
3777PP(pp_syscall)
3778{
3779#ifdef HAS_SYSCALL
3780 dSP; dMARK; dORIGMARK; dTARGET;
3781 register I32 items = SP - MARK;
3782 unsigned long a[20];
3783 register I32 i = 0;
3784 I32 retval = -1;
748a9306 3785 MAGIC *mg;
a0d0e21e
LW		 3786
3787 if (tainting) {
3788 while (++MARK <= SP) {
748a9306
LW		 3789 if (SvGMAGICAL(*MARK) && SvSMAGICAL(*MARK) &&
3790 (mg = mg_find(*MARK, 't')) && mg->mg_len & 1)
a0d0e21e
LW		 3791 tainted = TRUE;
3792 }
3793 MARK = ORIGMARK;
3794 TAINT_PROPER("syscall");
3795 }
3796
3797 /* This probably won't work on machines where sizeof(long) != sizeof(int)
3798 * or where sizeof(long) != sizeof(char*). But such machines will
3799 * not likely have syscall implemented either, so who cares?
3800 */
3801 while (++MARK <= SP) {
3802 if (SvNIOK(*MARK) || !i)
3803 a[i++] = SvIV(*MARK);
748a9306
LW		 3804 else if (*MARK == &sv_undef)
3805 a[i++] = 0;
3806 else
3807 a[i++] = (unsigned long)SvPV_force(*MARK, na);
a0d0e21e
LW		 3808 if (i > 15)
3809 break;
3810 }
3811 switch (items) {
3812 default:
3813 DIE("Too many args to syscall");
3814 case 0:
3815 DIE("Too few args to syscall");
3816 case 1:
3817 retval = syscall(a[0]);
3818 break;
3819 case 2:
3820 retval = syscall(a[0],a[1]);
3821 break;
3822 case 3:
3823 retval = syscall(a[0],a[1],a[2]);
3824 break;
3825 case 4:
3826 retval = syscall(a[0],a[1],a[2],a[3]);
3827 break;
3828 case 5:
3829 retval = syscall(a[0],a[1],a[2],a[3],a[4]);
3830 break;
3831 case 6:
3832 retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5]);
3833 break;
3834 case 7:
3835 retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6]);
3836 break;
3837 case 8:
3838 retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7]);
3839 break;
3840#ifdef atarist
3841 case 9:
3842 retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8]);
3843 break;
3844 case 10:
3845 retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9]);
3846 break;
3847 case 11:
3848 retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
3849 a[10]);
3850 break;
3851 case 12:
3852 retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
3853 a[10],a[11]);
3854 break;
3855 case 13:
3856 retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
3857 a[10],a[11],a[12]);
3858 break;
3859 case 14:
3860 retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
3861 a[10],a[11],a[12],a[13]);
3862 break;
3863#endif /* atarist */
3864 }
3865 SP = ORIGMARK;
3866 PUSHi(retval);
3867 RETURN;
3868#else
3869 DIE(no_func, "syscall");
3870#endif
3871}
3872
16d20bd9
AD		 3873#if !defined(HAS_FLOCK) && defined(HAS_LOCKF)
3874
3875/* XXX Emulate flock() with lockf(). This is just to increase
3876 portability of scripts. The calls are not completely
3877 interchangeable. What's really needed is a good file
3878 locking module.
3879*/
3880
3881/* We might need <unistd.h> because it sometimes defines the lockf()
3882 constants. Unfortunately, <unistd.h> causes troubles on some mixed
3883 (BSD/POSIX) systems, such as SunOS 4.1.3. We could just try including
3884 <unistd.h> here in this part of the file, but that might
3885 conflict with various other #defines and includes above, such as
3886 #define vfork fork above.
3887
3888 Further, the lockf() constants aren't POSIX, so they might not be
3889 visible if we're compiling with _POSIX_SOURCE defined. Thus, we'll
3890 just stick in the SVID values and be done with it. Sigh.
3891*/
3892
3893# ifndef F_ULOCK
3894# define F_ULOCK 0 /* Unlock a previously locked region */
3895# endif
3896# ifndef F_LOCK
3897# define F_LOCK 1 /* Lock a region for exclusive use */
3898# endif
3899# ifndef F_TLOCK
3900# define F_TLOCK 2 /* Test and lock a region for exclusive use */
3901# endif
3902# ifndef F_TEST
3903# define F_TEST 3 /* Test a region for other processes locks */
3904# endif
3905
3906/* These are the flock() constants. Since this sytems doesn't have
3907 flock(), the values of the constants are probably not available.
3908*/
3909# ifndef LOCK_SH
3910# define LOCK_SH 1
3911# endif
3912# ifndef LOCK_EX
3913# define LOCK_EX 2
3914# endif
3915# ifndef LOCK_NB
3916# define LOCK_NB 4
3917# endif
3918# ifndef LOCK_UN
3919# define LOCK_UN 8
3920# endif
3921
3922int
3923lockf_emulate_flock (fd, operation)
3924int fd;
3925int operation;
3926{
3927 int i;
3928 switch (operation) {
3929
3930 /* LOCK_SH - get a shared lock */
3931 case LOCK_SH:
3932 /* LOCK_EX - get an exclusive lock */
3933 case LOCK_EX:
3934 i = lockf (fd, F_LOCK, 0);
3935 break;
3936
3937 /* LOCK_SH|LOCK_NB - get a non-blocking shared lock */
3938 case LOCK_SH|LOCK_NB:
3939 /* LOCK_EX|LOCK_NB - get a non-blocking exclusive lock */
3940 case LOCK_EX|LOCK_NB:
3941 i = lockf (fd, F_TLOCK, 0);
3942 if (i == -1)
3943 if ((errno == EAGAIN) || (errno == EACCES))
3944 errno = EWOULDBLOCK;
3945 break;
3946
3947 /* LOCK_UN - unlock */
3948 case LOCK_UN:
3949 i = lockf (fd, F_ULOCK, 0);
3950 break;
3951
3952 /* Default - can't decipher operation */
3953 default:
3954 i = -1;
3955 errno = EINVAL;
3956 break;
3957 }
3958 return (i);
3959}
3960#endif
Unnamed repository; edit this file 'description' to name the repository.