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