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