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