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