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