home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / perl-5.003-base.tgz / perl-5.003-base.tar / fsf / perl / doio.c < prev    next >
C/C++ Source or Header  |  1996-02-27  |  32KB  |  1,568 lines
  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. FILE *
  333. nextargv(gv)
  334. register GV *gv;
  335. {
  336.     register SV *sv;
  337. #ifndef FLEXFILENAMES
  338.     int filedev;
  339.     int fileino;
  340. #endif
  341.     int fileuid;
  342.     int filegid;
  343.  
  344.     if (!argvoutgv)
  345.     argvoutgv = gv_fetchpv("ARGVOUT",TRUE,SVt_PVIO);
  346.     if (filemode & (S_ISUID|S_ISGID)) {
  347.     Fflush(IoIFP(GvIOn(argvoutgv)));  /* chmod must follow last write */
  348. #ifdef HAS_FCHMOD
  349.     (void)fchmod(lastfd,filemode);
  350. #else
  351.     (void)chmod(oldname,filemode);
  352. #endif
  353.     }
  354.     filemode = 0;
  355.     while (av_len(GvAV(gv)) >= 0) {
  356.     STRLEN len;
  357.     sv = av_shift(GvAV(gv));
  358.     SAVEFREESV(sv);
  359.     sv_setsv(GvSV(gv),sv);
  360.     SvSETMAGIC(GvSV(gv));
  361.     oldname = SvPVx(GvSV(gv), len);
  362.     if (do_open(gv,oldname,len,FALSE,0,0,Nullfp)) {
  363.         if (inplace) {
  364.         TAINT_PROPER("inplace open");
  365.         if (strEQ(oldname,"-")) {
  366.             setdefout(gv_fetchpv("STDOUT",TRUE,SVt_PVIO));
  367.             return IoIFP(GvIOp(gv));
  368.         }
  369. #ifndef FLEXFILENAMES
  370.         filedev = statbuf.st_dev;
  371.         fileino = statbuf.st_ino;
  372. #endif
  373.         filemode = statbuf.st_mode;
  374.         fileuid = statbuf.st_uid;
  375.         filegid = statbuf.st_gid;
  376.         if (!S_ISREG(filemode)) {
  377.             warn("Can't do inplace edit: %s is not a regular file",
  378.               oldname );
  379.             do_close(gv,FALSE);
  380.             continue;
  381.         }
  382.         if (*inplace) {
  383. #ifdef SUFFIX
  384.             add_suffix(sv,inplace);
  385. #else
  386.             sv_catpv(sv,inplace);
  387. #endif
  388. #ifndef FLEXFILENAMES
  389.             if (Stat(SvPVX(sv),&statbuf) >= 0
  390.               && statbuf.st_dev == filedev
  391.               && statbuf.st_ino == fileino ) {
  392.             warn("Can't do inplace edit: %s > 14 characters",
  393.               SvPVX(sv) );
  394.             do_close(gv,FALSE);
  395.             continue;
  396.             }
  397. #endif
  398. #ifdef HAS_RENAME
  399. #ifndef DOSISH
  400.             if (rename(oldname,SvPVX(sv)) < 0) {
  401.             warn("Can't rename %s to %s: %s, skipping file",
  402.               oldname, SvPVX(sv), Strerror(errno) );
  403.             do_close(gv,FALSE);
  404.             continue;
  405.             }
  406. #else
  407.             do_close(gv,FALSE);
  408.             (void)unlink(SvPVX(sv));
  409.             (void)rename(oldname,SvPVX(sv));
  410.             do_open(gv,SvPVX(sv),SvCUR(sv),FALSE,0,0,Nullfp);
  411. #endif /* MSDOS */
  412. #else
  413.             (void)UNLINK(SvPVX(sv));
  414.             if (link(oldname,SvPVX(sv)) < 0) {
  415.             warn("Can't rename %s to %s: %s, skipping file",
  416.               oldname, SvPVX(sv), Strerror(errno) );
  417.             do_close(gv,FALSE);
  418.             continue;
  419.             }
  420.             (void)UNLINK(oldname);
  421. #endif
  422.         }
  423.         else {
  424. #ifndef DOSISH
  425.             if (UNLINK(oldname) < 0) {
  426.             warn("Can't rename %s to %s: %s, skipping file",
  427.               oldname, SvPVX(sv), Strerror(errno) );
  428.             do_close(gv,FALSE);
  429.             continue;
  430.             }
  431. #else
  432.             croak("Can't do inplace edit without backup");
  433. #endif
  434.         }
  435.  
  436.         sv_setpvn(sv,">",1);
  437.         sv_catpv(sv,oldname);
  438.         SETERRNO(0,0);        /* in case sprintf set errno */
  439.         if (!do_open(argvoutgv,SvPVX(sv),SvCUR(sv),FALSE,0,0,Nullfp)) {
  440.             warn("Can't do inplace edit on %s: %s",
  441.               oldname, Strerror(errno) );
  442.             do_close(gv,FALSE);
  443.             continue;
  444.         }
  445.         setdefout(argvoutgv);
  446.         lastfd = fileno(IoIFP(GvIOp(argvoutgv)));
  447.         (void)Fstat(lastfd,&statbuf);
  448. #ifdef HAS_FCHMOD
  449.         (void)fchmod(lastfd,filemode);
  450. #else
  451.         (void)chmod(oldname,filemode);
  452. #endif
  453.         if (fileuid != statbuf.st_uid || filegid != statbuf.st_gid) {
  454. #ifdef HAS_FCHOWN
  455.             (void)fchown(lastfd,fileuid,filegid);
  456. #else
  457. #ifdef HAS_CHOWN
  458.             (void)chown(oldname,fileuid,filegid);
  459. #endif
  460. #endif
  461.         }
  462.         }
  463.         return IoIFP(GvIOp(gv));
  464.     }
  465.     else
  466.         fprintf(stderr,"Can't open %s: %s\n",SvPV(sv, na), Strerror(errno));
  467.     }
  468.     if (inplace) {
  469.     (void)do_close(argvoutgv,FALSE);
  470.     setdefout(gv_fetchpv("STDOUT",TRUE,SVt_PVIO));
  471.     }
  472.     return Nullfp;
  473. }
  474.  
  475. #ifdef HAS_PIPE
  476. void
  477. do_pipe(sv, rgv, wgv)
  478. SV *sv;
  479. GV *rgv;
  480. GV *wgv;
  481. {
  482.     register IO *rstio;
  483.     register IO *wstio;
  484.     int fd[2];
  485.  
  486.     if (!rgv)
  487.     goto badexit;
  488.     if (!wgv)
  489.     goto badexit;
  490.  
  491.     rstio = GvIOn(rgv);
  492.     wstio = GvIOn(wgv);
  493.  
  494.     if (IoIFP(rstio))
  495.     do_close(rgv,FALSE);
  496.     if (IoIFP(wstio))
  497.     do_close(wgv,FALSE);
  498.  
  499.     if (pipe(fd) < 0)
  500.     goto badexit;
  501.     IoIFP(rstio) = fdopen(fd[0], "r");
  502.     IoOFP(wstio) = fdopen(fd[1], "w");
  503.     IoIFP(wstio) = IoOFP(wstio);
  504.     IoTYPE(rstio) = '<';
  505.     IoTYPE(wstio) = '>';
  506.     if (!IoIFP(rstio) || !IoOFP(wstio)) {
  507.     if (IoIFP(rstio)) fclose(IoIFP(rstio));
  508.     else close(fd[0]);
  509.     if (IoOFP(wstio)) fclose(IoOFP(wstio));
  510.     else close(fd[1]);
  511.     goto badexit;
  512.     }
  513.  
  514.     sv_setsv(sv,&sv_yes);
  515.     return;
  516.  
  517. badexit:
  518.     sv_setsv(sv,&sv_undef);
  519.     return;
  520. }
  521. #endif
  522.  
  523. bool
  524. #ifndef CAN_PROTOTYPE
  525. do_close(gv,explicit)
  526. GV *gv;
  527. bool explicit;
  528. #else
  529. do_close(GV *gv, bool explicit)
  530. #endif /* CAN_PROTOTYPE */
  531. {
  532.     bool retval;
  533.     IO *io;
  534.  
  535.     if (!gv)
  536.     gv = argvgv;
  537.     if (!gv || SvTYPE(gv) != SVt_PVGV) {
  538.     SETERRNO(EBADF,SS$_IVCHAN);
  539.     return FALSE;
  540.     }
  541.     io = GvIO(gv);
  542.     if (!io) {        /* never opened */
  543.     if (dowarn && explicit)
  544.         warn("Close on unopened file <%s>",GvENAME(gv));
  545.     return FALSE;
  546.     }
  547.     retval = io_close(io);
  548.     if (explicit) {
  549.     IoLINES(io) = 0;
  550.     IoPAGE(io) = 0;
  551.     IoLINES_LEFT(io) = IoPAGE_LEN(io);
  552.     }
  553.     IoTYPE(io) = ' ';
  554.     return retval;
  555. }
  556.  
  557. bool
  558. io_close(io)
  559. IO* io;
  560. {
  561.     bool retval = FALSE;
  562.     int status;
  563.  
  564.     if (IoIFP(io)) {
  565.     if (IoTYPE(io) == '|') {
  566.         status = my_pclose(IoIFP(io));
  567.         retval = (status == 0);
  568.         statusvalue = FIXSTATUS(status);
  569.     }
  570.     else if (IoTYPE(io) == '-')
  571.         retval = TRUE;
  572.     else {
  573.         if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {        /* a socket */
  574.         retval = (fclose(IoOFP(io)) != EOF);
  575.         fclose(IoIFP(io));    /* clear stdio, fd already closed */
  576.         }
  577.         else
  578.         retval = (fclose(IoIFP(io)) != EOF);
  579.     }
  580.     IoOFP(io) = IoIFP(io) = Nullfp;
  581.     }
  582.  
  583.     return retval;
  584. }
  585.  
  586. bool
  587. do_eof(gv)
  588. GV *gv;
  589. {
  590.     register IO *io;
  591.     int ch;
  592.  
  593.     io = GvIO(gv);
  594.  
  595.     if (!io)
  596.     return TRUE;
  597.  
  598.     while (IoIFP(io)) {
  599.  
  600. #ifdef USE_STDIO_PTR            /* (the code works without this) */
  601.     if (FILE_cnt(IoIFP(io)) > 0)    /* cheat a little, since */
  602.         return FALSE;        /* this is the most usual case */
  603. #endif
  604.  
  605.     ch = getc(IoIFP(io));
  606.     if (ch != EOF) {
  607.         (void)ungetc(ch, IoIFP(io));
  608.         return FALSE;
  609.     }
  610. #if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
  611.     if (FILE_cnt(IoIFP(io)) < -1)
  612.         FILE_cnt(IoIFP(io)) = -1;
  613. #endif
  614.     if (op->op_flags & OPf_SPECIAL) { /* not necessarily a real EOF yet? */
  615.         if (!nextargv(argvgv))    /* get another fp handy */
  616.         return TRUE;
  617.     }
  618.     else
  619.         return TRUE;        /* normal fp, definitely end of file */
  620.     }
  621.     return TRUE;
  622. }
  623.  
  624. long
  625. do_tell(gv)
  626. GV *gv;
  627. {
  628.     register IO *io;
  629.  
  630.     if (!gv)
  631.     goto phooey;
  632.  
  633.     io = GvIO(gv);
  634.     if (!io || !IoIFP(io))
  635.     goto phooey;
  636.  
  637. #ifdef ULTRIX_STDIO_BOTCH
  638.     if (feof(IoIFP(io)))
  639.     (void)fseek (IoIFP(io), 0L, 2);        /* ultrix 1.2 workaround */
  640. #endif
  641.  
  642.     return ftell(IoIFP(io));
  643.  
  644. phooey:
  645.     if (dowarn)
  646.     warn("tell() on unopened file");
  647.     SETERRNO(EBADF,RMS$_IFI);
  648.     return -1L;
  649. }
  650.  
  651. bool
  652. do_seek(gv, pos, whence)
  653. GV *gv;
  654. long pos;
  655. int whence;
  656. {
  657.     register IO *io;
  658.  
  659.     if (!gv)
  660.     goto nuts;
  661.  
  662.     io = GvIO(gv);
  663.     if (!io || !IoIFP(io))
  664.     goto nuts;
  665.  
  666. #ifdef ULTRIX_STDIO_BOTCH
  667.     if (feof(IoIFP(io)))
  668.     (void)fseek (IoIFP(io), 0L, 2);        /* ultrix 1.2 workaround */
  669. #endif
  670.  
  671.     return fseek(IoIFP(io), pos, whence) >= 0;
  672.  
  673. nuts:
  674.     if (dowarn)
  675.     warn("seek() on unopened file");
  676.     SETERRNO(EBADF,RMS$_IFI);
  677.     return FALSE;
  678. }
  679.  
  680. #if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP)
  681.     /* code courtesy of William Kucharski */
  682. #define HAS_CHSIZE
  683.  
  684. I32 chsize(fd, length)
  685. I32 fd;            /* file descriptor */
  686. Off_t length;        /* length to set file to */
  687. {
  688.     extern long lseek();
  689.     struct flock fl;
  690.     struct stat filebuf;
  691.  
  692.     if (Fstat(fd, &filebuf) < 0)
  693.     return -1;
  694.  
  695.     if (filebuf.st_size < length) {
  696.  
  697.     /* extend file length */
  698.  
  699.     if ((lseek(fd, (length - 1), 0)) < 0)
  700.         return -1;
  701.  
  702.     /* write a "0" byte */
  703.  
  704.     if ((write(fd, "", 1)) != 1)
  705.         return -1;
  706.     }
  707.     else {
  708.     /* truncate length */
  709.  
  710.     fl.l_whence = 0;
  711.     fl.l_len = 0;
  712.     fl.l_start = length;
  713.     fl.l_type = F_WRLCK;    /* write lock on file space */
  714.  
  715.     /*
  716.     * This relies on the UNDOCUMENTED F_FREESP argument to
  717.     * fcntl(2), which truncates the file so that it ends at the
  718.     * position indicated by fl.l_start.
  719.     *
  720.     * Will minor miracles never cease?
  721.     */
  722.  
  723.     if (fcntl(fd, F_FREESP, &fl) < 0)
  724.         return -1;
  725.  
  726.     }
  727.  
  728.     return 0;
  729. }
  730. #endif /* F_FREESP */
  731.  
  732. I32
  733. looks_like_number(sv)
  734. SV *sv;
  735. {
  736.     register char *s;
  737.     register char *send;
  738.  
  739.     if (!SvPOK(sv)) {
  740.     STRLEN len;
  741.     if (!SvPOKp(sv))
  742.         return TRUE;
  743.     s = SvPV(sv, len);
  744.     send = s + len;
  745.     }
  746.     else {
  747.     s = SvPVX(sv); 
  748.     send = s + SvCUR(sv);
  749.     }
  750.     while (isSPACE(*s))
  751.     s++;
  752.     if (s >= send)
  753.     return FALSE;
  754.     if (*s == '+' || *s == '-')
  755.     s++;
  756.     while (isDIGIT(*s))
  757.     s++;
  758.     if (s == send)
  759.     return TRUE;
  760.     if (*s == '.') 
  761.     s++;
  762.     else if (s == SvPVX(sv))
  763.     return FALSE;
  764.     while (isDIGIT(*s))
  765.     s++;
  766.     if (s == send)
  767.     return TRUE;
  768.     if (*s == 'e' || *s == 'E') {
  769.     s++;
  770.     if (*s == '+' || *s == '-')
  771.         s++;
  772.     while (isDIGIT(*s))
  773.         s++;
  774.     }
  775.     while (isSPACE(*s))
  776.     s++;
  777.     if (s >= send)
  778.     return TRUE;
  779.     return FALSE;
  780. }
  781.  
  782. bool
  783. do_print(sv,fp)
  784. register SV *sv;
  785. FILE *fp;
  786. {
  787.     register char *tmps;
  788.     STRLEN len;
  789.  
  790.     /* assuming fp is checked earlier */
  791.     if (!sv)
  792.     return TRUE;
  793.     if (ofmt) {
  794.     if (SvGMAGICAL(sv))
  795.         mg_get(sv);
  796.         if (SvIOK(sv) && SvIVX(sv) != 0) {
  797.         fprintf(fp, ofmt, (double)SvIVX(sv));
  798.         return !ferror(fp);
  799.     }
  800.     if (  (SvNOK(sv) && SvNVX(sv) != 0.0)
  801.        || (looks_like_number(sv) && sv_2nv(sv) != 0.0) ) {
  802.         fprintf(fp, ofmt, SvNVX(sv));
  803.         return !ferror(fp);
  804.     }
  805.     }
  806.     switch (SvTYPE(sv)) {
  807.     case SVt_NULL:
  808.     if (dowarn)
  809.         warn(warn_uninit);
  810.     return TRUE;
  811.     case SVt_IV:
  812.     if (SvIOK(sv)) {
  813.         if (SvGMAGICAL(sv))
  814.         mg_get(sv);
  815.         fprintf(fp, "%ld", (long)SvIVX(sv));
  816.         return !ferror(fp);
  817.     }
  818.     /* FALL THROUGH */
  819.     default:
  820.     tmps = SvPV(sv, len);
  821.     break;
  822.     }
  823.     if (len && (fwrite1(tmps,1,len,fp) == 0 || ferror(fp)))
  824.     return FALSE;
  825.     return TRUE;
  826. }
  827.  
  828. I32
  829. my_stat(ARGS)
  830. dARGS
  831. {
  832.     dSP;
  833.     IO *io;
  834.     GV* tmpgv;
  835.  
  836.     if (op->op_flags & OPf_REF) {
  837.     EXTEND(sp,1);
  838.     tmpgv = cGVOP->op_gv;
  839.       do_fstat:
  840.     io = GvIO(tmpgv);
  841.     if (io && IoIFP(io)) {
  842.         statgv = tmpgv;
  843.         sv_setpv(statname,"");
  844.         laststype = OP_STAT;
  845.         return (laststatval = Fstat(fileno(IoIFP(io)), &statcache));
  846.     }
  847.     else {
  848.         if (tmpgv == defgv)
  849.         return laststatval;
  850.         if (dowarn)
  851.         warn("Stat on unopened file <%s>",
  852.           GvENAME(tmpgv));
  853.         statgv = Nullgv;
  854.         sv_setpv(statname,"");
  855.         return (laststatval = -1);
  856.     }
  857.     }
  858.     else {
  859.     SV* sv = POPs;
  860.     PUTBACK;
  861.     if (SvTYPE(sv) == SVt_PVGV) {
  862.         tmpgv = (GV*)sv;
  863.         goto do_fstat;
  864.     }
  865.     else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
  866.         tmpgv = (GV*)SvRV(sv);
  867.         goto do_fstat;
  868.     }
  869.  
  870.     statgv = Nullgv;
  871.     sv_setpv(statname,SvPV(sv, na));
  872.     laststype = OP_STAT;
  873.     laststatval = Stat(SvPV(sv, na),&statcache);
  874.     if (laststatval < 0 && dowarn && strchr(SvPV(sv, na), '\n'))
  875.         warn(warn_nl, "stat");
  876.     return laststatval;
  877.     }
  878. }
  879.  
  880. I32
  881. my_lstat(ARGS)
  882. dARGS
  883. {
  884.     dSP;
  885.     SV *sv;
  886.     if (op->op_flags & OPf_REF) {
  887.     EXTEND(sp,1);
  888.     if (cGVOP->op_gv == defgv) {
  889.         if (laststype != OP_LSTAT)
  890.         croak("The stat preceding -l _ wasn't an lstat");
  891.         return laststatval;
  892.     }
  893.     croak("You can't use -l on a filehandle");
  894.     }
  895.  
  896.     laststype = OP_LSTAT;
  897.     statgv = Nullgv;
  898.     sv = POPs;
  899.     PUTBACK;
  900.     sv_setpv(statname,SvPV(sv, na));
  901. #ifdef HAS_LSTAT
  902.     laststatval = lstat(SvPV(sv, na),&statcache);
  903. #else
  904.     laststatval = Stat(SvPV(sv, na),&statcache);
  905. #endif
  906.     if (laststatval < 0 && dowarn && strchr(SvPV(sv, na), '\n'))
  907.     warn(warn_nl, "lstat");
  908.     return laststatval;
  909. }
  910.  
  911. bool
  912. do_aexec(really,mark,sp)
  913. SV *really;
  914. register SV **mark;
  915. register SV **sp;
  916. {
  917.     register char **a;
  918.     char *tmps;
  919.  
  920.     if (sp > mark) {
  921.     New(401,Argv, sp - mark + 1, char*);
  922.     a = Argv;
  923.     while (++mark <= sp) {
  924.         if (*mark)
  925.         *a++ = SvPVx(*mark, na);
  926.         else
  927.         *a++ = "";
  928.     }
  929.     *a = Nullch;
  930.     if (*Argv[0] != '/')    /* will execvp use PATH? */
  931.         TAINT_ENV();        /* testing IFS here is overkill, probably */
  932.     if (really && *(tmps = SvPV(really, na)))
  933.         execvp(tmps,Argv);
  934.     else
  935.         execvp(Argv[0],Argv);
  936.     if (dowarn)
  937.         warn("Can't exec \"%s\": %s", Argv[0], Strerror(errno));
  938.     }
  939.     do_execfree();
  940.     return FALSE;
  941. }
  942.  
  943. void
  944. do_execfree()
  945. {
  946.     if (Argv) {
  947.     Safefree(Argv);
  948.     Argv = Null(char **);
  949.     }
  950.     if (Cmd) {
  951.     Safefree(Cmd);
  952.     Cmd = Nullch;
  953.     }
  954. }
  955.  
  956. bool
  957. do_exec(cmd)
  958. char *cmd;
  959. {
  960.     register char **a;
  961.     register char *s;
  962.     char flags[10];
  963.  
  964.     while (*cmd && isSPACE(*cmd))
  965.     cmd++;
  966.  
  967.     /* save an extra exec if possible */
  968.  
  969. #ifdef CSH
  970.     if (strnEQ(cmd,cshname,cshlen) && strnEQ(cmd+cshlen," -c",3)) {
  971.     strcpy(flags,"-c");
  972.     s = cmd+cshlen+3;
  973.     if (*s == 'f') {
  974.         s++;
  975.         strcat(flags,"f");
  976.     }
  977.     if (*s == ' ')
  978.         s++;
  979.     if (*s++ == '\'') {
  980.         char *ncmd = s;
  981.  
  982.         while (*s)
  983.         s++;
  984.         if (s[-1] == '\n')
  985.         *--s = '\0';
  986.         if (s[-1] == '\'') {
  987.         *--s = '\0';
  988.         execl(cshname,"csh", flags,ncmd,(char*)0);
  989.         *s = '\'';
  990.         return FALSE;
  991.         }
  992.     }
  993.     }
  994. #endif /* CSH */
  995.  
  996.     /* see if there are shell metacharacters in it */
  997.  
  998.     if (*cmd == '.' && isSPACE(cmd[1]))
  999.     goto doshell;
  1000.  
  1001.     if (strnEQ(cmd,"exec",4) && isSPACE(cmd[4]))
  1002.     goto doshell;
  1003.  
  1004.     for (s = cmd; *s && isALPHA(*s); s++) ;    /* catch VAR=val gizmo */
  1005.     if (*s == '=')
  1006.     goto doshell;
  1007.  
  1008.     for (s = cmd; *s; s++) {
  1009.     if (*s != ' ' && !isALPHA(*s) && strchr("$&*(){}[]'\";\\|?<>~`\n",*s)) {
  1010.         if (*s == '\n' && !s[1]) {
  1011.         *s = '\0';
  1012.         break;
  1013.         }
  1014.       doshell:
  1015.         execl("/bin/sh","sh","-c",cmd,(char*)0);
  1016.         return FALSE;
  1017.     }
  1018.     }
  1019.  
  1020.     New(402,Argv, (s - cmd) / 2 + 2, char*);
  1021.     Cmd = savepvn(cmd, s-cmd);
  1022.     a = Argv;
  1023.     for (s = Cmd; *s;) {
  1024.     while (*s && isSPACE(*s)) s++;
  1025.     if (*s)
  1026.         *(a++) = s;
  1027.     while (*s && !isSPACE(*s)) s++;
  1028.     if (*s)
  1029.         *s++ = '\0';
  1030.     }
  1031.     *a = Nullch;
  1032.     if (Argv[0]) {
  1033.     execvp(Argv[0],Argv);
  1034.     if (errno == ENOEXEC) {        /* for system V NIH syndrome */
  1035.         do_execfree();
  1036.         goto doshell;
  1037.     }
  1038.     if (dowarn)
  1039.         warn("Can't exec \"%s\": %s", Argv[0], Strerror(errno));
  1040.     }
  1041.     do_execfree();
  1042.     return FALSE;
  1043. }
  1044.  
  1045. I32
  1046. apply(type,mark,sp)
  1047. I32 type;
  1048. register SV **mark;
  1049. register SV **sp;
  1050. {
  1051.     register I32 val;
  1052.     register I32 val2;
  1053.     register I32 tot = 0;
  1054.     char *s;
  1055.     SV **oldmark = mark;
  1056.  
  1057.     if (tainting) {
  1058.     while (++mark <= sp) {
  1059.         MAGIC *mg;
  1060.         if (SvMAGICAL(*mark) && (mg = mg_find(*mark, 't')) && mg->mg_len & 1)
  1061.         tainted = TRUE;
  1062.     }
  1063.     mark = oldmark;
  1064.     }
  1065.     switch (type) {
  1066.     case OP_CHMOD:
  1067.     TAINT_PROPER("chmod");
  1068.     if (++mark <= sp) {
  1069.         tot = sp - mark;
  1070.         val = SvIVx(*mark);
  1071.         while (++mark <= sp) {
  1072.         if (chmod(SvPVx(*mark, na),val))
  1073.             tot--;
  1074.         }
  1075.     }
  1076.     break;
  1077. #ifdef HAS_CHOWN
  1078.     case OP_CHOWN:
  1079.     TAINT_PROPER("chown");
  1080.     if (sp - mark > 2) {
  1081.         val = SvIVx(*++mark);
  1082.         val2 = SvIVx(*++mark);
  1083.         tot = sp - mark;
  1084.         while (++mark <= sp) {
  1085.         if (chown(SvPVx(*mark, na),val,val2))
  1086.             tot--;
  1087.         }
  1088.     }
  1089.     break;
  1090. #endif
  1091. #ifdef HAS_KILL
  1092.     case OP_KILL:
  1093.     TAINT_PROPER("kill");
  1094.     s = SvPVx(*++mark, na);
  1095.     tot = sp - mark;
  1096.     if (isUPPER(*s)) {
  1097.         if (*s == 'S' && s[1] == 'I' && s[2] == 'G')
  1098.         s += 3;
  1099.         if (!(val = whichsig(s)))
  1100.         croak("Unrecognized signal name \"%s\"",s);
  1101.     }
  1102.     else
  1103.         val = SvIVx(*mark);
  1104. #ifdef VMS
  1105.     /* kill() doesn't do process groups (job trees?) under VMS */
  1106.     if (val < 0) val = -val;
  1107.     if (val == SIGKILL) {
  1108. #        include <starlet.h>
  1109.         /* Use native sys$delprc() to insure that target process is
  1110.          * deleted; supervisor-mode images don't pay attention to
  1111.          * CRTL's emulation of Unix-style signals and kill()
  1112.          */
  1113.         while (++mark <= sp) {
  1114.         I32 proc = SvIVx(*mark);
  1115.         register unsigned long int __vmssts;
  1116.         if (!((__vmssts = sys$delprc(&proc,0)) & 1)) {
  1117.             tot--;
  1118.             switch (__vmssts) {
  1119.             case SS$_NONEXPR:
  1120.             case SS$_NOSUCHNODE:
  1121.                 SETERRNO(ESRCH,__vmssts);
  1122.                 break;
  1123.             case SS$_NOPRIV:
  1124.                 SETERRNO(EPERM,__vmssts);
  1125.                 break;
  1126.             default:
  1127.                 SETERRNO(EVMSERR,__vmssts);
  1128.             }
  1129.         }
  1130.         }
  1131.         break;
  1132.     }
  1133. #endif
  1134.     if (val < 0) {
  1135.         val = -val;
  1136.         while (++mark <= sp) {
  1137.         I32 proc = SvIVx(*mark);
  1138. #ifdef HAS_KILLPG
  1139.         if (killpg(proc,val))    /* BSD */
  1140. #else
  1141.         if (kill(-proc,val))    /* SYSV */
  1142. #endif
  1143.             tot--;
  1144.         }
  1145.     }
  1146.     else {
  1147.         while (++mark <= sp) {
  1148.         if (kill(SvIVx(*mark),val))
  1149.             tot--;
  1150.         }
  1151.     }
  1152.     break;
  1153. #endif
  1154.     case OP_UNLINK:
  1155.     TAINT_PROPER("unlink");
  1156.     tot = sp - mark;
  1157.     while (++mark <= sp) {
  1158.         s = SvPVx(*mark, na);
  1159.         if (euid || unsafe) {
  1160.         if (UNLINK(s))
  1161.             tot--;
  1162.         }
  1163.         else {    /* don't let root wipe out directories without -U */
  1164. #ifdef HAS_LSTAT
  1165.         if (lstat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode))
  1166. #else
  1167.         if (Stat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode))
  1168. #endif
  1169.             tot--;
  1170.         else {
  1171.             if (UNLINK(s))
  1172.             tot--;
  1173.         }
  1174.         }
  1175.     }
  1176.     break;
  1177. #ifdef HAS_UTIME
  1178.     case OP_UTIME:
  1179.     TAINT_PROPER("utime");
  1180.     if (sp - mark > 2) {
  1181. #if defined(I_UTIME) || defined(VMS)
  1182.         struct utimbuf utbuf;
  1183. #else
  1184.         struct {
  1185.         long    actime;
  1186.         long    modtime;
  1187.         } utbuf;
  1188. #endif
  1189.  
  1190.         Zero(&utbuf, sizeof utbuf, char);
  1191.         utbuf.actime = SvIVx(*++mark);    /* time accessed */
  1192.         utbuf.modtime = SvIVx(*++mark);    /* time modified */
  1193.         tot = sp - mark;
  1194.         while (++mark <= sp) {
  1195.         if (utime(SvPVx(*mark, na),&utbuf))
  1196.             tot--;
  1197.         }
  1198.     }
  1199.     else
  1200.         tot = 0;
  1201.     break;
  1202. #endif
  1203.     }
  1204.     return tot;
  1205. }
  1206.  
  1207. /* Do the permissions allow some operation?  Assumes statcache already set. */
  1208. #ifndef VMS /* VMS' cando is in vms.c */
  1209. I32
  1210. cando(bit, effective, statbufp)
  1211. I32 bit;
  1212. I32 effective;
  1213. register struct stat *statbufp;
  1214. {
  1215. #ifdef DOSISH
  1216.     /* [Comments and code from Len Reed]
  1217.      * MS-DOS "user" is similar to UNIX's "superuser," but can't write
  1218.      * to write-protected files.  The execute permission bit is set
  1219.      * by the Miscrosoft C library stat() function for the following:
  1220.      *        .exe files
  1221.      *        .com files
  1222.      *        .bat files
  1223.      *        directories
  1224.      * All files and directories are readable.
  1225.      * Directories and special files, e.g. "CON", cannot be
  1226.      * write-protected.
  1227.      * [Comment by Tom Dinger -- a directory can have the write-protect
  1228.      *        bit set in the file system, but DOS permits changes to
  1229.      *        the directory anyway.  In addition, all bets are off
  1230.      *        here for networked software, such as Novell and
  1231.      *        Sun's PC-NFS.]
  1232.      */
  1233.  
  1234.      /* Atari stat() does pretty much the same thing. we set x_bit_set_in_stat
  1235.       * too so it will actually look into the files for magic numbers
  1236.       */
  1237.      return (bit & statbufp->st_mode) ? TRUE : FALSE;
  1238.  
  1239. #else /* ! MSDOS */
  1240.     if ((effective ? euid : uid) == 0) {    /* root is special */
  1241.     if (bit == S_IXUSR) {
  1242.         if (statbufp->st_mode & 0111 || S_ISDIR(statbufp->st_mode))
  1243.         return TRUE;
  1244.     }
  1245.     else
  1246.         return TRUE;        /* root reads and writes anything */
  1247.     return FALSE;
  1248.     }
  1249.     if (statbufp->st_uid == (effective ? euid : uid) ) {
  1250.     if (statbufp->st_mode & bit)
  1251.         return TRUE;    /* ok as "user" */
  1252.     }
  1253.     else if (ingroup((I32)statbufp->st_gid,effective)) {
  1254.     if (statbufp->st_mode & bit >> 3)
  1255.         return TRUE;    /* ok as "group" */
  1256.     }
  1257.     else if (statbufp->st_mode & bit >> 6)
  1258.     return TRUE;    /* ok as "other" */
  1259.     return FALSE;
  1260. #endif /* ! MSDOS */
  1261. }
  1262. #endif /* ! VMS */
  1263.  
  1264. I32
  1265. ingroup(testgid,effective)
  1266. I32 testgid;
  1267. I32 effective;
  1268. {
  1269.     if (testgid == (effective ? egid : gid))
  1270.     return TRUE;
  1271. #ifdef HAS_GETGROUPS
  1272. #ifndef NGROUPS
  1273. #define NGROUPS 32
  1274. #endif
  1275.     {
  1276.     Groups_t gary[NGROUPS];
  1277.     I32 anum;
  1278.  
  1279.     anum = getgroups(NGROUPS,gary);
  1280.     while (--anum >= 0)
  1281.         if (gary[anum] == testgid)
  1282.         return TRUE;
  1283.     }
  1284. #endif
  1285.     return FALSE;
  1286. }
  1287.  
  1288. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  1289.  
  1290. I32
  1291. do_ipcget(optype, mark, sp)
  1292. I32 optype;
  1293. SV **mark;
  1294. SV **sp;
  1295. {
  1296.     key_t key;
  1297.     I32 n, flags;
  1298.  
  1299.     key = (key_t)SvNVx(*++mark);
  1300.     n = (optype == OP_MSGGET) ? 0 : SvIVx(*++mark);
  1301.     flags = SvIVx(*++mark);
  1302.     SETERRNO(0,0);
  1303.     switch (optype)
  1304.     {
  1305. #ifdef HAS_MSG
  1306.     case OP_MSGGET:
  1307.     return msgget(key, flags);
  1308. #endif
  1309. #ifdef HAS_SEM
  1310.     case OP_SEMGET:
  1311.     return semget(key, n, flags);
  1312. #endif
  1313. #ifdef HAS_SHM
  1314.     case OP_SHMGET:
  1315.     return shmget(key, n, flags);
  1316. #endif
  1317. #if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM)
  1318.     default:
  1319.     croak("%s not implemented", op_desc[optype]);
  1320. #endif
  1321.     }
  1322.     return -1;            /* should never happen */
  1323. }
  1324.  
  1325. I32
  1326. do_ipcctl(optype, mark, sp)
  1327. I32 optype;
  1328. SV **mark;
  1329. SV **sp;
  1330. {
  1331.     SV *astr;
  1332.     char *a;
  1333.     I32 id, n, cmd, infosize, getinfo;
  1334.     I32 ret = -1;
  1335.  
  1336.     id = SvIVx(*++mark);
  1337.     n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0;
  1338.     cmd = SvIVx(*++mark);
  1339.     astr = *++mark;
  1340.     infosize = 0;
  1341.     getinfo = (cmd == IPC_STAT);
  1342.  
  1343.     switch (optype)
  1344.     {
  1345. #ifdef HAS_MSG
  1346.     case OP_MSGCTL:
  1347.     if (cmd == IPC_STAT || cmd == IPC_SET)
  1348.         infosize = sizeof(struct msqid_ds);
  1349.     break;
  1350. #endif
  1351. #ifdef HAS_SHM
  1352.     case OP_SHMCTL:
  1353.     if (cmd == IPC_STAT || cmd == IPC_SET)
  1354.         infosize = sizeof(struct shmid_ds);
  1355.     break;
  1356. #endif
  1357. #ifdef HAS_SEM
  1358.     case OP_SEMCTL:
  1359.     if (cmd == IPC_STAT || cmd == IPC_SET)
  1360.         infosize = sizeof(struct semid_ds);
  1361.     else if (cmd == GETALL || cmd == SETALL)
  1362.     {
  1363.         struct semid_ds semds;
  1364.         if (semctl(id, 0, IPC_STAT, &semds) == -1)
  1365.         return -1;
  1366.         getinfo = (cmd == GETALL);
  1367.         infosize = semds.sem_nsems * sizeof(short);
  1368.         /* "short" is technically wrong but much more portable
  1369.            than guessing about u_?short(_t)? */
  1370.     }
  1371.     break;
  1372. #endif
  1373. #if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM)
  1374.     default:
  1375.     croak("%s not implemented", op_desc[optype]);
  1376. #endif
  1377.     }
  1378.  
  1379.     if (infosize)
  1380.     {
  1381.     STRLEN len;
  1382.     if (getinfo)
  1383.     {
  1384.         SvPV_force(astr, len);
  1385.         a = SvGROW(astr, infosize+1);
  1386.     }
  1387.     else
  1388.     {
  1389.         a = SvPV(astr, len);
  1390.         if (len != infosize)
  1391.         croak("Bad arg length for %s, is %d, should be %d",
  1392.             op_desc[optype], len, infosize);
  1393.     }
  1394.     }
  1395.     else
  1396.     {
  1397.     I32 i = SvIV(astr);
  1398.     a = (char *)i;        /* ouch */
  1399.     }
  1400.     SETERRNO(0,0);
  1401.     switch (optype)
  1402.     {
  1403. #ifdef HAS_MSG
  1404.     case OP_MSGCTL:
  1405.     ret = msgctl(id, cmd, (struct msqid_ds *)a);
  1406.     break;
  1407. #endif
  1408. #ifdef HAS_SEM
  1409.     case OP_SEMCTL:
  1410.     ret = semctl(id, n, cmd, (struct semid_ds *)a);
  1411.     break;
  1412. #endif
  1413. #ifdef HAS_SHM
  1414.     case OP_SHMCTL:
  1415.     ret = shmctl(id, cmd, (struct shmid_ds *)a);
  1416.     break;
  1417. #endif
  1418.     }
  1419.     if (getinfo && ret >= 0) {
  1420.     SvCUR_set(astr, infosize);
  1421.     *SvEND(astr) = '\0';
  1422.     SvSETMAGIC(astr);
  1423.     }
  1424.     return ret;
  1425. }
  1426.  
  1427. I32
  1428. do_msgsnd(mark, sp)
  1429. SV **mark;
  1430. SV **sp;
  1431. {
  1432. #ifdef HAS_MSG
  1433.     SV *mstr;
  1434.     char *mbuf;
  1435.     I32 id, msize, flags;
  1436.     STRLEN len;
  1437.  
  1438.     id = SvIVx(*++mark);
  1439.     mstr = *++mark;
  1440.     flags = SvIVx(*++mark);
  1441.     mbuf = SvPV(mstr, len);
  1442.     if ((msize = len - sizeof(long)) < 0)
  1443.     croak("Arg too short for msgsnd");
  1444.     SETERRNO(0,0);
  1445.     return msgsnd(id, (struct msgbuf *)mbuf, msize, flags);
  1446. #else
  1447.     croak("msgsnd not implemented");
  1448. #endif
  1449. }
  1450.  
  1451. I32
  1452. do_msgrcv(mark, sp)
  1453. SV **mark;
  1454. SV **sp;
  1455. {
  1456. #ifdef HAS_MSG
  1457.     SV *mstr;
  1458.     char *mbuf;
  1459.     long mtype;
  1460.     I32 id, msize, flags, ret;
  1461.     STRLEN len;
  1462.  
  1463.     id = SvIVx(*++mark);
  1464.     mstr = *++mark;
  1465.     msize = SvIVx(*++mark);
  1466.     mtype = (long)SvIVx(*++mark);
  1467.     flags = SvIVx(*++mark);
  1468.     if (SvTHINKFIRST(mstr)) {
  1469.     if (SvREADONLY(mstr))
  1470.         croak("Can't msgrcv to readonly var");
  1471.     if (SvROK(mstr))
  1472.         sv_unref(mstr);
  1473.     }
  1474.     SvPV_force(mstr, len);
  1475.     mbuf = SvGROW(mstr, sizeof(long)+msize+1);
  1476.     
  1477.     SETERRNO(0,0);
  1478.     ret = msgrcv(id, (struct msgbuf *)mbuf, msize, mtype, flags);
  1479.     if (ret >= 0) {
  1480.     SvCUR_set(mstr, sizeof(long)+ret);
  1481.     *SvEND(mstr) = '\0';
  1482.     }
  1483.     return ret;
  1484. #else
  1485.     croak("msgrcv not implemented");
  1486. #endif
  1487. }
  1488.  
  1489. I32
  1490. do_semop(mark, sp)
  1491. SV **mark;
  1492. SV **sp;
  1493. {
  1494. #ifdef HAS_SEM
  1495.     SV *opstr;
  1496.     char *opbuf;
  1497.     I32 id;
  1498.     STRLEN opsize;
  1499.  
  1500.     id = SvIVx(*++mark);
  1501.     opstr = *++mark;
  1502.     opbuf = SvPV(opstr, opsize);
  1503.     if (opsize < sizeof(struct sembuf)
  1504.     || (opsize % sizeof(struct sembuf)) != 0) {
  1505.     SETERRNO(EINVAL,LIB$_INVARG);
  1506.     return -1;
  1507.     }
  1508.     SETERRNO(0,0);
  1509.     return semop(id, (struct sembuf *)opbuf, opsize/sizeof(struct sembuf));
  1510. #else
  1511.     croak("semop not implemented");
  1512. #endif
  1513. }
  1514.  
  1515. I32
  1516. do_shmio(optype, mark, sp)
  1517. I32 optype;
  1518. SV **mark;
  1519. SV **sp;
  1520. {
  1521. #ifdef HAS_SHM
  1522.     SV *mstr;
  1523.     char *mbuf, *shm;
  1524.     I32 id, mpos, msize;
  1525.     STRLEN len;
  1526.     struct shmid_ds shmds;
  1527.  
  1528.     id = SvIVx(*++mark);
  1529.     mstr = *++mark;
  1530.     mpos = SvIVx(*++mark);
  1531.     msize = SvIVx(*++mark);
  1532.     SETERRNO(0,0);
  1533.     if (shmctl(id, IPC_STAT, &shmds) == -1)
  1534.     return -1;
  1535.     if (mpos < 0 || msize < 0 || mpos + msize > shmds.shm_segsz) {
  1536.     SETERRNO(EFAULT,SS$_ACCVIO);        /* can't do as caller requested */
  1537.     return -1;
  1538.     }
  1539.     shm = (Shmat_t)shmat(id, (char*)NULL, (optype == OP_SHMREAD) ? SHM_RDONLY : 0);
  1540.     if (shm == (char *)-1)    /* I hate System V IPC, I really do */
  1541.     return -1;
  1542.     if (optype == OP_SHMREAD) {
  1543.     SvPV_force(mstr, len);
  1544.     mbuf = SvGROW(mstr, msize+1);
  1545.  
  1546.     Copy(shm + mpos, mbuf, msize, char);
  1547.     SvCUR_set(mstr, msize);
  1548.     *SvEND(mstr) = '\0';
  1549.     SvSETMAGIC(mstr);
  1550.     }
  1551.     else {
  1552.     I32 n;
  1553.  
  1554.     mbuf = SvPV(mstr, len);
  1555.     if ((n = len) > msize)
  1556.         n = msize;
  1557.     Copy(mbuf, shm + mpos, n, char);
  1558.     if (n < msize)
  1559.         memzero(shm + mpos + n, msize - n);
  1560.     }
  1561.     return shmdt(shm);
  1562. #else
  1563.     croak("shm I/O not implemented");
  1564. #endif
  1565. }
  1566.  
  1567. #endif /* SYSV IPC */
  1568.