[fix crash in regexec.c]
[perl.git] / pp_sys.c
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
45 extern 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)
87 static int dooneliner _((char *cmd, char *filename));
88 #endif
89 /* Pushy I/O. */
90
91 PP(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
133 PP(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
158 PP(pp_indread)
159 {
160     last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*stack_sp--)), na), TRUE,SVt_PVIO);
161     return do_readline();
162 }
163
164 PP(pp_rcatline)
165 {
166     last_in_gv = cGVOP->op_gv;
167     return do_readline();
168 }
169
170 PP(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
196 PP(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
223 PP(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
248 PP(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
262 PP(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
305 badexit:
306     RETPUSHUNDEF;
307 #else
308     DIE(no_func, "pipe");
309 #endif
310 }
311
312 PP(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
327 PP(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
347 PP(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
380 PP(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
440 PP(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
450 PP(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
523 PP(pp_dbmclose)
524 {
525     return pp_untie(ARGS);
526 }
527
528 PP(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
656 PP(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
670 PP(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
690 PP(pp_read)
691 {
692     return pp_sysread(ARGS);
693 }
694
695 static OP *
696 doform(cv,gv,retop)
697 CV *cv;
698 GV *gv;
699 OP *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
719 PP(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
758 PP(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
840 PP(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
889 PP(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
971 PP(pp_syswrite)
972 {
973     return pp_send(ARGS);
974 }
975
976 PP(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
1040 PP(pp_recv)
1041 {
1042     return pp_sysread(ARGS);
1043 }
1044
1045 PP(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
1058 PP(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
1071 PP(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
1083 PP(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
1131 PP(pp_fcntl)
1132 {
1133     return pp_ioctl(ARGS);
1134 }
1135
1136 PP(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
1210 PP(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
1245 PP(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
1287 PP(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
1337 PP(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
1357 nuts:
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
1367 PP(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
1387 nuts:
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
1397 PP(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
1413 nuts:
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
1423 PP(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
1466 nuts:
1467     if (dowarn)
1468         warn("accept() on closed fd");
1469     errno = EBADF;
1470
1471 badexit:
1472     RETPUSHUNDEF;
1473
1474 #else
1475     DIE(no_sock_func, "accept");
1476 #endif
1477 }
1478
1479 PP(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
1493 nuts:
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
1503 PP(pp_gsockopt)
1504 {
1505 #ifdef HAS_SOCKET
1506     return pp_ssockopt(ARGS);
1507 #else
1508     DIE(no_sock_func, "getsockopt");
1509 #endif
1510 }
1511
1512 PP(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
1564 nuts:
1565     if (dowarn)
1566         warn("[gs]etsockopt() on closed fd");
1567     errno = EBADF;
1568 nuts2:
1569     RETPUSHUNDEF;
1570
1571 #else
1572     DIE(no_sock_func, "setsockopt");
1573 #endif
1574 }
1575
1576 PP(pp_getsockname)
1577 {
1578 #ifdef HAS_SOCKET
1579     return pp_getpeername(ARGS);
1580 #else
1581     DIE(no_sock_func, "getsockname");
1582 #endif
1583 }
1584
1585 PP(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
1615 nuts:
1616     if (dowarn)
1617         warn("get{sock, peer}name() on closed fd");
1618     errno = EBADF;
1619 nuts2:
1620     RETPUSHUNDEF;
1621
1622 #else
1623     DIE(no_sock_func, "getpeername");
1624 #endif
1625 }
1626
1627 /* Stat calls. */
1628
1629 PP(pp_lstat)
1630 {
1631     return pp_stat(ARGS);
1632 }
1633
1634 PP(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
1702 PP(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
1713 PP(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
1724 PP(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
1735 PP(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
1746 PP(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
1757 PP(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
1768 PP(pp_ftis)
1769 {
1770     I32 result = my_stat(ARGS);
1771     dSP;
1772     if (result < 0)
1773         RETPUSHUNDEF;
1774     RETPUSHYES;
1775 }
1776
1777 PP(pp_fteowned)
1778 {
1779     return pp_ftrowned(ARGS);
1780 }
1781
1782 PP(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
1793 PP(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
1804 PP(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
1814 PP(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
1824 PP(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
1834 PP(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
1844 PP(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
1855 PP(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
1866 PP(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
1877 PP(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
1888 PP(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
1899 PP(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
1910 PP(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
1921 PP(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
1935 PP(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
1949 PP(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
1963 PP(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
2000 PP(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
2102 PP(pp_ftbinary)
2103 {
2104     return pp_fttext(ARGS);
2105 }
2106
2107 /* File calls. */
2108
2109 PP(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
2134 PP(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
2148 PP(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
2162 PP(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
2172 PP(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
2182 PP(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
2192 PP(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
2216 PP(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
2230 PP(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
2244 PP(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)
2264 static int
2265 dooneliner(cmd, filename)
2266 char *cmd;
2267 char *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
2337 PP(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
2358 PP(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
2375 PP(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;
2392 nope:
2393     if (!errno)
2394         errno = EBADF;
2395     RETPUSHUNDEF;
2396 #else
2397     DIE(no_dir_func, "opendir");
2398 #endif
2399 }
2400
2401 PP(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
2436 nope:
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
2448 PP(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;
2463 nope:
2464     if (!errno)
2465         errno = EBADF;
2466     RETPUSHUNDEF;
2467 #else
2468     DIE(no_dir_func, "telldir");
2469 #endif
2470 }
2471
2472 PP(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;
2486 nope:
2487     if (!errno)
2488         errno = EBADF;
2489     RETPUSHUNDEF;
2490 #else
2491     DIE(no_dir_func, "seekdir");
2492 #endif
2493 }
2494
2495 PP(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;
2507 nope:
2508     if (!errno)
2509         errno = EBADF;
2510     RETPUSHUNDEF;
2511 #else
2512     DIE(no_dir_func, "rewinddir");
2513 #endif
2514 }
2515
2516 PP(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;
2535 nope:
2536     if (!errno)
2537         errno = EBADF;
2538     RETPUSHUNDEF;
2539 #else
2540     DIE(no_dir_func, "closedir");
2541 #endif
2542 }
2543
2544 /* Process control. */
2545
2546 PP(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
2570 PP(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
2591 PP(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
2612 PP(pp_system)
2613 {
2614     dSP; dMARK; dORIGMARK; dTARGET;
2615     I32 value;
2616     int childpid;
2617     int result;
2618     int status;
2619     Signal_t (*ihand)();     /* place to save signal during system() */
2620     Signal_t (*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
2683 PP(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
2715 PP(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
2729 PP(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
2740 PP(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
2765 PP(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
2795 PP(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
2810 PP(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
2830 PP(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
2841 PP(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
2868 PP(pp_localtime)
2869 {
2870     return pp_gmtime(ARGS);
2871 }
2872
2873 PP(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
2922 PP(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
2940 PP(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
2961 PP(pp_shmget)
2962 {
2963     return pp_semget(ARGS);
2964 }
2965
2966 PP(pp_shmctl)
2967 {
2968     return pp_semctl(ARGS);
2969 }
2970
2971 PP(pp_shmread)
2972 {
2973     return pp_shmwrite(ARGS);
2974 }
2975
2976 PP(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
2991 PP(pp_msgget)
2992 {
2993     return pp_semget(ARGS);
2994 }
2995
2996 PP(pp_msgctl)
2997 {
2998     return pp_semctl(ARGS);
2999 }
3000
3001 PP(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
3014 PP(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
3029 PP(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
3044 PP(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
3064 PP(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
3079 PP(pp_ghbyname)
3080 {
3081 #ifdef HAS_SOCKET
3082     return pp_ghostent(ARGS);
3083 #else
3084     DIE(no_sock_func, "gethostbyname");
3085 #endif
3086 }
3087
3088 PP(pp_ghbyaddr)
3089 {
3090 #ifdef HAS_SOCKET
3091     return pp_ghostent(ARGS);
3092 #else
3093     DIE(no_sock_func, "gethostbyaddr");
3094 #endif
3095 }
3096
3097 PP(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
3178 PP(pp_gnbyname)
3179 {
3180 #ifdef HAS_SOCKET
3181     return pp_gnetent(ARGS);
3182 #else
3183     DIE(no_sock_func, "getnetbyname");
3184 #endif
3185 }
3186
3187 PP(pp_gnbyaddr)
3188 {
3189 #ifdef HAS_SOCKET
3190     return pp_gnetent(ARGS);
3191 #else
3192     DIE(no_sock_func, "getnetbyaddr");
3193 #endif
3194 }
3195
3196 PP(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
3251 PP(pp_gpbyname)
3252 {
3253 #ifdef HAS_SOCKET
3254     return pp_gprotoent(ARGS);
3255 #else
3256     DIE(no_sock_func, "getprotobyname");
3257 #endif
3258 }
3259
3260 PP(pp_gpbynumber)
3261 {
3262 #ifdef HAS_SOCKET
3263     return pp_gprotoent(ARGS);
3264 #else
3265     DIE(no_sock_func, "getprotobynumber");
3266 #endif
3267 }
3268
3269 PP(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
3319 PP(pp_gsbyname)
3320 {
3321 #ifdef HAS_SOCKET
3322     return pp_gservent(ARGS);
3323 #else
3324     DIE(no_sock_func, "getservbyname");
3325 #endif
3326 }
3327
3328 PP(pp_gsbyport)
3329 {
3330 #ifdef HAS_SOCKET
3331     return pp_gservent(ARGS);
3332 #else
3333     DIE(no_sock_func, "getservbyport");
3334 #endif
3335 }
3336
3337 PP(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
3409 PP(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
3420 PP(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
3431 PP(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
3442 PP(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
3453 PP(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
3465 PP(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
3477 PP(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
3489 PP(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
3501 PP(pp_gpwnam)
3502 {
3503 #ifdef HAS_PASSWD
3504     return pp_gpwent(ARGS);
3505 #else
3506     DIE(no_func, "getpwnam");
3507 #endif
3508 }
3509
3510 PP(pp_gpwuid)
3511 {
3512 #ifdef HAS_PASSWD
3513     return pp_gpwent(ARGS);
3514 #else
3515     DIE(no_func, "getpwuid");
3516 #endif
3517 }
3518
3519 PP(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
3592 PP(pp_spwent)
3593 {
3594     dSP;
3595 #ifdef HAS_PASSWD
3596     setpwent();
3597     RETPUSHYES;
3598 #else
3599     DIE(no_func, "setpwent");
3600 #endif
3601 }
3602
3603 PP(pp_epwent)
3604 {
3605     dSP;
3606 #ifdef HAS_PASSWD
3607     endpwent();
3608     RETPUSHYES;
3609 #else
3610     DIE(no_func, "endpwent");
3611 #endif
3612 }
3613
3614 PP(pp_ggrnam)
3615 {
3616 #ifdef HAS_GROUP
3617     return pp_ggrent(ARGS);
3618 #else
3619     DIE(no_func, "getgrnam");
3620 #endif
3621 }
3622
3623 PP(pp_ggrgid)
3624 {
3625 #ifdef HAS_GROUP
3626     return pp_ggrent(ARGS);
3627 #else
3628     DIE(no_func, "getgrgid");
3629 #endif
3630 }
3631
3632 PP(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
3681 PP(pp_sgrent)
3682 {
3683     dSP;
3684 #ifdef HAS_GROUP
3685     setgrent();
3686     RETPUSHYES;
3687 #else
3688     DIE(no_func, "setgrent");
3689 #endif
3690 }
3691
3692 PP(pp_egrent)
3693 {
3694     dSP;
3695 #ifdef HAS_GROUP
3696     endgrent();
3697     RETPUSHYES;
3698 #else
3699     DIE(no_func, "endgrent");
3700 #endif
3701 }
3702
3703 PP(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
3720 PP(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