libf2c/libI77/open.c

   1 /* Define _XOPEN_SOURCE to get tempnam prototype with glibc et al --
   2    more general than _INCLUDE_XOPEN_SOURCE used elsewhere `for HP-UX'.  */
   3 #define _XOPEN_SOURCE 1
   4 #include "config.h"
   5 #include "f2c.h"
   6 #include "fio.h"
   7 #include <string.h>
   8 #ifndef NON_POSIX_STDIO
   9 #ifdef MSDOS
  10 #include "io.h"
  11 #else
  12 #include "unistd.h"     /* for access */
  13 #endif
  14 #endif
  15
  16 #ifdef KR_headers
  17 extern char *malloc();
  18 #ifdef NON_ANSI_STDIO
  19 extern char *mktemp();
  20 #endif
  21 extern integer f_clos();
  22 #else
  23 #undef abs
  24 #undef min
  25 #undef max
  26 #include <stdlib.h>
  27 extern int f__canseek(FILE*);
  28 extern integer f_clos(cllist*);
  29 #endif
  30
  31 #ifdef NON_ANSI_RW_MODES
  32 char *f__r_mode[2] = {"r", "r"};
  33 char *f__w_mode[4] = {"w", "w", "r+w", "r+w"};
  34 #else
  35 char *f__r_mode[2] = {"rb", "r"};
  36 char *f__w_mode[4] = {"wb", "w", "r+b", "r+"};
  37 #endif
  38
  39  static char f__buf0[400], *f__buf = f__buf0;
  40  int f__buflen = (int)sizeof(f__buf0);
  41
  42  static void
  43 #ifdef KR_headers
  44 f__bufadj(n, c) int n, c;
  45 #else
  46 f__bufadj(int n, int c)
  47 #endif
  48 {
  49         unsigned int len;
  50         char *nbuf, *s, *t, *te;
  51
  52         if (f__buf == f__buf0)
  53                 f__buflen = 1024;
  54         while(f__buflen <= n)
  55                 f__buflen <<= 1;
  56         len = (unsigned int)f__buflen;
  57         if (len != f__buflen || !(nbuf = (char*)malloc(len)))
  58                 f__fatal(113, "malloc failure");
  59         s = nbuf;
  60         t = f__buf;
  61         te = t + c;
  62         while(t < te)
  63                 *s++ = *t++;
  64         if (f__buf != f__buf0)
  65                 free(f__buf);
  66         f__buf = nbuf;
  67         }
  68
  69  int
  70 #ifdef KR_headers
  71 f__putbuf(c) int c;
  72 #else
  73 f__putbuf(int c)
  74 #endif
  75 {
  76         char *s, *se;
  77         int n;
  78
  79         if (f__hiwater > f__recpos)
  80                 f__recpos = f__hiwater;
  81         n = f__recpos + 1;
  82         if (n >= f__buflen)
  83                 f__bufadj(n, f__recpos);
  84         s = f__buf;
  85         se = s + f__recpos;
  86         if (c)
  87                 *se++ = c;
  88         *se = 0;
  89         for(;;) {
  90                 fputs(s, f__cf);
  91                 s += strlen(s);
  92                 if (s >= se)
  93                         break;  /* normally happens the first time */
  94                 putc(*s++, f__cf);
  95                 }
  96         return 0;
  97         }
  98
  99  void
 100 #ifdef KR_headers
 101 x_putc(c)
 102 #else
 103 x_putc(int c)
 104 #endif
 105 {
 106         if (f__recpos >= f__buflen)
 107                 f__bufadj(f__recpos, f__buflen);
 108         f__buf[f__recpos++] = c;
 109         }
 110
 111 #define opnerr(f,m,s) \
 112   do {if(f) {f__init &= ~2; errno= m;} else opn_err(m,s,a); return(m);} while(0)
 113
 114  static void
 115 #ifdef KR_headers
 116 opn_err(m, s, a) int m; char *s; olist *a;
 117 #else
 118 opn_err(int m, char *s, olist *a)
 119 #endif
 120 {
 121         if (a->ofnm) {
 122                 /* supply file name to error message */
 123                 if (a->ofnmlen >= f__buflen)
 124                         f__bufadj((int)a->ofnmlen, 0);
 125                 g_char(a->ofnm, a->ofnmlen, f__curunit->ufnm = f__buf);
 126                 }
 127         f__fatal(m, s);
 128         }
 129
 130 #ifdef KR_headers
 131 integer f_open(a) olist *a;
 132 #else
 133 integer f_open(olist *a)
 134 #endif
 135 {       unit *b;
 136         integer rv;
 137         char buf[256], *s, *env;
 138         cllist x;
 139         int ufmt;
 140         FILE *tf;
 141         int fd, len;
 142 #ifndef NON_UNIX_STDIO
 143         int n;
 144 #endif
 145         if(f__init != 1) f_init();
 146         f__external = 1;
 147         if(a->ounit>=MXUNIT || a->ounit<0)
 148                 err(a->oerr,101,"open");
 149         f__curunit = b = &f__units[a->ounit];
 150         if(b->ufd) {
 151                 if(a->ofnm==0)
 152                 {
 153                 same:   if (a->oblnk)
 154                                 b->ublnk = *a->oblnk == 'z' || *a->oblnk == 'Z';
 155                         return(0);
 156                 }
 157 #ifdef NON_UNIX_STDIO
 158                 if (b->ufnm
 159                  && strlen(b->ufnm) == a->ofnmlen
 160                  && !strncmp(b->ufnm, a->ofnm, (unsigned)a->ofnmlen))
 161                         goto same;
 162 #else
 163                 g_char(a->ofnm,a->ofnmlen,buf);
 164                 if (f__inode(buf,&n) == b->uinode && n == b->udev)
 165                         goto same;
 166 #endif
 167                 x.cunit=a->ounit;
 168                 x.csta=0;
 169                 x.cerr=a->oerr;
 170                 if ((rv = f_clos(&x)) != 0)
 171                         return rv;
 172                 }
 173         b->url = (int)a->orl;
 174         b->ublnk = a->oblnk && (*a->oblnk == 'z' || *a->oblnk == 'Z');
 175         if(a->ofm==0)
 176         {       if(b->url>0) b->ufmt=0;
 177                 else b->ufmt=1;
 178         }
 179         else if(*a->ofm=='f' || *a->ofm == 'F') b->ufmt=1;
 180         else b->ufmt=0;
 181         ufmt = b->ufmt;
 182 #ifdef url_Adjust
 183         if (b->url && !ufmt)
 184                 url_Adjust(b->url);
 185 #endif
 186         if (a->ofnm) {
 187                 g_char(a->ofnm,a->ofnmlen,buf);
 188                 if (!buf[0])
 189                         opnerr(a->oerr,107,"open");
 190                 }
 191         else
 192                 sprintf(buf, "fort.%ld", (long)a->ounit);
 193         b->uscrtch = 0;
 194         b->uend=0;
 195         b->uwrt = 0;
 196         b->ufd = 0;
 197         b->urw = 3;
 198         switch(a->osta ? *a->osta : 'u')
 199         {
 200         case 'o':
 201         case 'O':
 202 #ifdef NON_POSIX_STDIO
 203                 if (!(tf = fopen(buf,"r")))
 204                         opnerr(a->oerr,errno,"open");
 205                 fclose(tf);
 206 #else
 207                 if (access(buf,0))
 208                         opnerr(a->oerr,errno,"open");
 209 #endif
 210                 break;
 211          case 's':
 212          case 'S':
 213                 b->uscrtch=1;
 214 #ifdef HAVE_MKSTEMP             /* Allow use of TMPDIR preferentially. */
 215                 env = getenv("TMPDIR");
 216                 if (!env) env = getenv("TEMP");
 217                 if (!env) env = "/tmp";
 218                 len = strlen(env);
 219                 if (len > 256 - sizeof "/tmp.FXXXXXX")
 220                   err (a->oerr, 132, "open");
 221                 strcpy(buf, env);
 222                 strcat(buf, "/tmp.FXXXXXX");
 223                 fd = mkstemp(buf);
 224                 if (fd == -1 || close(fd))
 225                   err (a->oerr, 132, "open");
 226 #else /* ! defined (HAVE_MKSTEMP) */
 227 #ifdef HAVE_TEMPNAM             /* Allow use of TMPDIR preferentially. */
 228                 s = tempnam (0, buf);
 229                 if (strlen (s) >= sizeof (buf))
 230                   err (a->oerr, 132, "open");
 231                 (void) strcpy (buf, s);
 232                 free (s);
 233 #else /* ! defined (HAVE_TEMPNAM) */
 234 #ifdef _POSIX_SOURCE
 235                 tmpnam(buf);
 236 #else
 237                 (void) strcpy(buf,"tmp.FXXXXXX");
 238                 (void) mktemp(buf);
 239 #endif
 240 #endif /* ! defined (HAVE_TEMPNAM) */
 241 #endif /* ! defined (HAVE_MKSTEMP) */
 242                 goto replace;
 243         case 'n':
 244         case 'N':
 245 #ifdef NON_POSIX_STDIO
 246                 if ((tf = fopen(buf,"r")) || (tf = fopen(buf,"a"))) {
 247                         fclose(tf);
 248                         opnerr(a->oerr,128,"open");
 249                         }
 250 #else
 251                 if (!access(buf,0))
 252                         opnerr(a->oerr,128,"open");
 253 #endif
 254                 /* no break */
 255         case 'r':       /* Fortran 90 replace option */
 256         case 'R':
 257  replace:
 258                 if (tf = fopen(buf,f__w_mode[0]))
 259                         fclose(tf);
 260         }
 261
 262         b->ufnm=(char *) malloc((unsigned int)(strlen(buf)+1));
 263         if(b->ufnm==NULL) opnerr(a->oerr,113,"no space");
 264         (void) strcpy(b->ufnm,buf);
 265         if ((s = a->oacc) && b->url)
 266                 ufmt = 0;
 267         if(!(tf = fopen(buf, f__w_mode[ufmt|2]))) {
 268                 if (tf = fopen(buf, f__r_mode[ufmt]))
 269                         b->urw = 1;
 270                 else if (tf = fopen(buf, f__w_mode[ufmt])) {
 271                         b->uwrt = 1;
 272                         b->urw = 2;
 273                         }
 274                 else
 275                         err(a->oerr, errno, "open");
 276                 }
 277         b->useek = f__canseek(b->ufd = tf);
 278 #ifndef NON_UNIX_STDIO
 279         if((b->uinode = f__inode(buf,&b->udev)) == -1)
 280                 opnerr(a->oerr,108,"open");
 281 #endif
 282         if(b->useek)
 283                 if (a->orl)
 284                         FSEEK(b->ufd, 0, SEEK_SET);
 285                 else if ((s = a->oacc) && (*s == 'a' || *s == 'A')
 286                         && FSEEK(b->ufd, 0, SEEK_END))
 287                                 opnerr(a->oerr,129,"open");
 288         return(0);
 289 }
 290 #ifdef KR_headers
 291 fk_open(seq,fmt,n) ftnint n;
 292 #else
 293 fk_open(int seq, int fmt, ftnint n)
 294 #endif
 295 {       char nbuf[10];
 296         olist a;
 297         int rtn;
 298         int save_init;
 299
 300         (void) sprintf(nbuf,"fort.%ld",(long)n);
 301         a.oerr=1;
 302         a.ounit=n;
 303         a.ofnm=nbuf;
 304         a.ofnmlen=strlen(nbuf);
 305         a.osta=NULL;
 306         a.oacc= seq==SEQ?"s":"d";
 307         a.ofm = fmt==FMT?"f":"u";
 308         a.orl = seq==DIR?1:0;
 309         a.oblnk=NULL;
 310         save_init = f__init;
 311         f__init &= ~2;
 312         rtn = f_open(&a);
 313         f__init = save_init | 1;
 314         return rtn;
 315 }