1 /*- 2 * Copyright (c) 1980 The Regents of the University of California. 3 * All rights reserved. 4 * 5 * %sccs.include.proprietary.c% 6 */ 7 8 #ifndef lint 9 static char sccsid[] = "@(#)open.c 5.4 (Berkeley) 04/12/91"; 10 #endif /* not lint */ 11 12 /* 13 * open.c - f77 file open and I/O library initialization routines 14 */ 15 16 #include <sys/types.h> 17 #include <sys/stat.h> 18 #include <errno.h> 19 #include "fio.h" 20 21 #define SCRATCH (st=='s') 22 #define NEW (st=='n') 23 #define OLD (st=='o') 24 #define OPEN (b->ufd) 25 #define FROM_OPEN "\2" /* for use in f_clos() */ 26 #define BUF_LEN 256 27 28 LOCAL char *tmplate = "tmp.FXXXXXX"; /* scratch file template */ 29 LOCAL char *fortfile = "fort.%d"; /* default file template */ 30 31 char *getenv(); 32 33 f_open(a) olist *a; 34 { unit *b; 35 struct stat sbuf; 36 int n,exists; 37 char buf[BUF_LEN], env_name[BUF_LEN]; 38 char *env_val, *p1, *p2, ch, st; 39 cllist x; 40 41 lfname = NULL; 42 elist = NO; 43 external = YES; /* for err */ 44 errflag = a->oerr; 45 lunit = a->ounit; 46 if(not_legal(lunit)) err(errflag,F_ERUNIT,"open") 47 b= &units[lunit]; 48 if(a->osta) st = lcase(*a->osta); 49 else st = 'u'; 50 if(SCRATCH) 51 { strcpy(buf,tmplate); 52 /* make a new temp file name, err if mktemp fails */ 53 if( strcmp( mktemp(buf), "/" ) == 0 ) 54 err(errflag, F_ERSYS, "open") 55 } 56 else 57 { 58 if(a->ofnm) g_char(a->ofnm,a->ofnmlen,buf); 59 else sprintf(buf,fortfile,lunit); 60 /* check if overriding file name via environment variable 61 * first copy tail of name - delete periods as Bourne Shell 62 * croaks if any periods in name 63 */ 64 p1 = buf; 65 p2 = env_name; 66 while ((ch = *p1++) != '\0') { 67 if(ch == '/') p2 = env_name; 68 else if(ch != '.') *p2++ = ch; 69 } 70 if(p2 != env_name) { 71 *p2 = '\0'; 72 if( (env_val = getenv( env_name )) != NULL ) { 73 if(strlen(env_val) >= BUF_LEN-1 ) 74 err(errflag,F_ERSTAT,"open: file name too long"); 75 strcpy(buf, env_val); 76 } 77 } 78 } 79 lfname = &buf[0]; 80 if(OPEN) 81 { 82 if(!a->ofnm || inode(buf)==b->uinode) 83 { 84 if(a->oblnk) b->ublnk= (lcase(*a->oblnk)== 'z'); 85 #ifndef KOSHER 86 if(a->ofm && b->ufmt) b->uprnt = (lcase(*a->ofm)== 'p'); 87 #endif 88 return(OK); 89 } 90 x.cunit=lunit; 91 x.csta=FROM_OPEN; 92 x.cerr=errflag; 93 if(n=f_clos(&x)) return(n); 94 } 95 exists = (stat(buf,&sbuf)==NULL); 96 if(!exists && OLD) err(errflag,F_EROLDF,"open"); 97 if( exists && NEW) err(errflag,F_ERNEWF,"open"); 98 errno = F_ERSYS; 99 if(isdev(buf)) 100 { if((b->ufd = fopen(buf,"r")) != NULL) b->uwrt = NO; 101 else err(errflag,errno,buf) 102 } 103 else 104 { 105 errno = F_ERSYS; 106 if((b->ufd = fopen(buf, "a")) != NULL) 107 { if(!opneof) 108 { if(freopen(buf, "r", b->ufd) != NULL) 109 b->uwrt = NO; 110 else 111 err(errflag, errno, buf) 112 } 113 else 114 b->uwrt = YES; 115 } 116 else if((b->ufd = fopen(buf, "r")) != NULL) 117 { if (opneof) 118 fseek(b->ufd, 0L, 2); 119 b->uwrt = NO; 120 } 121 else err(errflag, errno, buf) 122 } 123 if((b->uinode=finode(b->ufd))==-1) err(errflag,F_ERSTAT,"open") 124 b->ufnm = (char *) calloc(strlen(buf)+1,sizeof(char)); 125 if(b->ufnm==NULL) err(errflag,F_ERSPACE,"open") 126 strcpy(b->ufnm,buf); 127 b->uscrtch = SCRATCH; 128 b->uend = NO; 129 b->useek = canseek(b->ufd); 130 if (a->oacc == NULL) 131 a->oacc = "seq"; 132 if (lcase(*a->oacc)=='s' && a->orl > 0) 133 { 134 fputs("Warning: open: record length ignored on sequential access\n", units[0].ufd); 135 b->url = 0; 136 } 137 else if (a->orl < 0 || (lcase(*a->oacc)=='d' && a->orl == 0)) 138 err(errflag,F_ERARG,"recl on open") 139 else 140 b->url = a->orl; 141 if (a->oblnk) 142 b->ublnk = (lcase(*a->oblnk)=='z'); 143 else if (lunit == STDERR) 144 b->ublnk = NO; 145 else 146 b->ublnk = blzero; 147 if (a->ofm) 148 { 149 switch(lcase(*a->ofm)) 150 { 151 case 'f': 152 b->ufmt = YES; 153 b->uprnt = NO; 154 break; 155 #ifndef KOSHER 156 case 'p': /* print file *** NOT STANDARD FORTRAN ***/ 157 b->ufmt = YES; 158 b->uprnt = YES; 159 break; 160 #endif 161 case 'u': 162 b->ufmt = NO; 163 b->uprnt = NO; 164 break; 165 default: 166 err(errflag,F_ERARG,"open form=") 167 } 168 } 169 else /* not specified */ 170 { b->ufmt = (b->url==0); 171 if (lunit == STDERR) 172 b->uprnt = NO; 173 else 174 b->uprnt = ccntrl; 175 } 176 if(b->url && b->useek) rewind(b->ufd); 177 return(OK); 178 } 179 180 fk_open(rd,seq,fmt,n) ftnint n; 181 { char nbuf[10]; 182 olist a; 183 sprintf(nbuf, fortfile, (int)n); 184 a.oerr=errflag; 185 a.ounit=n; 186 a.ofnm=nbuf; 187 a.ofnmlen=strlen(nbuf); 188 a.osta=NULL; 189 a.oacc= seq==SEQ?"s":"d"; 190 a.ofm = fmt==FMT?"f":"u"; 191 a.orl = seq==DIR?1:0; 192 a.oblnk=NULL; 193 return(f_open(&a)); 194 } 195 196 LOCAL 197 isdev(s) char *s; 198 { struct stat x; 199 int j; 200 if(stat(s, &x) == -1) return(NO); 201 if((j = (x.st_mode&S_IFMT)) == S_IFREG || j == S_IFDIR) return(NO); 202 else return(YES); 203 } 204 205 /*initialization routine*/ 206 f_init() 207 { 208 ini_std(STDERR, stderr, WRITE); 209 ini_std(STDIN, stdin, READ); 210 ini_std(STDOUT, stdout, WRITE); 211 setlinebuf(stderr); 212 } 213 214 LOCAL 215 ini_std(u,F,w) FILE *F; 216 { unit *p; 217 p = &units[u]; 218 p->ufd = F; 219 p->ufnm = NULL; 220 p->useek = canseek(F); 221 p->ufmt = YES; 222 p->uwrt = (w==WRITE)? YES : NO; 223 p->uscrtch = p->uend = NO; 224 p->ublnk = blzero; 225 p->uprnt = ccntrl; 226 p->url = 0; 227 p->uinode = finode(F); 228 } 229 230 LOCAL 231 canseek(f) FILE *f; /*SYSDEP*/ 232 { struct stat x; 233 return( (fstat(fileno(f),&x)==0) && 234 (x.st_nlink > 0 /*!pipe*/) && !isatty(fileno(f)) ); 235 } 236 237 LOCAL 238 finode(f) FILE *f; 239 { struct stat x; 240 if(fstat(fileno(f),&x)==0) return(x.st_ino); 241 else return(-1); 242 } 243 244 inode(a) char *a; 245 { struct stat x; 246 if(stat(a,&x)==0) return(x.st_ino); 247 else return(-1); 248 } 249