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
f_open(a)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
fk_open(rd,seq,fmt,n)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
isdev(s)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*/
f_init()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
ini_std(u,F,w)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
canseek(f)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
finode(f)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
inode(a)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