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