home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / MacPerl 5.1.3 / Mac_Perl_513_src / perl5.002 / doio.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-10-20  |  32.6 KB  |  1,644 lines  |  [TEXT/MPS ]
  1. /*    doio.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.  * "Far below them they saw the white waters pour into a foaming bowl, and
  12.  * then swirl darkly about a deep oval basin in the rocks, until they found
  13.  * their way out again through a narrow gate, and flowed away, fuming and
  14.  * chattering, into calmer and more level reaches."
  15.  */
  16.  
  17. #include "EXTERN.h"
  18. #include "perl.h"
  19.  
  20. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  21. #include <sys/ipc.h>
  22. #ifdef HAS_MSG
  23. #include <sys/msg.h>
  24. #endif
  25. #ifdef HAS_SEM
  26. #include <sys/sem.h>
  27. #endif
  28. #ifdef HAS_SHM
  29. #include <sys/shm.h>
  30. # ifndef HAS_SHMAT_PROTOTYPE
  31.     extern Shmat_t shmat _((int, char *, int));
  32. # endif
  33. #endif
  34. #endif
  35.  
  36. #ifdef I_UTIME
  37. #include <utime.h>
  38. #endif
  39. #ifdef I_FCNTL
  40. #include <fcntl.h>
  41. #endif
  42. #ifdef I_SYS_FILE
  43. #include <sys/file.h>
  44. #endif
  45.  
  46. #if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */
  47. # include <sys/socket.h>
  48. # include <netdb.h>
  49. # ifndef ENOTSOCK
  50. #  ifdef I_NET_ERRNO
  51. #   include <net/errno.h>
  52. #  endif
  53. # endif
  54. #endif
  55.  
  56. bool
  57. do_open(gv,name,len,as_raw,rawmode,rawperm,supplied_fp)
  58. GV *gv;
  59. register char *name;
  60. I32 len;
  61. int as_raw;
  62. int rawmode, rawperm;
  63. FILE *supplied_fp;
  64. {
  65.     register IO *io = GvIOn(gv);
  66.     FILE *saveifp = Nullfp;
  67.     FILE *saveofp = Nullfp;
  68.     char savetype = ' ';
  69.     int writing = 0;
  70.     FILE *fp;
  71.     int fd;
  72.     int result;
  73.  
  74.     forkprocess = 1;        /* assume true if no fork */
  75.  
  76.     if (IoIFP(io)) {
  77.     fd = fileno(IoIFP(io));
  78.     if (IoTYPE(io) == '-')
  79.         result = 0;
  80.     else if (fd <= maxsysfd) {
  81.         saveifp = IoIFP(io);
  82.         saveofp = IoOFP(io);
  83.         savetype = IoTYPE(io);
  84.         result = 0;
  85.     }
  86.     else if (IoTYPE(io) == '|')
  87.         result = my_pclose(IoIFP(io));
  88.     else if (IoIFP(io) != IoOFP(io)) {
  89.         if (IoOFP(io)) {
  90.         result = fclose(IoOFP(io));
  91.         fclose(IoIFP(io));    /* clear stdio, fd already closed */
  92.         }
  93.         else
  94.         result = fclose(IoIFP(io));
  95.     }
  96.     else
  97.         result = fclose(IoIFP(io));
  98.     if (result == EOF && fd > maxsysfd)
  99.         fprintf(stderr,"Warning: unable to close filehandle %s properly.\n",
  100.           GvENAME(gv));
  101.     IoOFP(io) = IoIFP(io) = Nullfp;
  102.     }
  103.  
  104.     if (as_raw) {
  105.     result = rawmode & 3;
  106.     IoTYPE(io) = "<>++"[result];
  107.     writing = (result > 0);
  108.     fd = open(name, rawmode, rawperm);
  109.     if (fd == -1)
  110.         fp = NULL;
  111.     else {
  112.         fp = fdopen(fd, ((result == 0) ? "r"
  113.                  : (result == 1) ? "w"
  114.                  : "r+"));
  115.         if (!fp)
  116.         close(fd);
  117.     }
  118.     }
  119.     else {
  120.     char *myname;
  121.     char mode[3];        /* stdio file mode ("r\0" or "r+\0") */
  122.     int dodup;
  123.  
  124.     myname = savepvn(name, len);
  125.     SAVEFREEPV(myname);
  126.     name = myname;
  127.     while (len && isSPACE(name[len-1]))
  128.         name[--len] = '\0';
  129.  
  130.     mode[0] = mode[1] = mode[2] = '\0';
  131.     IoTYPE(io) = *name;
  132.     if (*name == '+' && len > 1 && name[len-1] != '|') { /* scary */
  133.         mode[1] = *name++;
  134.         --len;
  135.         writing = 1;
  136.     }
  137.  
  138.     if (*name == '|') {
  139.         /*SUPPRESS 530*/
  140.         for (name++; isSPACE(*name); name++) ;
  141.         if (strNE(name,"-"))
  142.         TAINT_ENV();
  143.         TAINT_PROPER("piped open");
  144.         if (dowarn && name[strlen(name)-1] == '|')
  145.         warn("Can't do bidirectional pipe");
  146.         fp = my_popen(name,"w");
  147.         writing = 1;
  148.     }
  149.     else if (*name == '>') {
  150.         TAINT_PROPER("open");
  151.         name++;
  152.         if (*name == '>') {
  153.         mode[0] = IoTYPE(io) = 'a';
  154.         name++;
  155.         }
  156.         else
  157.         mode[0] = 'w';
  158.         writing = 1;
  159.  
  160.         if (*name == '&') {
  161.           duplicity:
  162.         dodup = 1;
  163.         name++;
  164.         if (*name == '=') {
  165.             dodup = 0;
  166.             name++;
  167.         }
  168.         if (!*name && supplied_fp)
  169.             fp = supplied_fp;
  170.         else {
  171.             /*SUPPRESS 530*/
  172.             for (; isSPACE(*name); name++) ;
  173.             if (isDIGIT(*name))
  174.             fd = atoi(name);
  175.             else {
  176.             IO* thatio;
  177.             gv = gv_fetchpv(name,FALSE,SVt_PVIO);
  178.             thatio = GvIO(gv);
  179.             if (!thatio) {
  180. #ifdef EINVAL
  181.                 SETERRNO(EINVAL,SS$_IVCHAN);
  182. #endif
  183.                 goto say_false;
  184.             }
  185.             if (IoIFP(thatio)) {
  186.                 fd = fileno(IoIFP(thatio));
  187.                 if (IoTYPE(thatio) == 's')
  188.                 IoTYPE(io) = 's';
  189.             }
  190.             else
  191.                 fd = -1;
  192.             }
  193.             if (dodup)
  194.             fd = dup(fd);
  195.             if (!(fp = fdopen(fd,mode)))
  196.             if (dodup)
  197.                 close(fd);
  198.         }
  199.         }
  200.         else {
  201.         /*SUPPRESS 530*/
  202.         for (; isSPACE(*name); name++) ;
  203.         if (strEQ(name,"-")) {
  204.             fp = stdout;
  205.             IoTYPE(io) = '-';
  206.         }
  207.         else {
  208.             fp = fopen(name,mode);
  209.         }
  210.         }
  211.     }
  212.     else if (*name == '<') {
  213.         /*SUPPRESS 530*/
  214.         for (name++; isSPACE(*name); name++) ;
  215.         mode[0] = 'r';
  216.         if (*name == '&')
  217.         goto duplicity;
  218.         if (strEQ(name,"-")) {
  219.         fp = stdin;
  220.         IoTYPE(io) = '-';
  221.         }
  222.         else
  223.         fp = fopen(name,mode);
  224.     }
  225.     else if (name[len-1] == '|') {
  226.         name[--len] = '\0';
  227.         while (len && isSPACE(name[len-1]))
  228.         name[--len] = '\0';
  229.         /*SUPPRESS 530*/
  230.         for (; isSPACE(*name); name++) ;
  231.         if (strNE(name,"-"))
  232.         TAINT_ENV();
  233.         TAINT_PROPER("piped open");
  234.         fp = my_popen(name,"r");
  235.         IoTYPE(io) = '|';
  236.     }
  237.     else {
  238.         IoTYPE(io) = '<';
  239.         /*SUPPRESS 530*/
  240.         for (; isSPACE(*name); name++) ;
  241.         if (strEQ(name,"-")) {
  242.         fp = stdin;
  243.         IoTYPE(io) = '-';
  244.         }
  245.         else
  246.         fp = fopen(name,"r");
  247.     }
  248.     }
  249.     if (!fp) {
  250.     if (dowarn && IoTYPE(io) == '<' && strchr(name, '\n'))
  251.         warn(warn_nl, "open");
  252.     goto say_false;
  253.     }
  254.     if (IoTYPE(io) &&
  255.       IoTYPE(io) != '|' && IoTYPE(io) != '-') {
  256.     if (Fstat(fileno(fp),&statbuf) < 0) {
  257.         (void)fclose(fp);
  258.         goto say_false;
  259.     }
  260.     if (S_ISSOCK(statbuf.st_mode))
  261.         IoTYPE(io) = 's';    /* in case a socket was passed in to us */
  262. #ifdef HAS_SOCKET
  263.     else if (
  264. #ifdef S_IFMT
  265.         !(statbuf.st_mode & S_IFMT)
  266. #else
  267.         !statbuf.st_mode
  268. #endif
  269.     ) {
  270.         int buflen = sizeof tokenbuf;
  271.         if (getsockname(fileno(fp), (struct sockaddr *)tokenbuf, &buflen) >= 0
  272.         || errno != ENOTSOCK)
  273.         IoTYPE(io) = 's'; /* some OS's return 0 on fstat()ed socket */
  274.                 /* but some return 0 for streams too, sigh */
  275.     }
  276. #endif
  277.     }
  278.     if (saveifp) {        /* must use old fp? */
  279.     fd = fileno(saveifp);
  280.     if (saveofp) {
  281.         Fflush(saveofp);        /* emulate fclose() */
  282.         if (saveofp != saveifp) {    /* was a socket? */
  283.         fclose(saveofp);
  284.         if (fd > 2)
  285.             Safefree(saveofp);
  286.         }
  287.     }
  288.     if (fd != fileno(fp)) {
  289.         int pid;
  290.         SV *sv;
  291.  
  292.         dup2(fileno(fp), fd);
  293.         sv = *av_fetch(fdpid,fileno(fp),TRUE);
  294.         (void)SvUPGRADE(sv, SVt_IV);
  295.         pid = SvIVX(sv);
  296.         SvIVX(sv) = 0;
  297.         sv = *av_fetch(fdpid,fd,TRUE);
  298.         (void)SvUPGRADE(sv, SVt_IV);
  299.         SvIVX(sv) = pid;
  300.         fclose(fp);
  301.  
  302.     }
  303.     fp = saveifp;
  304.     clearerr(fp);
  305.     }
  306. #if defined(HAS_FCNTL) && defined(F_SETFD)
  307.     fd = fileno(fp);
  308.     fcntl(fd,F_SETFD,fd > maxsysfd);
  309. #endif
  310.     IoIFP(io) = fp;
  311.     if (writing) {
  312.     if (IoTYPE(io) == 's'
  313.       || (IoTYPE(io) == '>' && S_ISCHR(statbuf.st_mode)) ) {
  314.         if (!(IoOFP(io) = fdopen(fileno(fp),"w"))) {
  315.         fclose(fp);
  316.         IoIFP(io) = Nullfp;
  317.         goto say_false;
  318.         }
  319.     }
  320.     else
  321.         IoOFP(io) = fp;
  322.     }
  323.     return TRUE;
  324.  
  325. say_false:
  326.     IoIFP(io) = saveifp;
  327.     IoOFP(io) = saveofp;
  328.     IoTYPE(io) = savetype;
  329.     return FALSE;
  330. }
  331.  
  332. #ifdef macintosh
  333. #include <Files.h>
  334.  
  335. static FSSpec    EphTemp;
  336. static Boolean    HasEphKiller;
  337.  
  338. void EphKiller()
  339. {
  340.     if (EphTemp.name[0]) {
  341.         HDelete(EphTemp.vRefNum, EphTemp.parID, EphTemp.name);
  342.     EphTemp.name[0] = 0;
  343.     }
  344.     HasEphKiller = false;
  345. }
  346.  
  347. int Ephemeralize(char * name)
  348. {
  349.     FSSpec  old;
  350.     
  351.     if (Path2FSSpec(name, &old))
  352.         return ENOENT;
  353.     if (EphTemp.name[0] && EphTemp.vRefNum != old.vRefNum) {
  354.         HDelete(EphTemp.vRefNum, EphTemp.parID, EphTemp.name);
  355.     EphTemp.name[0] = 0;
  356.     }
  357.     if (!EphTemp.name[0] && Special2FSSpec('TMPF', old.vRefNum, 0, &EphTemp))
  358.         goto permErr;
  359.     
  360.     if (FSpSmartMove(&old, &EphTemp))
  361.         goto permErr;
  362.  
  363.     if (!HasEphKiller) {
  364.         atexit(EphKiller);
  365.     
  366.     HasEphKiller = true;
  367.     }
  368.  
  369.     return 0;
  370. permErr:
  371.     EphTemp.name[0] = 0;
  372.     
  373.     return EPERM;
  374. }
  375. #endif
  376.  
  377. FILE *
  378. nextargv(gv)
  379. register GV *gv;
  380. {
  381.     register SV *sv;
  382. #ifndef FLEXFILENAMES
  383.     int filedev;
  384.     int fileino;
  385. #endif
  386.     int fileuid;
  387.     int filegid;
  388.  
  389.     if (!argvoutgv)
  390.     argvoutgv = gv_fetchpv("ARGVOUT",TRUE,SVt_PVIO);
  391.     if (filemode & (S_ISUID|S_ISGID)) {
  392.     Fflush(IoIFP(GvIOn(argvoutgv)));  /* chmod must follow last write */
  393. #ifdef HAS_FCHMOD
  394.     (void)fchmod(lastfd,filemode);
  395. #else
  396.     (void)chmod(oldname,filemode);
  397. #endif
  398.     }
  399.     filemode = 0;
  400.     while (av_len(GvAV(gv)) >= 0) {
  401.     STRLEN len;
  402.     sv = av_shift(GvAV(gv));
  403.     SAVEFREESV(sv);
  404.     sv_setsv(GvSV(gv),sv);
  405.     SvSETMAGIC(GvSV(gv));
  406.     oldname = SvPVx(GvSV(gv), len);
  407.     if (do_open(gv,oldname,len,FALSE,0,0,Nullfp)) {
  408.         if (inplace) {
  409.         TAINT_PROPER("inplace open");
  410.         if (strEQ(oldname,"-")) {
  411.             setdefout(gv_fetchpv("STDOUT",TRUE,SVt_PVIO));
  412.             return IoIFP(GvIOp(gv));
  413.         }
  414. #ifndef FLEXFILENAMES
  415.         filedev = statbuf.st_dev;
  416.         fileino = statbuf.st_ino;
  417. #endif
  418.         filemode = statbuf.st_mode;
  419.         fileuid = statbuf.st_uid;
  420.         filegid = statbuf.st_gid;
  421.         if (!S_ISREG(filemode)) {
  422.             warn("Can't do inplace edit: %s is not a regular file",
  423.               oldname );
  424.             do_close(gv,FALSE);
  425.             continue;
  426.         }
  427.         if (*inplace) {
  428. #ifdef SUFFIX
  429.             add_suffix(sv,inplace);
  430. #else
  431.             sv_catpv(sv,inplace);
  432. #endif
  433. #ifndef FLEXFILENAMES
  434.             if (Stat(SvPVX(sv),&statbuf) >= 0
  435.               && statbuf.st_dev == filedev
  436.               && statbuf.st_ino == fileino ) {
  437.             warn("Can't do inplace edit: %s > 14 characters",
  438.               SvPVX(sv) );
  439.             do_close(gv,FALSE);
  440.             continue;
  441.             }
  442. #endif
  443. #ifdef HAS_RENAME
  444. #ifndef DOSISH
  445.             if (rename(oldname,SvPVX(sv)) < 0) {
  446.             warn("Can't rename %s to %s: %s, skipping file",
  447.               oldname, SvPVX(sv), Strerror(errno) );
  448.             do_close(gv,FALSE);
  449.             continue;
  450.             }
  451. #else
  452.             do_close(gv,FALSE);
  453.             (void)unlink(SvPVX(sv));
  454.             (void)rename(oldname,SvPVX(sv));
  455.             do_open(gv,SvPVX(sv),SvCUR(sv),FALSE,0,0,Nullfp);
  456. #endif /* MSDOS */
  457. #else
  458.             (void)UNLINK(SvPVX(sv));
  459.             if (link(oldname,SvPVX(sv)) < 0) {
  460.             warn("Can't rename %s to %s: %s, skipping file",
  461.               oldname, SvPVX(sv), Strerror(errno) );
  462.             do_close(gv,FALSE);
  463.             continue;
  464.             }
  465.             (void)UNLINK(oldname);
  466. #endif
  467.         }
  468.         else {
  469. #ifdef macintosh
  470.             if (errno = Ephemeralize(oldname)) {
  471.             warn("Can't rename %s to %s: %s, skipping file",
  472.               oldname, SvPVX(sv), Strerror(errno) );
  473.             do_close(gv,FALSE);
  474.             continue;
  475.             }
  476. #else
  477. #ifndef DOSISH
  478.             if (UNLINK(oldname) < 0) {
  479.             warn("Can't rename %s to %s: %s, skipping file",
  480.               oldname, SvPVX(sv), Strerror(errno) );
  481.             do_close(gv,FALSE);
  482.             continue;
  483.             }
  484. #else
  485.             croak("Can't do inplace edit without backup");
  486. #endif
  487. #endif
  488.         }
  489.  
  490.         sv_setpvn(sv,">",1);
  491.         sv_catpv(sv,oldname);
  492.         SETERRNO(0,0);        /* in case sprintf set errno */
  493.         if (!do_open(argvoutgv,SvPVX(sv),SvCUR(sv),FALSE,0,0,Nullfp)) {
  494.             warn("Can't do inplace edit on %s: %s",
  495.               oldname, Strerror(errno) );
  496.             do_close(gv,FALSE);
  497.             continue;
  498.         }
  499.         setdefout(argvoutgv);
  500.         lastfd = fileno(IoIFP(GvIOp(argvoutgv)));
  501.         (void)Fstat(lastfd,&statbuf);
  502. #ifdef HAS_FCHMOD
  503.         (void)fchmod(lastfd,filemode);
  504. #else
  505.         (void)chmod(oldname,filemode);
  506. #endif
  507.         if (fileuid != statbuf.st_uid || filegid != statbuf.st_gid) {
  508. #ifdef HAS_FCHOWN
  509.             (void)fchown(lastfd,fileuid,filegid);
  510. #else
  511. #ifdef HAS_CHOWN
  512.             (void)chown(oldname,fileuid,filegid);
  513. #endif
  514. #endif
  515.         }
  516.         }
  517.         return IoIFP(GvIOp(gv));
  518.     }
  519.     else
  520. #ifdef macintosh
  521.         fprintf(stderr,"# Can't open %s: %s\n",SvPV(sv, na), Strerror(errno));
  522. #else
  523.         fprintf(stderr,"Can't open %s: %s\n",SvPV(sv, na), Strerror(errno));
  524. #endif
  525.     }
  526.     if (inplace) {
  527.     (void)do_close(argvoutgv,FALSE);
  528.     setdefout(gv_fetchpv("STDOUT",TRUE,SVt_PVIO));
  529.     }
  530.     return Nullfp;
  531. }
  532.  
  533. #ifdef HAS_PIPE
  534. void
  535. do_pipe(sv, rgv, wgv)
  536. SV *sv;
  537. GV *rgv;
  538. GV *wgv;
  539. {
  540.     register IO *rstio;
  541.     register IO *wstio;
  542.     int fd[2];
  543.  
  544.     if (!rgv)
  545.     goto badexit;
  546.     if (!wgv)
  547.     goto badexit;
  548.  
  549.     rstio = GvIOn(rgv);
  550.     wstio = GvIOn(wgv);
  551.  
  552.     if (IoIFP(rstio))
  553.     do_close(rgv,FALSE);
  554.     if (IoIFP(wstio))
  555.     do_close(wgv,FALSE);
  556.  
  557.     if (pipe(fd) < 0)
  558.     goto badexit;
  559.     IoIFP(rstio) = fdopen(fd[0], "r");
  560.     IoOFP(wstio) = fdopen(fd[1], "w");
  561.     IoIFP(wstio) = IoOFP(wstio);
  562.     IoTYPE(rstio) = '<';
  563.     IoTYPE(wstio) = '>';
  564.     if (!IoIFP(rstio) || !IoOFP(wstio)) {
  565.     if (IoIFP(rstio)) fclose(IoIFP(rstio));
  566.     else close(fd[0]);
  567.     if (IoOFP(wstio)) fclose(IoOFP(wstio));
  568.     else close(fd[1]);
  569.     goto badexit;
  570.     }
  571.  
  572.     sv_setsv(sv,&sv_yes);
  573.     return;
  574.  
  575. badexit:
  576.     sv_setsv(sv,&sv_undef);
  577.     return;
  578. }
  579. #endif
  580.  
  581. bool
  582. #ifndef CAN_PROTOTYPE
  583. do_close(gv,explicit)
  584. GV *gv;
  585. bool explicit;
  586. #else
  587. do_close(GV *gv, bool explicit)
  588. #endif /* CAN_PROTOTYPE */
  589. {
  590.     bool retval;
  591.     IO *io;
  592.  
  593.     if (!gv)
  594.     gv = argvgv;
  595.     if (!gv || SvTYPE(gv) != SVt_PVGV) {
  596.     SETERRNO(EBADF,SS$_IVCHAN);
  597.     return FALSE;
  598.     }
  599.     io = GvIO(gv);
  600.     if (!io) {        /* never opened */
  601.     if (dowarn && explicit)
  602.         warn("Close on unopened file <%s>",GvENAME(gv));
  603.     return FALSE;
  604.     }
  605.     retval = io_close(io);
  606.     if (explicit) {
  607.     IoLINES(io) = 0;
  608.     IoPAGE(io) = 0;
  609.     IoLINES_LEFT(io) = IoPAGE_LEN(io);
  610.     }
  611.     IoTYPE(io) = ' ';
  612.     return retval;
  613. }
  614.  
  615. bool
  616. io_close(io)
  617. IO* io;
  618. {
  619.     bool retval = FALSE;
  620.     int status;
  621.  
  622.     if (IoIFP(io)) {
  623.     if (IoTYPE(io) == '|') {
  624.         status = my_pclose(IoIFP(io));
  625.         retval = (status == 0);
  626.         statusvalue = FIXSTATUS(status);
  627.     }
  628.     else if (IoTYPE(io) == '-')
  629.         retval = TRUE;
  630.     else {
  631.         if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {        /* a socket */
  632.         retval = (fclose(IoOFP(io)) != EOF);
  633.         fclose(IoIFP(io));    /* clear stdio, fd already closed */
  634.         }
  635.         else
  636.         retval = (fclose(IoIFP(io)) != EOF);
  637.     }
  638.     IoOFP(io) = IoIFP(io) = Nullfp;
  639.     }
  640.  
  641.     return retval;
  642. }
  643.  
  644. bool
  645. do_eof(gv)
  646. GV *gv;
  647. {
  648.     register IO *io;
  649.     int ch;
  650.  
  651.     io = GvIO(gv);
  652.  
  653.     if (!io)
  654.     return TRUE;
  655.  
  656.     while (IoIFP(io)) {
  657.  
  658. #ifdef USE_STDIO_PTR            /* (the code works without this) */
  659.     if (FILE_cnt(IoIFP(io)) > 0)    /* cheat a little, since */
  660.         return FALSE;        /* this is the most usual case */
  661. #endif
  662.  
  663.     ch = getc(IoIFP(io));
  664.     if (ch != EOF) {
  665.         (void)ungetc(ch, IoIFP(io));
  666.         return FALSE;
  667.     }
  668. #if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
  669.     if (FILE_cnt(IoIFP(io)) < -1)
  670.         FILE_cnt(IoIFP(io)) = -1;
  671. #endif
  672.     if (op->op_flags & OPf_SPECIAL) { /* not necessarily a real EOF yet? */
  673.         if (!nextargv(argvgv))    /* get another fp handy */
  674.         return TRUE;
  675.     }
  676.     else
  677.         return TRUE;        /* normal fp, definitely end of file */
  678.     }
  679.     return TRUE;
  680. }
  681.  
  682. long
  683. do_tell(gv)
  684. GV *gv;
  685. {
  686.     register IO *io;
  687.  
  688.     if (!gv)
  689.     goto phooey;
  690.  
  691.     io = GvIO(gv);
  692.     if (!io || !IoIFP(io))
  693.     goto phooey;
  694.  
  695. #ifdef ULTRIX_STDIO_BOTCH
  696.     if (feof(IoIFP(io)))
  697.     (void)fseek (IoIFP(io), 0L, 2);        /* ultrix 1.2 workaround */
  698. #endif
  699.  
  700.     return ftell(IoIFP(io));
  701.  
  702. phooey:
  703.     if (dowarn)
  704.     warn("tell() on unopened file");
  705.     SETERRNO(EBADF,RMS$_IFI);
  706.     return -1L;
  707. }
  708.  
  709. bool
  710. do_seek(gv, pos, whence)
  711. GV *gv;
  712. long pos;
  713. int whence;
  714. {
  715.     register IO *io;
  716.  
  717.     if (!gv)
  718.     goto nuts;
  719.  
  720.     io = GvIO(gv);
  721.     if (!io || !IoIFP(io))
  722.     goto nuts;
  723.  
  724. #ifdef ULTRIX_STDIO_BOTCH
  725.     if (feof(IoIFP(io)))
  726.     (void)fseek (IoIFP(io), 0L, 2);        /* ultrix 1.2 workaround */
  727. #endif
  728.  
  729.     return fseek(IoIFP(io), pos, whence) >= 0;
  730.  
  731. nuts:
  732.     if (dowarn)
  733.     warn("seek() on unopened file");
  734.     SETERRNO(EBADF,RMS$_IFI);
  735.     return FALSE;
  736. }
  737.  
  738. #if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP)
  739.     /* code courtesy of William Kucharski */
  740. #define HAS_CHSIZE
  741.  
  742. I32 chsize(fd, length)
  743. I32 fd;            /* file descriptor */
  744. Off_t length;        /* length to set file to */
  745. {
  746.     extern long lseek();
  747.     struct flock fl;
  748.     struct stat filebuf;
  749.  
  750.     if (Fstat(fd, &filebuf) < 0)
  751.     return -1;
  752.  
  753.     if (filebuf.st_size < length) {
  754.  
  755.     /* extend file length */
  756.  
  757.     if ((lseek(fd, (length - 1), 0)) < 0)
  758.         return -1;
  759.  
  760.     /* write a "0" byte */
  761.  
  762.     if ((write(fd, "", 1)) != 1)
  763.         return -1;
  764.     }
  765.     else {
  766.     /* truncate length */
  767.  
  768.     fl.l_whence = 0;
  769.     fl.l_len = 0;
  770.     fl.l_start = length;
  771.     fl.l_type = F_WRLCK;    /* write lock on file space */
  772.  
  773.     /*
  774.     * This relies on the UNDOCUMENTED F_FREESP argument to
  775.     * fcntl(2), which truncates the file so that it ends at the
  776.     * position indicated by fl.l_start.
  777.     *
  778.     * Will minor miracles never cease?
  779.     */
  780.  
  781.     if (fcntl(fd, F_FREESP, &fl) < 0)
  782.         return -1;
  783.  
  784.     }
  785.  
  786.     return 0;
  787. }
  788. #endif /* F_FREESP */
  789.  
  790. I32
  791. looks_like_number(sv)
  792. SV *sv;
  793. {
  794.     register char *s;
  795.     register char *send;
  796.  
  797.     if (!SvPOK(sv)) {
  798.     STRLEN len;
  799.     if (!SvPOKp(sv))
  800.         return TRUE;
  801.     s = SvPV(sv, len);
  802.     send = s + len;
  803.     }
  804.     else {
  805.     s = SvPVX(sv); 
  806.     send = s + SvCUR(sv);
  807.     }
  808.     while (isSPACE(*s))
  809.     s++;
  810.     if (s >= send)
  811.     return FALSE;
  812.     if (*s == '+' || *s == '-')
  813.     s++;
  814.     while (isDIGIT(*s))
  815.     s++;
  816.     if (s == send)
  817.     return TRUE;
  818.     if (*s == '.') 
  819.     s++;
  820.     else if (s == SvPVX(sv))
  821.     return FALSE;
  822.     while (isDIGIT(*s))
  823.     s++;
  824.     if (s == send)
  825.     return TRUE;
  826.     if (*s == 'e' || *s == 'E') {
  827.     s++;
  828.     if (*s == '+' || *s == '-')
  829.         s++;
  830.     while (isDIGIT(*s))
  831.         s++;
  832.     }
  833.     while (isSPACE(*s))
  834.     s++;
  835.     if (s >= send)
  836.     return TRUE;
  837.     return FALSE;
  838. }
  839.  
  840. bool
  841. do_print(sv,fp)
  842. register SV *sv;
  843. FILE *fp;
  844. {
  845.     register char *tmps;
  846.     STRLEN len;
  847.  
  848.     /* assuming fp is checked earlier */
  849.     if (!sv)
  850.     return TRUE;
  851.     if (ofmt) {
  852.     if (SvGMAGICAL(sv))
  853.         mg_get(sv);
  854.         if (SvIOK(sv) && SvIVX(sv) != 0) {
  855.         fprintf(fp, ofmt, (double)SvIVX(sv));
  856.         return !ferror(fp);
  857.     }
  858.     if (  (SvNOK(sv) && SvNVX(sv) != 0.0)
  859.        || (looks_like_number(sv) && sv_2nv(sv) != 0.0) ) {
  860.         fprintf(fp, ofmt, SvNVX(sv));
  861.         return !ferror(fp);
  862.     }
  863.     }
  864.     switch (SvTYPE(sv)) {
  865.     case SVt_NULL:
  866.     if (dowarn)
  867.         warn(warn_uninit);
  868.     return TRUE;
  869.     case SVt_IV:
  870.     if (SvIOK(sv)) {
  871.         if (SvGMAGICAL(sv))
  872.         mg_get(sv);
  873.         fprintf(fp, "%ld", (long)SvIVX(sv));
  874.         return !ferror(fp);
  875.     }
  876.     /* FALL THROUGH */
  877.     default:
  878.     tmps = SvPV(sv, len);
  879.     break;
  880.     }
  881.     if (len && (fwrite1(tmps,1,len,fp) == 0 || ferror(fp)))
  882.     return FALSE;
  883.     return TRUE;
  884. }
  885.  
  886. I32
  887. my_stat(ARGS)
  888. dARGS
  889. {
  890.     dSP;
  891.     IO *io;
  892.     GV* tmpgv;
  893.  
  894.     if (op->op_flags & OPf_REF) {
  895.     EXTEND(sp,1);
  896.     tmpgv = cGVOP->op_gv;
  897.       do_fstat:
  898.     io = GvIO(tmpgv);
  899.     if (io && IoIFP(io)) {
  900.         statgv = tmpgv;
  901.         sv_setpv(statname,"");
  902.         laststype = OP_STAT;
  903.         return (laststatval = Fstat(fileno(IoIFP(io)), &statcache));
  904.     }
  905.     else {
  906.         if (tmpgv == defgv)
  907.         return laststatval;
  908.         if (dowarn)
  909.         warn("Stat on unopened file <%s>",
  910.           GvENAME(tmpgv));
  911.         statgv = Nullgv;
  912.         sv_setpv(statname,"");
  913.         return (laststatval = -1);
  914.     }
  915.     }
  916.     else {
  917.     SV* sv = POPs;
  918.     PUTBACK;
  919.     if (SvTYPE(sv) == SVt_PVGV) {
  920.         tmpgv = (GV*)sv;
  921.         goto do_fstat;
  922.     }
  923.     else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
  924.         tmpgv = (GV*)SvRV(sv);
  925.         goto do_fstat;
  926.     }
  927.  
  928.     statgv = Nullgv;
  929.     sv_setpv(statname,SvPV(sv, na));
  930.     laststype = OP_STAT;
  931.     laststatval = Stat(SvPV(sv, na),&statcache);
  932.     if (laststatval < 0 && dowarn && strchr(SvPV(sv, na), '\n'))
  933.         warn(warn_nl, "stat");
  934.     return laststatval;
  935.     }
  936. }
  937.  
  938. I32
  939. my_lstat(ARGS)
  940. dARGS
  941. {
  942.     dSP;
  943.     SV *sv;
  944.     if (op->op_flags & OPf_REF) {
  945.     EXTEND(sp,1);
  946.     if (cGVOP->op_gv == defgv) {
  947.         if (laststype != OP_LSTAT)
  948.         croak("The stat preceding -l _ wasn't an lstat");
  949.         return laststatval;
  950.     }
  951.     croak("You can't use -l on a filehandle");
  952.     }
  953.  
  954.     laststype = OP_LSTAT;
  955.     statgv = Nullgv;
  956.     sv = POPs;
  957.     PUTBACK;
  958.     sv_setpv(statname,SvPV(sv, na));
  959. #ifdef HAS_LSTAT
  960.     laststatval = lstat(SvPV(sv, na),&statcache);
  961. #else
  962.     laststatval = Stat(SvPV(sv, na),&statcache);
  963. #endif
  964.     if (laststatval < 0 && dowarn && strchr(SvPV(sv, na), '\n'))
  965.     warn(warn_nl, "lstat");
  966.     return laststatval;
  967. }
  968.  
  969. bool
  970. do_aexec(really,mark,sp)
  971. SV *really;
  972. register SV **mark;
  973. register SV **sp;
  974. {
  975. #ifdef macintosh
  976.     croak("exec? I'm not *that* kind of operating system");
  977. #else
  978.     register char **a;
  979.     char *tmps;
  980.  
  981.     if (sp > mark) {
  982.     New(401,Argv, sp - mark + 1, char*);
  983.     a = Argv;
  984.     while (++mark <= sp) {
  985.         if (*mark)
  986.         *a++ = SvPVx(*mark, na);
  987.         else
  988.         *a++ = "";
  989.     }
  990.     *a = Nullch;
  991.     if (*Argv[0] != '/')    /* will execvp use PATH? */
  992.         TAINT_ENV();        /* testing IFS here is overkill, probably */
  993.     if (really && *(tmps = SvPV(really, na)))
  994.         execvp(tmps,Argv);
  995.     else
  996.         execvp(Argv[0],Argv);
  997.     if (dowarn)
  998.         warn("Can't exec \"%s\": %s", Argv[0], Strerror(errno));
  999.     }
  1000.     do_execfree();
  1001. #endif
  1002.     return FALSE;
  1003. }
  1004.  
  1005. void
  1006. do_execfree()
  1007. {
  1008.     if (Argv) {
  1009.     Safefree(Argv);
  1010.     Argv = Null(char **);
  1011.     }
  1012.     if (Cmd) {
  1013.     Safefree(Cmd);
  1014.     Cmd = Nullch;
  1015.     }
  1016. }
  1017.  
  1018. bool
  1019. do_exec(cmd)
  1020. char *cmd;
  1021. {
  1022. #ifdef macintosh
  1023.     croak("exec? I'm not *that* kind of operating system");
  1024. #else
  1025.     register char **a;
  1026.     register char *s;
  1027.     char flags[10];
  1028.  
  1029.     while (*cmd && isSPACE(*cmd))
  1030.     cmd++;
  1031.  
  1032.     /* save an extra exec if possible */
  1033.  
  1034. #ifdef CSH
  1035.     if (strnEQ(cmd,cshname,cshlen) && strnEQ(cmd+cshlen," -c",3)) {
  1036.     strcpy(flags,"-c");
  1037.     s = cmd+cshlen+3;
  1038.     if (*s == 'f') {
  1039.         s++;
  1040.         strcat(flags,"f");
  1041.     }
  1042.     if (*s == ' ')
  1043.         s++;
  1044.     if (*s++ == '\'') {
  1045.         char *ncmd = s;
  1046.  
  1047.         while (*s)
  1048.         s++;
  1049.         if (s[-1] == '\n')
  1050.         *--s = '\0';
  1051.         if (s[-1] == '\'') {
  1052.         *--s = '\0';
  1053.         execl(cshname,"csh", flags,ncmd,(char*)0);
  1054.         *s = '\'';
  1055.         return FALSE;
  1056.         }
  1057.     }
  1058.     }
  1059. #endif /* CSH */
  1060.  
  1061.     /* see if there are shell metacharacters in it */
  1062.  
  1063.     if (*cmd == '.' && isSPACE(cmd[1]))
  1064.     goto doshell;
  1065.  
  1066.     if (strnEQ(cmd,"exec",4) && isSPACE(cmd[4]))
  1067.     goto doshell;
  1068.  
  1069.     for (s = cmd; *s && isALPHA(*s); s++) ;    /* catch VAR=val gizmo */
  1070.     if (*s == '=')
  1071.     goto doshell;
  1072.  
  1073.     for (s = cmd; *s; s++) {
  1074.     if (*s != ' ' && !isALPHA(*s) && strchr("$&*(){}[]'\";\\|?<>~`\n",*s)) {
  1075.         if (*s == '\n' && !s[1]) {
  1076.         *s = '\0';
  1077.         break;
  1078.         }
  1079.       doshell:
  1080.         execl("/bin/sh","sh","-c",cmd,(char*)0);
  1081.         return FALSE;
  1082.     }
  1083.     }
  1084.  
  1085.     New(402,Argv, (s - cmd) / 2 + 2, char*);
  1086.     Cmd = savepvn(cmd, s-cmd);
  1087.     a = Argv;
  1088.     for (s = Cmd; *s;) {
  1089.     while (*s && isSPACE(*s)) s++;
  1090.     if (*s)
  1091.         *(a++) = s;
  1092.     while (*s && !isSPACE(*s)) s++;
  1093.     if (*s)
  1094.         *s++ = '\0';
  1095.     }
  1096.     *a = Nullch;
  1097.     if (Argv[0]) {
  1098.     execvp(Argv[0],Argv);
  1099.     if (errno == ENOEXEC) {        /* for system V NIH syndrome */
  1100.         do_execfree();
  1101.         goto doshell;
  1102.     }
  1103.     if (dowarn)
  1104.         warn("Can't exec \"%s\": %s", Argv[0], Strerror(errno));
  1105.     }
  1106.     do_execfree();
  1107. #endif
  1108.     return FALSE;
  1109. }
  1110.  
  1111. I32
  1112. apply(type,mark,sp)
  1113. I32 type;
  1114. register SV **mark;
  1115. register SV **sp;
  1116. {
  1117.     register I32 val;
  1118.     register I32 val2;
  1119.     register I32 tot = 0;
  1120.     char *s;
  1121.     SV **oldmark = mark;
  1122.  
  1123.     if (tainting) {
  1124.     while (++mark <= sp) {
  1125.         MAGIC *mg;
  1126.         if (SvMAGICAL(*mark) && (mg = mg_find(*mark, 't')) && mg->mg_len & 1)
  1127.         tainted = TRUE;
  1128.     }
  1129.     mark = oldmark;
  1130.     }
  1131.     switch (type) {
  1132.     case OP_CHMOD:
  1133.     TAINT_PROPER("chmod");
  1134.     if (++mark <= sp) {
  1135.         tot = sp - mark;
  1136.         val = SvIVx(*mark);
  1137.         while (++mark <= sp) {
  1138.         if (chmod(SvPVx(*mark, na),val))
  1139.             tot--;
  1140.         }
  1141.     }
  1142.     break;
  1143. #ifdef HAS_CHOWN
  1144.     case OP_CHOWN:
  1145.     TAINT_PROPER("chown");
  1146.     if (sp - mark > 2) {
  1147.         val = SvIVx(*++mark);
  1148.         val2 = SvIVx(*++mark);
  1149.         tot = sp - mark;
  1150.         while (++mark <= sp) {
  1151.         if (chown(SvPVx(*mark, na),val,val2))
  1152.             tot--;
  1153.         }
  1154.     }
  1155.     break;
  1156. #endif
  1157. #ifdef HAS_KILL
  1158.     case OP_KILL:
  1159.     TAINT_PROPER("kill");
  1160.     s = SvPVx(*++mark, na);
  1161.     tot = sp - mark;
  1162.     if (isUPPER(*s)) {
  1163.         if (*s == 'S' && s[1] == 'I' && s[2] == 'G')
  1164.         s += 3;
  1165.         if (!(val = whichsig(s)))
  1166.         croak("Unrecognized signal name \"%s\"",s);
  1167.     }
  1168.     else
  1169.         val = SvIVx(*mark);
  1170. #ifdef VMS
  1171.     /* kill() doesn't do process groups (job trees?) under VMS */
  1172.     if (val < 0) val = -val;
  1173.     if (val == SIGKILL) {
  1174. #        include <starlet.h>
  1175.         /* Use native sys$delprc() to insure that target process is
  1176.          * deleted; supervisor-mode images don't pay attention to
  1177.          * CRTL's emulation of Unix-style signals and kill()
  1178.          */
  1179.         while (++mark <= sp) {
  1180.         I32 proc = SvIVx(*mark);
  1181.         register unsigned long int __vmssts;
  1182.         if (!((__vmssts = sys$delprc(&proc,0)) & 1)) {
  1183.             tot--;
  1184.             switch (__vmssts) {
  1185.             case SS$_NONEXPR:
  1186.             case SS$_NOSUCHNODE:
  1187.                 SETERRNO(ESRCH,__vmssts);
  1188.                 break;
  1189.             case SS$_NOPRIV:
  1190.                 SETERRNO(EPERM,__vmssts);
  1191.                 break;
  1192.             default:
  1193.                 SETERRNO(EVMSERR,__vmssts);
  1194.             }
  1195.         }
  1196.         }
  1197.         break;
  1198.     }
  1199. #endif
  1200.     if (val < 0) {
  1201.         val = -val;
  1202.         while (++mark <= sp) {
  1203.         I32 proc = SvIVx(*mark);
  1204. #ifdef HAS_KILLPG
  1205.         if (killpg(proc,val))    /* BSD */
  1206. #else
  1207.         if (kill(-proc,val))    /* SYSV */
  1208. #endif
  1209.             tot--;
  1210.         }
  1211.     }
  1212.     else {
  1213.         while (++mark <= sp) {
  1214.         if (kill(SvIVx(*mark),val))
  1215.             tot--;
  1216.         }
  1217.     }
  1218.     break;
  1219. #endif
  1220.     case OP_UNLINK:
  1221.     TAINT_PROPER("unlink");
  1222.     tot = sp - mark;
  1223.     while (++mark <= sp) {
  1224.         s = SvPVx(*mark, na);
  1225.         if (euid || unsafe) {
  1226.         if (UNLINK(s))
  1227.             tot--;
  1228.         }
  1229.         else {    /* don't let root wipe out directories without -U */
  1230. #ifdef HAS_LSTAT
  1231.         if (lstat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode))
  1232. #else
  1233.         if (Stat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode))
  1234. #endif
  1235.             tot--;
  1236.         else {
  1237.             if (UNLINK(s))
  1238.             tot--;
  1239.         }
  1240.         }
  1241.     }
  1242.     break;
  1243. #ifdef HAS_UTIME
  1244.     case OP_UTIME:
  1245.     TAINT_PROPER("utime");
  1246.     if (sp - mark > 2) {
  1247. #if defined(I_UTIME) || defined(VMS)
  1248.         struct utimbuf utbuf;
  1249. #else
  1250.         struct {
  1251.         long    actime;
  1252.         long    modtime;
  1253.         } utbuf;
  1254. #endif
  1255.  
  1256.         Zero(&utbuf, sizeof utbuf, char);
  1257. #ifdef BIG_TIME
  1258.         utbuf.actime = (time_t)SvNVx(*++mark);    /* time accessed */
  1259.         utbuf.modtime = (time_t)SvNVx(*++mark);    /* time modified */
  1260. #else
  1261.         utbuf.actime = SvIVx(*++mark);    /* time accessed */
  1262.         utbuf.modtime = SvIVx(*++mark);    /* time modified */
  1263. #endif
  1264.         tot = sp - mark;
  1265.         while (++mark <= sp) {
  1266.         if (utime(SvPVx(*mark, na),&utbuf))
  1267.             tot--;
  1268.         }
  1269.     }
  1270.     else
  1271.         tot = 0;
  1272.     break;
  1273. #endif
  1274.     }
  1275.     return tot;
  1276. }
  1277.  
  1278. /* Do the permissions allow some operation?  Assumes statcache already set. */
  1279. #ifndef VMS /* VMS' cando is in vms.c */
  1280. I32
  1281. cando(bit, effective, statbufp)
  1282. I32 bit;
  1283. I32 effective;
  1284. register struct stat *statbufp;
  1285. {
  1286. #ifdef DOSISH
  1287.     /* [Comments and code from Len Reed]
  1288.      * MS-DOS "user" is similar to UNIX's "superuser," but can't write
  1289.      * to write-protected files.  The execute permission bit is set
  1290.      * by the Miscrosoft C library stat() function for the following:
  1291.      *        .exe files
  1292.      *        .com files
  1293.      *        .bat files
  1294.      *        directories
  1295.      * All files and directories are readable.
  1296.      * Directories and special files, e.g. "CON", cannot be
  1297.      * write-protected.
  1298.      * [Comment by Tom Dinger -- a directory can have the write-protect
  1299.      *        bit set in the file system, but DOS permits changes to
  1300.      *        the directory anyway.  In addition, all bets are off
  1301.      *        here for networked software, such as Novell and
  1302.      *        Sun's PC-NFS.]
  1303.      */
  1304.  
  1305.      /* Atari stat() does pretty much the same thing. we set x_bit_set_in_stat
  1306.       * too so it will actually look into the files for magic numbers
  1307.       */
  1308.      return (bit & statbufp->st_mode) ? TRUE : FALSE;
  1309.  
  1310. #else /* ! MSDOS */
  1311.     if ((effective ? euid : uid) == 0) {    /* root is special */
  1312.     if (bit == S_IXUSR) {
  1313.         if (statbufp->st_mode & 0111 || S_ISDIR(statbufp->st_mode))
  1314.         return TRUE;
  1315.     }
  1316.     else
  1317.         return TRUE;        /* root reads and writes anything */
  1318.     return FALSE;
  1319.     }
  1320.     if (statbufp->st_uid == (effective ? euid : uid) ) {
  1321.     if (statbufp->st_mode & bit)
  1322.         return TRUE;    /* ok as "user" */
  1323.     }
  1324.     else if (ingroup((I32)statbufp->st_gid,effective)) {
  1325.     if (statbufp->st_mode & bit >> 3)
  1326.         return TRUE;    /* ok as "group" */
  1327.     }
  1328.     else if (statbufp->st_mode & bit >> 6)
  1329.     return TRUE;    /* ok as "other" */
  1330.     return FALSE;
  1331. #endif /* ! MSDOS */
  1332. }
  1333. #endif /* ! VMS */
  1334.  
  1335. I32
  1336. ingroup(testgid,effective)
  1337. I32 testgid;
  1338. I32 effective;
  1339. {
  1340. #ifdef macintosh
  1341.     /* This is simply not correct for AppleShare, but fix it yerself. */
  1342.     return TRUE;
  1343. #else
  1344.     if (testgid == (effective ? egid : gid))
  1345.     return TRUE;
  1346. #ifdef HAS_GETGROUPS
  1347. #ifndef NGROUPS
  1348. #define NGROUPS 32
  1349. #endif
  1350.     {
  1351.     Groups_t gary[NGROUPS];
  1352.     I32 anum;
  1353.  
  1354.     anum = getgroups(NGROUPS,gary);
  1355.     while (--anum >= 0)
  1356.         if (gary[anum] == testgid)
  1357.         return TRUE;
  1358.     }
  1359. #endif
  1360.     return FALSE;
  1361. #endif
  1362. }
  1363.  
  1364. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  1365.  
  1366. I32
  1367. do_ipcget(optype, mark, sp)
  1368. I32 optype;
  1369. SV **mark;
  1370. SV **sp;
  1371. {
  1372.     key_t key;
  1373.     I32 n, flags;
  1374.  
  1375.     key = (key_t)SvNVx(*++mark);
  1376.     n = (optype == OP_MSGGET) ? 0 : SvIVx(*++mark);
  1377.     flags = SvIVx(*++mark);
  1378.     SETERRNO(0,0);
  1379.     switch (optype)
  1380.     {
  1381. #ifdef HAS_MSG
  1382.     case OP_MSGGET:
  1383.     return msgget(key, flags);
  1384. #endif
  1385. #ifdef HAS_SEM
  1386.     case OP_SEMGET:
  1387.     return semget(key, n, flags);
  1388. #endif
  1389. #ifdef HAS_SHM
  1390.     case OP_SHMGET:
  1391.     return shmget(key, n, flags);
  1392. #endif
  1393. #if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM)
  1394.     default:
  1395.     croak("%s not implemented", op_desc[optype]);
  1396. #endif
  1397.     }
  1398.     return -1;            /* should never happen */
  1399. }
  1400.  
  1401. I32
  1402. do_ipcctl(optype, mark, sp)
  1403. I32 optype;
  1404. SV **mark;
  1405. SV **sp;
  1406. {
  1407.     SV *astr;
  1408.     char *a;
  1409.     I32 id, n, cmd, infosize, getinfo;
  1410.     I32 ret = -1;
  1411.  
  1412.     id = SvIVx(*++mark);
  1413.     n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0;
  1414.     cmd = SvIVx(*++mark);
  1415.     astr = *++mark;
  1416.     infosize = 0;
  1417.     getinfo = (cmd == IPC_STAT);
  1418.  
  1419.     switch (optype)
  1420.     {
  1421. #ifdef HAS_MSG
  1422.     case OP_MSGCTL:
  1423.     if (cmd == IPC_STAT || cmd == IPC_SET)
  1424.         infosize = sizeof(struct msqid_ds);
  1425.     break;
  1426. #endif
  1427. #ifdef HAS_SHM
  1428.     case OP_SHMCTL:
  1429.     if (cmd == IPC_STAT || cmd == IPC_SET)
  1430.         infosize = sizeof(struct shmid_ds);
  1431.     break;
  1432. #endif
  1433. #ifdef HAS_SEM
  1434.     case OP_SEMCTL:
  1435.     if (cmd == IPC_STAT || cmd == IPC_SET)
  1436.         infosize = sizeof(struct semid_ds);
  1437.     else if (cmd == GETALL || cmd == SETALL)
  1438.     {
  1439.         struct semid_ds semds;
  1440.         if (semctl(id, 0, IPC_STAT, &semds) == -1)
  1441.         return -1;
  1442.         getinfo = (cmd == GETALL);
  1443.         infosize = semds.sem_nsems * sizeof(short);
  1444.         /* "short" is technically wrong but much more portable
  1445.            than guessing about u_?short(_t)? */
  1446.     }
  1447.     break;
  1448. #endif
  1449. #if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM)
  1450.     default:
  1451.     croak("%s not implemented", op_desc[optype]);
  1452. #endif
  1453.     }
  1454.  
  1455.     if (infosize)
  1456.     {
  1457.     STRLEN len;
  1458.     if (getinfo)
  1459.     {
  1460.         SvPV_force(astr, len);
  1461.         a = SvGROW(astr, infosize+1);
  1462.     }
  1463.     else
  1464.     {
  1465.         a = SvPV(astr, len);
  1466.         if (len != infosize)
  1467.         croak("Bad arg length for %s, is %d, should be %d",
  1468.             op_desc[optype], len, infosize);
  1469.     }
  1470.     }
  1471.     else
  1472.     {
  1473.     I32 i = SvIV(astr);
  1474.     a = (char *)i;        /* ouch */
  1475.     }
  1476.     SETERRNO(0,0);
  1477.     switch (optype)
  1478.     {
  1479. #ifdef HAS_MSG
  1480.     case OP_MSGCTL:
  1481.     ret = msgctl(id, cmd, (struct msqid_ds *)a);
  1482.     break;
  1483. #endif
  1484. #ifdef HAS_SEM
  1485.     case OP_SEMCTL:
  1486.     ret = semctl(id, n, cmd, (struct semid_ds *)a);
  1487.     break;
  1488. #endif
  1489. #ifdef HAS_SHM
  1490.     case OP_SHMCTL:
  1491.     ret = shmctl(id, cmd, (struct shmid_ds *)a);
  1492.     break;
  1493. #endif
  1494.     }
  1495.     if (getinfo && ret >= 0) {
  1496.     SvCUR_set(astr, infosize);
  1497.     *SvEND(astr) = '\0';
  1498.     SvSETMAGIC(astr);
  1499.     }
  1500.     return ret;
  1501. }
  1502.  
  1503. I32
  1504. do_msgsnd(mark, sp)
  1505. SV **mark;
  1506. SV **sp;
  1507. {
  1508. #ifdef HAS_MSG
  1509.     SV *mstr;
  1510.     char *mbuf;
  1511.     I32 id, msize, flags;
  1512.     STRLEN len;
  1513.  
  1514.     id = SvIVx(*++mark);
  1515.     mstr = *++mark;
  1516.     flags = SvIVx(*++mark);
  1517.     mbuf = SvPV(mstr, len);
  1518.     if ((msize = len - sizeof(long)) < 0)
  1519.     croak("Arg too short for msgsnd");
  1520.     SETERRNO(0,0);
  1521.     return msgsnd(id, (struct msgbuf *)mbuf, msize, flags);
  1522. #else
  1523.     croak("msgsnd not implemented");
  1524. #endif
  1525. }
  1526.  
  1527. I32
  1528. do_msgrcv(mark, sp)
  1529. SV **mark;
  1530. SV **sp;
  1531. {
  1532. #ifdef HAS_MSG
  1533.     SV *mstr;
  1534.     char *mbuf;
  1535.     long mtype;
  1536.     I32 id, msize, flags, ret;
  1537.     STRLEN len;
  1538.  
  1539.     id = SvIVx(*++mark);
  1540.     mstr = *++mark;
  1541.     msize = SvIVx(*++mark);
  1542.     mtype = (long)SvIVx(*++mark);
  1543.     flags = SvIVx(*++mark);
  1544.     if (SvTHINKFIRST(mstr)) {
  1545.     if (SvREADONLY(mstr))
  1546.         croak("Can't msgrcv to readonly var");
  1547.     if (SvROK(mstr))
  1548.         sv_unref(mstr);
  1549.     }
  1550.     SvPV_force(mstr, len);
  1551.     mbuf = SvGROW(mstr, sizeof(long)+msize+1);
  1552.     
  1553.     SETERRNO(0,0);
  1554.     ret = msgrcv(id, (struct msgbuf *)mbuf, msize, mtype, flags);
  1555.     if (ret >= 0) {
  1556.     SvCUR_set(mstr, sizeof(long)+ret);
  1557.     *SvEND(mstr) = '\0';
  1558.     }
  1559.     return ret;
  1560. #else
  1561.     croak("msgrcv not implemented");
  1562. #endif
  1563. }
  1564.  
  1565. I32
  1566. do_semop(mark, sp)
  1567. SV **mark;
  1568. SV **sp;
  1569. {
  1570. #ifdef HAS_SEM
  1571.     SV *opstr;
  1572.     char *opbuf;
  1573.     I32 id;
  1574.     STRLEN opsize;
  1575.  
  1576.     id = SvIVx(*++mark);
  1577.     opstr = *++mark;
  1578.     opbuf = SvPV(opstr, opsize);
  1579.     if (opsize < sizeof(struct sembuf)
  1580.     || (opsize % sizeof(struct sembuf)) != 0) {
  1581.     SETERRNO(EINVAL,LIB$_INVARG);
  1582.     return -1;
  1583.     }
  1584.     SETERRNO(0,0);
  1585.     return semop(id, (struct sembuf *)opbuf, opsize/sizeof(struct sembuf));
  1586. #else
  1587.     croak("semop not implemented");
  1588. #endif
  1589. }
  1590.  
  1591. I32
  1592. do_shmio(optype, mark, sp)
  1593. I32 optype;
  1594. SV **mark;
  1595. SV **sp;
  1596. {
  1597. #ifdef HAS_SHM
  1598.     SV *mstr;
  1599.     char *mbuf, *shm;
  1600.     I32 id, mpos, msize;
  1601.     STRLEN len;
  1602.     struct shmid_ds shmds;
  1603.  
  1604.     id = SvIVx(*++mark);
  1605.     mstr = *++mark;
  1606.     mpos = SvIVx(*++mark);
  1607.     msize = SvIVx(*++mark);
  1608.     SETERRNO(0,0);
  1609.     if (shmctl(id, IPC_STAT, &shmds) == -1)
  1610.     return -1;
  1611.     if (mpos < 0 || msize < 0 || mpos + msize > shmds.shm_segsz) {
  1612.     SETERRNO(EFAULT,SS$_ACCVIO);        /* can't do as caller requested */
  1613.     return -1;
  1614.     }
  1615.     shm = (Shmat_t)shmat(id, (char*)NULL, (optype == OP_SHMREAD) ? SHM_RDONLY : 0);
  1616.     if (shm == (char *)-1)    /* I hate System V IPC, I really do */
  1617.     return -1;
  1618.     if (optype == OP_SHMREAD) {
  1619.     SvPV_force(mstr, len);
  1620.     mbuf = SvGROW(mstr, msize+1);
  1621.  
  1622.     Copy(shm + mpos, mbuf, msize, char);
  1623.     SvCUR_set(mstr, msize);
  1624.     *SvEND(mstr) = '\0';
  1625.     SvSETMAGIC(mstr);
  1626.     }
  1627.     else {
  1628.     I32 n;
  1629.  
  1630.     mbuf = SvPV(mstr, len);
  1631.     if ((n = len) > msize)
  1632.         n = msize;
  1633.     Copy(mbuf, shm + mpos, n, char);
  1634.     if (n < msize)
  1635.         memzero(shm + mpos + n, msize - n);
  1636.     }
  1637.     return shmdt(shm);
  1638. #else
  1639.     croak("shm I/O not implemented");
  1640. #endif
  1641. }
  1642.  
  1643. #endif /* SYSV IPC */
  1644.