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