home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / program / language / perl / Source / C / Doio < prev    next >
Encoding:
Text File  |  1991-02-09  |  21.7 KB  |  1,029 lines
  1. /* $Header: doio.c,v 3.0.1.14 91/01/11 17:51:04 lwall Locked $
  2.  *
  3.  *    Copyright (c) 1989, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of the GNU General Public License
  6.  *    as specified in the README file that comes with the perl 3.0 kit.
  7.  *
  8.  * $Log:    doio.c,v $
  9.  * Revision 3.0.1.14  91/01/11  17:51:04  lwall
  10.  * patch42: ANSIfied the stat mode checking
  11.  * patch42: the -i switch is now much more robust and informative
  12.  * patch42: close on a pipe didn't return failure correctly
  13.  * patch42: stat on temp values could wipe them out prematurely, i.e. grep(-d,<*>)
  14.  * patch42: -l didn't work right with _
  15.  * 
  16.  * Revision 3.0.1.13  90/11/10  01:17:37  lwall
  17.  * patch38: -e _ was wrong if last stat failed
  18.  * patch38: more msdos/os2 upgrades
  19.  * 
  20.  * Revision 3.0.1.12  90/10/20  02:04:18  lwall
  21.  * patch37: split out separate Sys V IPC features
  22.  * 
  23.  * Revision 3.0.1.11  90/10/15  16:16:11  lwall
  24.  * patch29: added SysV IPC
  25.  * patch29: file - didn't auto-close cleanly
  26.  * patch29: close; core dumped
  27.  * patch29: more MSDOS and OS/2 updates, from Kai Uwe Rommel
  28.  * patch29: various portability fixes
  29.  * patch29: *foo now prints as *package'foo
  30.  * 
  31.  * Revision 3.0.1.10  90/08/13  22:14:29  lwall
  32.  * patch28: close-on-exec problems on dup'ed file descriptors
  33.  * patch28: F_FREESP wasn't implemented the way I thought
  34.  * 
  35.  * Revision 3.0.1.9  90/08/09  02:56:19  lwall
  36.  * patch19: various MSDOS and OS/2 patches folded in
  37.  * patch19: prints now check error status better
  38.  * patch19: printing a list with null elements only printed front of list
  39.  * patch19: on machines with vfork child would allocate memory in parent
  40.  * patch19: getsockname and getpeername gave bogus warning on error
  41.  * patch19: MACH doesn't have seekdir or telldir
  42.  * 
  43.  * Revision 3.0.1.8  90/03/27  15:44:02  lwall
  44.  * patch16: MSDOS support
  45.  * patch16: support for machines that can't cast negative floats to unsigned ints
  46.  * patch16: system() can lose arguments passed to shell scripts on SysV machines
  47.  * 
  48.  * Revision 3.0.1.7  90/03/14  12:26:24  lwall
  49.  * patch15: commands involving execs could cause malloc arena corruption
  50.  * 
  51.  * Revision 3.0.1.6  90/03/12  16:30:07  lwall
  52.  * patch13: system 'FOO=bar command' didn't invoke sh as it should
  53.  * 
  54.  * Revision 3.0.1.5  90/02/28  17:01:36  lwall
  55.  * patch9: open(FOO,"$filename\0") will now protect trailing spaces in filename
  56.  * patch9: removed obsolete checks to avoid opening block devices
  57.  * patch9: removed references to acusec and modusec that some utime.h's have
  58.  * patch9: added pipe function
  59.  * 
  60.  * Revision 3.0.1.4  89/12/21  19:55:10  lwall
  61.  * patch7: select now works on big-endian machines
  62.  * patch7: errno may now be a macro with an lvalue
  63.  * patch7: ANSI strerror() is now supported
  64.  * patch7: Configure now detects DG/UX thingies like [sg]etpgrp2 and utime.h
  65.  * 
  66.  * Revision 3.0.1.3  89/11/17  15:13:06  lwall
  67.  * patch5: some systems have symlink() but not lstat()
  68.  * patch5: some systems have dirent.h but not readdir()
  69.  * 
  70.  * Revision 3.0.1.2  89/11/11  04:25:51  lwall
  71.  * patch2: orthogonalized the file modes some so we can have <& +<& etc.
  72.  * patch2: do_open() now detects sockets passed to process from parent
  73.  * patch2: fd's above 2 are now closed on exec
  74.  * patch2: csh code can now use csh from other than /bin
  75.  * patch2: getsockopt, get{sock,peer}name didn't define result properly
  76.  * patch2: warn("shutdown") was replicated
  77.  * patch2: gethostbyname was misdeclared
  78.  * patch2: telldir() is sometimes a macro
  79.  * 
  80.  * Revision 3.0.1.1  89/10/26  23:10:05  lwall
  81.  * patch1: Configure now checks for BSD shadow passwords
  82.  * 
  83.  * Revision 3.0  89/10/18  15:10:54  lwall
  84.  * 3.0 baseline
  85.  * 
  86.  */
  87.  
  88. #include "EXTERN.h"
  89. #include "perl.h"
  90.  
  91. #ifdef SOCKET
  92. #include <sys/socket.h>
  93. #include <netdb.h>
  94. #endif
  95.  
  96. #if defined(SELECT) && (defined(M_UNIX) || defined(M_XENIX))
  97. #include <sys/select.h>
  98. #endif
  99.  
  100. #ifdef I_PWD
  101. #include <pwd.h>
  102. #endif
  103. #ifdef I_GRP
  104. #include <grp.h>
  105. #endif
  106. #ifdef I_UTIME
  107. #include <utime.h>
  108. #endif
  109. #ifdef I_FCNTL
  110. #include <fcntl.h>
  111. #endif
  112.  
  113. int laststatval = -1;
  114.  
  115. bool
  116. do_open(stab,name,len)
  117. STAB *stab;
  118. register char *name;
  119. STRLEN len;
  120. {
  121.     FILE *fp = Nullfp;
  122.     register STIO *stio = stab_io(stab);
  123.     char *myname = savestr(name);
  124.     int result;
  125.     int fd;
  126.     FILE *fp1;
  127.     int writing = 0;
  128.     char mode[3];        /* stdio file mode ("r\0" or "r+\0") */
  129.  
  130.     name = myname;
  131.     while (len && isspace(name[len-1]))
  132.     name[--len] = '\0';
  133.     if (!stio)
  134.     stio = stab_io(stab) = stio_new();
  135.     else if (stio->ifp) {
  136.     fp1 = stio->ifp;
  137.     if (stio->type == '|')
  138.         result = mypclose(stio->ifp);
  139.     else if (stio->type != '-')
  140.         result = fclose(stio->ifp);
  141.     else
  142.         result = 0;
  143.     if (result == EOF && fp1 != stdin && fp1 != stdout && fp1 != stderr)
  144.         fprintf(stderr,"Warning: unable to close filehandle %s properly.\n",
  145.           stab_name(stab));
  146.     stio->ofp = stio->ifp = Nullfp;
  147.     }
  148.     if (*name == '+' && len > 1 && name[len-1] != '|') {    /* scary */
  149.     mode[1] = *name++;
  150.     mode[2] = '\0';
  151.     --len;
  152.     writing = 1;
  153.     }
  154.     else  {
  155.     mode[1] = '\0';
  156.     }
  157.     stio->type = *name;
  158.     if (*name == '|') {
  159.     for (name++; isspace(*name); name++) ;
  160. #ifdef TAINT
  161.     taintenv();
  162.     taintproper("Insecure dependency in piped open");
  163. #endif
  164.     fp = mypopen(name,"w");
  165.     writing = 1;
  166.     }
  167.     else if (*name == '>') {
  168. #ifdef TAINT
  169.     taintproper("Insecure dependency in open");
  170. #endif
  171.     name++;
  172.     if (*name == '>') {
  173.         mode[0] = stio->type = 'a';
  174.         name++;
  175.     }
  176.     else
  177.         mode[0] = 'w';
  178.     writing = 1;
  179.     if (*name == '&') {
  180.       duplicity:
  181.         name++;
  182.  
  183.         /* Can only dup stdin/out/err */
  184.         stio->type = '-';
  185.  
  186.         while (isspace(*name))
  187.         name++;
  188.  
  189.         if (isdigit(*name))
  190.         {
  191.         fd = atoi(name);
  192.         switch (fd)
  193.         {
  194.             case 0:  fp = stdin;  break;
  195.             case 1:  fp = stdout; break;
  196.             case 2:  fp = stderr; break;
  197.             default: return FALSE;
  198.         }
  199.         }
  200.         else
  201.         {
  202.         stab = stabent(name,FALSE);
  203.  
  204.         if (!stab || !stab_io(stab))
  205.             return FALSE;
  206.  
  207.         if (stab_io(stab)->ifp && stab_io(stab)->type == '-')
  208.             fp = stab_io(stab)->ifp;
  209.         else
  210.             return FALSE;
  211.         }
  212.     }
  213.     else {
  214.         while (isspace(*name))
  215.         name++;
  216.         if (strEQ(name,"-")) {
  217.         fp = stdout;
  218.         stio->type = '-';
  219.         }
  220.         else  {
  221.         fp = fopen(name,mode);
  222.  
  223.         /* Hack: Set the file's timestamp, as the Archimedes C library
  224.          * does not correctly set it until the first byte is written.
  225.          * This causes problems when creating empty files....
  226.          */
  227.         stamp(name);
  228.         }
  229.     }
  230.     }
  231.     else {
  232.     if (*name == '<') {
  233.         mode[0] = 'r';
  234.         if (*name == '&')
  235.         goto duplicity;
  236.         name++;
  237.         while (isspace(*name))
  238.         name++;
  239.         if (strEQ(name,"-")) {
  240.         fp = stdin;
  241.         stio->type = '-';
  242.         }
  243.         else
  244.         fp = fopen(name,mode);
  245.     }
  246.     else if (name[len-1] == '|') {
  247. #ifdef TAINT
  248.         taintenv();
  249.         taintproper("Insecure dependency in piped open");
  250. #endif
  251.         name[--len] = '\0';
  252.         while (len && isspace(name[len-1]))
  253.         name[--len] = '\0';
  254.         for (; isspace(*name); name++) ;
  255.         fp = mypopen(name,"r");
  256.         stio->type = '|';
  257.     }
  258.     else {
  259.         stio->type = '<';
  260.         for (; isspace(*name); name++) ;
  261.         if (strEQ(name,"-")) {
  262.         fp = stdin;
  263.         stio->type = '-';
  264.         }
  265.         else
  266.         fp = fopen(name,"r");
  267.     }
  268.     }
  269.  
  270.     stio->name = savestr(name);
  271.  
  272.     if (!fp)
  273.     {
  274.     _kernel_osfile_block blk;
  275.  
  276.     /* Record a 'file not found' error */
  277.     blk.load = 0;
  278.     _kernel_osfile(19,name,&blk);
  279.  
  280.     save_err();
  281.     }
  282.  
  283.     if (stio->type && stio->type != '|' && stio->type != '-')
  284.     stio->statval = stat(stio->name, &stio->statcache);
  285.     else
  286.     stio->statval = -1;
  287.  
  288.     statbuf = stio->statcache;
  289.  
  290.     Safefree(myname);
  291.     stio->ifp = fp;
  292.  
  293.     if (writing)
  294.     stio->ofp = fp;
  295.  
  296.     if (!fp)
  297.     return FALSE;
  298.  
  299.     return TRUE;
  300. }
  301.  
  302. FILE *
  303. nextargv(stab)
  304. register STAB *stab;
  305. {
  306.     register STR *str;
  307.     char *oldname;
  308.     char *newname;
  309.     static char *tmpname = 0;
  310.  
  311.     while (alen(stab_xarray(stab)) >= 0) {
  312.     str = ashift(stab_xarray(stab));
  313.     str_sset(stab_val(stab),str);
  314.     STABSET(stab_val(stab));
  315.     oldname = str_get(stab_val(stab));
  316.  
  317.     if (!inplace)
  318.         newname = oldname;
  319.     else {
  320. #ifdef TAINT
  321.         taintproper("Insecure dependency in inplace open");
  322. #endif
  323.         if (*inplace) {
  324.             str_set(str,inplace);
  325.         str_cat(str,oldname);
  326.         if (frename(oldname,str->str_ptr))
  327.             fatal("Can't do inplace edit");
  328.         newname = savestr(str->str_ptr);
  329.         }
  330.         else {
  331.         if (!tmpname)
  332.             tmpname = mktemp("PerlTmp2");
  333.  
  334.         if (frename(oldname,tmpname))
  335.             fatal("Can't do inplace edit");
  336.         newname = savestr(tmpname);
  337.         }
  338.  
  339.         str_nset(str,">",1);
  340.         str_cat(str,oldname);
  341.         if (!do_open(argvoutstab,str->str_ptr,str->str_cur))
  342.         fatal("Can't do inplace edit");
  343.         defoutstab = argvoutstab;
  344.     }
  345.  
  346.     if (do_open(stab,newname,stab_val(stab)->str_cur)) {
  347.         if (inplace)
  348.         Safefree(newname);
  349.         str_free(str);
  350.         return stab_io(stab)->ifp;
  351.     }
  352.     else
  353.         fprintf(stderr,"Can't open %s\n",newname);
  354.     str_free(str);
  355.     }
  356.     (void)do_close(stab,FALSE);
  357.     if (inplace) {
  358.     (void)do_close(argvoutstab,FALSE);
  359.     if (tmpname) {
  360.         (void)UNLINK(tmpname);
  361.         free(tmpname);
  362.         tmpname = 0;
  363.     }
  364.     defoutstab = stabent("STDOUT",TRUE);
  365.     }
  366.     return Nullfp;
  367. }
  368.  
  369. bool
  370. do_close(stab,explicit)
  371. STAB *stab;
  372. int explicit;    /* Was bool */
  373. {
  374.     bool retval = FALSE;
  375.     register STIO *stio;
  376.     int status;
  377.  
  378.     if (!stab)
  379.     stab = argvstab;
  380.     if (!stab)
  381.     return FALSE;
  382.     stio = stab_io(stab);
  383.     if (!stio) {        /* never opened */
  384.     if (dowarn && explicit)
  385.         warn("Close on unopened file <%s>",stab_name(stab));
  386.     return FALSE;
  387.     }
  388.     if (stio->ifp) {
  389.     if (stio->type == '|') {
  390.         status = mypclose(stio->ifp);
  391.         retval = (status == 0);
  392.         statusvalue = status;
  393.     }
  394.     else if (stio->type == '-')
  395.         retval = TRUE;
  396.     else
  397.         retval = (fclose(stio->ifp) != EOF);
  398.  
  399.     stio->ofp = stio->ifp = Nullfp;
  400.     }
  401.     if (explicit)
  402.     stio->lines = 0;
  403.     stio->type = ' ';
  404.     stio->statval = 0;
  405.     Zero(&stio->statcache,1,struct stat);
  406.     save_err();
  407.     return retval;
  408. }
  409.  
  410. bool
  411. do_eof(stab)
  412. STAB *stab;
  413. {
  414.     register STIO *stio;
  415.     int ch;
  416.  
  417.     if (!stab) {            /* eof() */
  418.     if (argvstab)
  419.         stio = stab_io(argvstab);
  420.     else
  421.         return TRUE;
  422.     }
  423.     else
  424.     stio = stab_io(stab);
  425.  
  426.     if (!stio)
  427.     return TRUE;
  428.  
  429.     while (stio->ifp) {
  430.  
  431. #ifdef STDSTDIO            /* (the code works without this) */
  432.     if (stio->ifp->_cnt > 0)    /* cheat a little, since */
  433.         return FALSE;        /* this is the most usual case */
  434. #endif
  435.  
  436.     ch = getc(stio->ifp);
  437.     if (ch != EOF) {
  438.         (void)ungetc(ch, stio->ifp);
  439.         return FALSE;
  440.     }
  441.     if (!stab) {            /* not necessarily a real EOF yet? */
  442.         if (!nextargv(argvstab))    /* get another fp handy */
  443.         return TRUE;
  444.     }
  445.     else
  446.         return TRUE;        /* normal fp, definitely end of file */
  447.     }
  448.     return TRUE;
  449. }
  450.  
  451. long
  452. do_tell(stab)
  453. STAB *stab;
  454. {
  455.     register STIO *stio;
  456.  
  457.     if (!stab)
  458.     goto phooey;
  459.  
  460.     stio = stab_io(stab);
  461.     if (!stio || !stio->ifp)
  462.     goto phooey;
  463.  
  464.     return ftell(stio->ifp);
  465.  
  466. phooey:
  467.     if (dowarn)
  468.     warn("tell() on unopened file");
  469.     return -1L;
  470. }
  471.  
  472. bool
  473. do_seek(stab, pos, whence)
  474. STAB *stab;
  475. long pos;
  476. int whence;
  477. {
  478.     register STIO *stio;
  479.  
  480.     if (!stab)
  481.     goto nuts;
  482.  
  483.     stio = stab_io(stab);
  484.     if (!stio || !stio->ifp)
  485.     goto nuts;
  486.  
  487.     return fseek(stio->ifp, pos, whence) >= 0;
  488.  
  489. nuts:
  490.     if (dowarn)
  491.     warn("seek() on unopened file");
  492.     return FALSE;
  493. }
  494.  
  495. int
  496. do_stat(str,arg,gimme,arglast)
  497. STR *str;
  498. register ARG *arg;
  499. int gimme;
  500. int *arglast;
  501. {
  502.     register ARRAY *ary = stack;
  503.     register int sp = arglast[0] + 1;
  504.     int max = 13;
  505.  
  506.     if ((arg[1].arg_type & A_MASK) == A_WORD) {
  507.     tmpstab = arg[1].arg_ptr.arg_stab;
  508.     if (tmpstab != defstab) {
  509.         statstab = tmpstab;
  510.         str_set(statname,stab_io(tmpstab)->name);
  511.         if (!stab_io(tmpstab) || !stab_io(tmpstab)->ifp ||
  512.          stab_io(tmpstab)->statval < 0) {
  513.         max = 0;
  514.         laststatval = -1;
  515.         }
  516.         else
  517.         statcache = stab_io(tmpstab)->statcache;
  518.     }
  519.     else if (laststatval < 0)
  520.         max = 0;
  521.     }
  522.     else {
  523.     str_set(statname,str_get(ary->ary_array[sp]));
  524.     statstab = Nullstab;
  525.     laststatval = stat(str_get(statname),&statcache);
  526.     if (laststatval < 0) {
  527.         max = 0;
  528.         save_err();
  529.     }
  530.     }
  531.  
  532.     if (gimme != G_ARRAY) {
  533.     if (max)
  534.         str_sset(str,&str_yes);
  535.     else
  536.         str_sset(str,&str_undef);
  537.     STABSET(str);
  538.     ary->ary_array[sp] = str;
  539.     return sp;
  540.     }
  541.     sp--;
  542.     if (max) {
  543.     (void)astore(ary,++sp,
  544.       str_2static(str_nmake((double)statcache.st_type)));
  545.     (void)astore(ary,++sp,
  546.       str_2static(str_nmake((double)statcache.st_ftype)));
  547.     (void)astore(ary,++sp,
  548.       str_2static(str_nmake((double)statcache.st_load)));
  549.     (void)astore(ary,++sp,
  550.       str_2static(str_nmake((double)statcache.st_exec)));
  551.     (void)astore(ary,++sp,
  552.       str_2static(str_nmake((double)statcache.st_length)));
  553.     (void)astore(ary,++sp,
  554.       str_2static(str_nmake((double)statcache.st_attr)));
  555.     (void)astore(ary,++sp,
  556.       str_2static(str_nmake((double)statcache.st_time)));
  557.     (void)astore(ary,++sp,
  558.       str_2static(str_nmake((double)statcache.st_utime)));
  559.     }
  560.  
  561.     save_err();
  562.  
  563.     return sp;
  564. }
  565.  
  566. int
  567. do_truncate(str,arg,gimme,arglast)
  568. STR *str;
  569. register ARG *arg;
  570. int gimme;
  571. int *arglast;
  572. {
  573.     register ARRAY *ary = stack;
  574.     register int sp = arglast[0] + 1;
  575.     unsigned int len = (unsigned int)str_gnum(ary->ary_array[sp+1]);
  576.     int result = 1;
  577.     STAB *tmpstab;
  578.  
  579.     USE(gimme);
  580.  
  581.     if ((arg[1].arg_type & A_MASK) == A_WORD) {
  582.     tmpstab = arg[1].arg_ptr.arg_stab;
  583.     if (!stab_io(tmpstab))
  584.         result = 0;
  585.     else {
  586.         /* The following is unsafe. It is not clear that modifying the
  587.          * file length of a stdio-opened file while the file is still
  588.          * open will not cause problems, due to buffering. I have tried
  589.          * to minimise these by the seek/flush sequences, but the whole
  590.          * thing is still undocumented.
  591.          */
  592.         FILE *fp = stab_io(tmpstab)->ifp;
  593.         int handle = ((int *)fp)[5];        /* !!!!! */
  594.  
  595.         if (ftell(fp) > len)
  596.             fseek (fp, len, SEEK_SET);
  597.  
  598.         fflush(fp);
  599.         if (_kernel_osargs(3, handle, len) < 0) {
  600.         save_err();
  601.         result = 0;
  602.         }
  603.         fseek(fp, ftell(fp), SEEK_SET);
  604.         fflush(fp);
  605.     }
  606.     }
  607.     else {
  608.     int handle = _kernel_osfind(0xC4, str_get(ary->ary_array[sp]));
  609.     if (handle == 0) {
  610.         save_err();
  611.         result = 0;
  612.     }
  613.     else if (_kernel_osargs(3, handle, len) < 0) {
  614.         save_err();
  615.         result = 0;
  616.     }
  617.  
  618.     if (handle)
  619.         _kernel_osfind(0, (char *)handle);
  620.     }
  621.  
  622.     if (result)
  623.     str_sset(str,&str_yes);
  624.     else
  625.     str_sset(str,&str_undef);
  626.     STABSET(str);
  627.     ary->ary_array[sp] = str;
  628.     return sp;
  629. }
  630.  
  631. int
  632. looks_like_number(str)
  633. STR *str;
  634. {
  635.     register char *s;
  636.     register char *send;
  637.  
  638.     if (!str->str_pok)
  639.     return TRUE;
  640.     s = str->str_ptr; 
  641.     send = s + str->str_cur;
  642.     while (isspace(*s))
  643.     s++;
  644.     if (s >= send)
  645.     return FALSE;
  646.     if (*s == '+' || *s == '-')
  647.     s++;
  648.     while (isdigit(*s))
  649.     s++;
  650.     if (s == send)
  651.     return TRUE;
  652.     if (*s == '.') 
  653.     s++;
  654.     else if (s == str->str_ptr)
  655.     return FALSE;
  656.     while (isdigit(*s))
  657.     s++;
  658.     if (s == send)
  659.     return TRUE;
  660.     if (*s == 'e' || *s == 'E') {
  661.     s++;
  662.     if (*s == '+' || *s == '-')
  663.         s++;
  664.     while (isdigit(*s))
  665.         s++;
  666.     }
  667.     while (isspace(*s))
  668.     s++;
  669.     if (s >= send)
  670.     return TRUE;
  671.     return FALSE;
  672. }
  673.  
  674. bool
  675. do_print(str,fp)
  676. register STR *str;
  677. FILE *fp;
  678. {
  679.     register char *tmps;
  680.  
  681.     if (!fp) {
  682.     if (dowarn)
  683.         warn("print to unopened file");
  684.     return FALSE;
  685.     }
  686.     if (!str)
  687.     return TRUE;
  688.     if (ofmt &&
  689.       ((str->str_nok && str->str_u.str_nval != 0.0)
  690.        || (looks_like_number(str) && str_gnum(str) != 0.0) ) ) {
  691.     fprintf(fp, ofmt, str->str_u.str_nval);
  692.     return !ferror(fp);
  693.     }
  694.     else {
  695.     tmps = str_get(str);
  696.     if (*tmps == 'S' && tmps[1] == 't' && tmps[2] == 'B' && tmps[3] == '\0'
  697.       && str->str_cur == sizeof(STBP) && strlen(tmps) < str->str_cur) {
  698.         STR *tmpstr = str_static(&str_undef);
  699.         stab_fullname(tmpstr,((STAB*)str));/* a stab value, be nice */
  700.         str = tmpstr;
  701.         tmps = str->str_ptr;
  702.         putc('*',fp);
  703.     }
  704.     if (str->str_cur && (fwrite(tmps,1,str->str_cur,fp) == 0 || ferror(fp)))
  705.         return FALSE;
  706.     }
  707.     return TRUE;
  708. }
  709.  
  710. bool
  711. do_aprint(arg,fp,arglast)
  712. register ARG *arg;
  713. register FILE *fp;
  714. int *arglast;
  715. {
  716.     register STR **st = stack->ary_array;
  717.     register int sp = arglast[1];
  718.     register int retval;
  719.     register int items = arglast[2] - sp;
  720.  
  721.     if (!fp) {
  722.     if (dowarn)
  723.         warn("print to unopened file");
  724.     return FALSE;
  725.     }
  726.     st += ++sp;
  727.     if (arg->arg_type == O_PRTF) {
  728.     do_sprintf(arg->arg_ptr.arg_str,items,st);
  729.     retval = do_print(arg->arg_ptr.arg_str,fp);
  730.     }
  731.     else {
  732.     retval = (items <= 0);
  733.     for (; items > 0; items--,st++) {
  734.         if (retval && ofslen) {
  735.         if (fwrite(ofs, 1, ofslen, fp) == 0 || ferror(fp)) {
  736.             retval = FALSE;
  737.             break;
  738.         }
  739.         }
  740.         if ((retval = do_print(*st, fp)) == 0)
  741.         break;
  742.     }
  743.     if (retval && orslen)
  744.         if (fwrite(ors, 1, orslen, fp) == 0 || ferror(fp))
  745.         retval = FALSE;
  746.     }
  747.     return retval;
  748. }
  749.  
  750. int
  751. mystat(arg,str)
  752. ARG *arg;
  753. STR *str;
  754. {
  755.     STIO *stio;
  756.  
  757.     if (arg[1].arg_type & A_DONT) {
  758.     stio = stab_io(arg[1].arg_ptr.arg_stab);
  759.     if (stio && stio->ifp) {
  760.         statstab = arg[1].arg_ptr.arg_stab;
  761.         str_set(statname,stio->name);
  762.         laststatval = stio->statval;
  763.         statcache = stio->statcache;
  764.         return laststatval;
  765.     }
  766.     else {
  767.         if (arg[1].arg_ptr.arg_stab == defstab)
  768.         return laststatval;
  769.         if (dowarn)
  770.         warn("Stat on unopened file <%s>",
  771.           stab_name(arg[1].arg_ptr.arg_stab));
  772.         statstab = Nullstab;
  773.         str_set(statname,"");
  774.         return (laststatval = -1);
  775.     }
  776.     }
  777.     else {
  778.     statstab = Nullstab;
  779.     str_set(statname,str_get(str));
  780.     laststatval = stat(str_get(str),&statcache);
  781.     if (laststatval < 0)
  782.         save_err();
  783.     return laststatval;
  784.     }
  785. }
  786.  
  787. STR *
  788. do_fttext(arg,str)
  789. register ARG *arg;
  790. STR *str;
  791. {
  792.     int i;
  793.     int len;
  794.     int odd = 0;
  795.     STDCHAR tbuf[512];
  796.     register STDCHAR *s;
  797.     register STIO *stio;
  798.     FILE *fp;
  799.  
  800.     if (arg[1].arg_type & A_DONT) {
  801.     if (arg[1].arg_ptr.arg_stab == defstab) {
  802.         if (statstab)
  803.         stio = stab_io(statstab);
  804.         else {
  805.         str = statname;
  806.         goto really_filename;
  807.         }
  808.     }
  809.     else {
  810.         statstab = arg[1].arg_ptr.arg_stab;
  811.         str_set(statname,"");
  812.         stio = stab_io(statstab);
  813.     }
  814.     if (stio && stio->ifp) {
  815. #ifdef STDSTDIO
  816.         fstat(fileno(stio->ifp),&statcache);
  817.         if (stio->ifp->_cnt <= 0) {
  818.         i = getc(stio->ifp);
  819.         if (i != EOF)
  820.             (void)ungetc(i,stio->ifp);
  821.         }
  822.         if (stio->ifp->_cnt <= 0)    /* null file is anything */
  823.         return &str_yes;
  824.         len = stio->ifp->_cnt + (stio->ifp->_ptr - stio->ifp->_base);
  825.         s = stio->ifp->_base;
  826. #else
  827.         fatal("-T and -B not implemented on filehandles\n");
  828. #endif
  829.     }
  830.     else {
  831.         if (dowarn)
  832.         warn("Test on unopened file <%s>",
  833.           stab_name(arg[1].arg_ptr.arg_stab));
  834.         return &str_undef;
  835.     }
  836.     }
  837.     else {
  838.     statstab = Nullstab;
  839.     str_set(statname,str_get(str));
  840.       really_filename:
  841.     if (stat(str_get(str),&statcache) == -1)
  842.         return &str_undef;
  843.     
  844.     fp = fopen(str_get(str),"r");
  845.     if (fp == Nullfp)
  846.         return &str_undef;
  847.  
  848.     len = fread(tbuf,1,512,fp);
  849.     if (ferror(fp)) {
  850.         (void)fclose(fp);
  851.         return &str_undef;
  852.     }
  853.  
  854.     if (len == 0) /* null file is anything */
  855.         return &str_yes;
  856.  
  857.     (void)fclose(fp);
  858.     s = tbuf;
  859.     }
  860.  
  861.     /* now scan s to look for textiness */
  862.  
  863.     for (i = 0; i < len; i++,s++) {
  864.     if (!*s) {            /* null never allowed in text */
  865.         odd += len;
  866.         break;
  867.     }
  868.     else if (*s & 128)
  869.         odd++;
  870.     else if (*s < 32 &&
  871.       *s != '\n' && *s != '\r' && *s != '\b' &&
  872.       *s != '\t' && *s != '\f' && *s != 27)
  873.         odd++;
  874.     }
  875.  
  876.     if ((odd * 10 > len) == (arg->arg_type == O_FTTEXT)) /* allow 10% odd */
  877.     return &str_no;
  878.     else
  879.     return &str_yes;
  880. }
  881.  
  882. bool
  883. do_aexec(really,arglast)
  884. STR *really;
  885. int *arglast;
  886. {
  887.     USE(really);
  888.     return exec_cmdv(1,arglast);
  889. }
  890.  
  891. bool
  892. do_exec(cmd)
  893. char *cmd;
  894. {
  895.     STR *str;
  896.     int status;
  897.  
  898.     if (*cmd == '\0')
  899.     exit(0);
  900.  
  901.     _kernel_setenv("Sys$ReturnCode", "0");
  902.  
  903.     str = str_make("Call:",5);
  904.     str_cat(str,cmd);
  905.     status = system(str->str_ptr);
  906.     str_free(str);
  907.  
  908.     if (status != _kernel_ERROR)
  909.     exit(0);
  910.  
  911.     save_err();
  912.     return FALSE;
  913.  
  914. }
  915.  
  916. int
  917. do_dirop(optype,stab,gimme,arglast)
  918. int optype;
  919. STAB *stab;
  920. int gimme;
  921. int *arglast;
  922. {
  923. #if defined(DIRENT) && defined(READDIR)
  924.     register ARRAY *ary = stack;
  925.     register STR **st = ary->ary_array;
  926.     register int sp = arglast[1];
  927.     register STIO *stio;
  928.     long along;
  929. #ifndef telldir
  930.     long telldir();
  931. #endif
  932.     register struct DIRENT *dp;
  933.  
  934.     if (!stab)
  935.     goto nope;
  936.     if ((stio = stab_io(stab)) == Null(STIO*))
  937.     stio = stab_io(stab) = stio_new();
  938.     if (!stio->dirp && optype != O_OPENDIR)
  939.     goto nope;
  940.     st[sp] = &str_yes;
  941.     switch (optype) {
  942.     case O_OPENDIR:
  943.     if (stio->dirp)
  944.         closedir(stio->dirp);
  945.     if ((stio->dirp = opendir(str_get(st[sp+1]))) == Null(DIR*))
  946.         goto nope;
  947.     break;
  948.     case O_READDIR:
  949.     if (gimme == G_ARRAY) {
  950.         --sp;
  951.         while ((dp = readdir(stio->dirp)) != Null(struct DIRENT *)) {
  952. #ifdef DIRNAMLEN
  953.         (void)astore(ary,++sp,
  954.           str_2static(str_make(dp->d_name,dp->d_namlen)));
  955. #else
  956.         (void)astore(ary,++sp,
  957.           str_2static(str_make(dp->d_name,0)));
  958. #endif
  959.         }
  960.     }
  961.     else {
  962.         if ((dp = readdir(stio->dirp)) == Null(struct DIRENT *))
  963.         goto nope;
  964.         st[sp] = str_static(&str_undef);
  965. #ifdef DIRNAMLEN
  966.         str_nset(st[sp], dp->d_name, dp->d_namlen);
  967. #else
  968.         str_set(st[sp], dp->d_name);
  969. #endif
  970.     }
  971.     break;
  972.     case O_TELLDIR:
  973.     st[sp] = str_static(&str_undef);
  974.     str_numset(st[sp], (double)telldir(stio->dirp));
  975.     break;
  976.     case O_SEEKDIR:
  977.     st[sp] = str_static(&str_undef);
  978.     along = (long)str_gnum(st[sp+1]);
  979.     (void)seekdir(stio->dirp,along);
  980.     break;
  981.     case O_REWINDDIR:
  982.     st[sp] = str_static(&str_undef);
  983.     (void)rewinddir(stio->dirp);
  984.     break;
  985.     case O_CLOSEDIR:
  986.     st[sp] = str_static(&str_undef);
  987.     (void)closedir(stio->dirp);
  988.     stio->dirp = 0;
  989.     break;
  990.     }
  991.     return sp;
  992.  
  993. nope:
  994.     st[sp] = &str_undef;
  995.     return sp;
  996.  
  997. #else
  998.     fatal("Unimplemented directory operation");
  999. #endif
  1000. }
  1001.  
  1002. int
  1003. do_unlink(arglast)
  1004. int *arglast;
  1005. {
  1006.     register STR **st = stack->ary_array;
  1007.     register int sp = arglast[1];
  1008.     register int items = arglast[2] - sp;
  1009.     register int tot = 0;
  1010.     char *s;
  1011.  
  1012. #ifdef TAINT
  1013.     for (st += ++sp; items--; st++)
  1014.     tainted |= (*st)->str_tainted;
  1015.     st = stack->ary_array;
  1016.     sp = arglast[1];
  1017.     items = arglast[2] - sp;
  1018.  
  1019.     taintproper("Insecure dependency in unlink");
  1020. #endif
  1021.     tot = items;
  1022.     while (items--) {
  1023.     s = str_get(st[++sp]);
  1024.     if (UNLINK(s))
  1025.         tot--;
  1026.     }
  1027.     return tot;
  1028. }
  1029.