[project @ 1998-05-12 16:40:09 by sof]
[ghc-hetmet.git] / ghc / lib / std / cbits / openFile.lc
1 %
2 % (c) The GRASP/AQUA Project, Glasgow University, 1994
3 %
4 \subsection[openFile.lc]{openFile Runtime Support}
5
6 \begin{code}
7
8 #include "rtsdefs.h"
9 #include "stgio.h"
10
11 #ifdef HAVE_SYS_TYPES_H
12 #include <sys/types.h>
13 #endif
14
15 #ifdef HAVE_SYS_STAT_H
16 #include <sys/stat.h>
17 #endif
18
19 #ifdef HAVE_UNISTD_H
20 #include <unistd.h>
21 #endif
22
23 #ifdef HAVE_FCNTL_H
24 #include <fcntl.h>
25 #endif
26
27 StgAddr
28 openFile(file, how)
29 StgByteArray file;
30 StgByteArray how;
31 {
32     FILE *fp;
33     int fd;
34     int oflags;
35     int exclusive;
36     int created = 0;
37     struct stat sb;
38
39     /*
40      * Since we aren't supposed to succeed when we're opening for writing and
41      * there's another writer, we can't just do an fopen() for "w" mode.
42      */
43
44     switch (how[0]) {
45     case 'a':
46         oflags = O_WRONLY | O_NOCTTY | O_APPEND;
47         exclusive = 1;
48         break;
49     case 'w':
50         oflags = O_WRONLY | O_NOCTTY;
51         exclusive = 1;
52         break;
53     case 'r':
54 #if defined(cygwin32_TARGET_OS)
55         /* With cygwin32-b19, fdopen() returns EBADF under some
56            hard-to-reproduce situations (causing hsc's renamer
57            to break on some ~10 modules when recompiling it.)
58            As a temporary workaround, we open files that was requested
59            opened as read-only instead as read-write, since fdopen()
60            only appears to fail on RO file descriptors.
61
62            This won't have any impact on the correctness of the Haskell IO
63            implementation since the Handle in Haskell land will record the
64            file as being read-only, so illegal writes will be caught.
65            
66            ToDo: isolate and report.
67         */
68         oflags = how[1] == '+' ? O_RDWR | O_NOCTTY : O_RDWR | O_NOCTTY;
69 #else
70         oflags = how[1] == '+' ? O_RDWR | O_NOCTTY : O_RDONLY | O_NOCTTY;
71 #endif
72         exclusive = 0;
73         break;
74     default:
75         fprintf(stderr, "openFile: unknown mode `%s'\n", how);
76         EXIT(EXIT_FAILURE);
77     }
78
79     /* First try to open without creating */
80     while ((fd = open(file, oflags, 0666)) < 0) {
81         if (errno == ENOENT) {
82             if (how[0] == 'r' && how[1] == '\0') {
83                 /* For ReadMode, just bail out now */
84                 ghc_errtype = ERR_NOSUCHTHING;
85                 ghc_errstr = "file does not exist";
86                 return NULL;
87             } else {
88                 /* If it is a dangling symlink, break off now, too. */
89                 struct stat st;
90                 if ( lstat(file,&st) == 0) {
91                    ghc_errtype = ERR_NOSUCHTHING;
92                    ghc_errstr = "dangling symlink";
93                    return NULL;
94                 }
95             }
96             /* Now try to create it */
97             while ((fd = open(file, oflags | O_CREAT | O_EXCL, 0666)) < 0) {
98                 if (errno == EEXIST) {
99                     /* Race detected; go back and open without creating it */
100                     break;
101                 } else if (errno != EINTR) {
102                     cvtErrno();
103                     switch (ghc_errno) {
104                     default:
105                         stdErrno();
106                         break;
107                     case GHC_ENOENT:
108                     case GHC_ENOTDIR:
109                         ghc_errtype = ERR_NOSUCHTHING;
110                         ghc_errstr = "no path to file";
111                         break;
112                     case GHC_EINVAL:
113                         ghc_errtype = ERR_PERMISSIONDENIED;
114                         ghc_errstr = "unsupported owner or group";
115                         break;
116                     }
117                     return NULL;
118                 }
119             }
120             if (fd >= 0) {
121                 created = 1;
122                 break;
123             }
124         } else if (errno != EINTR) {
125             cvtErrno();
126             switch (ghc_errno) {
127             default:
128                 stdErrno();
129                 break;
130             case GHC_ENOTDIR:
131                 ghc_errtype = ERR_NOSUCHTHING;
132                 ghc_errstr = "no path to file";
133                 break;
134             case GHC_EINVAL:
135                 ghc_errtype = ERR_PERMISSIONDENIED;
136                 ghc_errstr = "unsupported owner or group";
137                 break;
138             }
139             return NULL;
140         }
141     }
142
143     /* Make sure that we aren't looking at a directory */
144
145     while (fstat(fd, &sb) < 0) {
146         /* highly unlikely */
147         if (errno != EINTR) {
148             cvtErrno();
149             if (created)
150                 (void) unlink(file);
151             (void) close(fd);
152             return NULL;
153         }
154     }
155     if (S_ISDIR(sb.st_mode)) {
156         ghc_errtype = ERR_INAPPROPRIATETYPE;
157         ghc_errstr = "file is a directory";
158         /* We can't have created it in this case. */
159         (void) close(fd);
160
161         return NULL;
162     }
163     /* Use our own personal locking */
164
165     if (lockFile(fd, exclusive) < 0) {
166         cvtErrno();
167         switch (ghc_errno) {
168         default:
169             stdErrno();
170             break;
171         case GHC_EACCES:
172         case GHC_EAGAIN:
173             ghc_errtype = ERR_RESOURCEBUSY;
174             ghc_errstr = "file is locked";
175             break;
176         }
177         if (created)
178             (void) unlink(file);
179         (void) close(fd);
180         return NULL;
181     }
182
183     /*
184      * Write mode is supposed to truncate the file.  Unfortunately, our pal
185      * ftruncate() is non-POSIX, so we truncate with a second open, which may fail.
186      */
187
188     if (how[0] == 'w') {
189         int fd2;
190
191         oflags |= O_TRUNC;
192         while ((fd2 = open(file, oflags, 0666)) < 0) {
193             if (errno != EINTR) {
194                 cvtErrno();
195                 if (created)
196                     (void) unlink(file);
197                 (void) close(fd);
198                 switch (ghc_errno) {
199                 default:
200                     stdErrno();
201                     break;
202                 case GHC_EAGAIN:
203                     ghc_errtype = ERR_RESOURCEBUSY;
204                     ghc_errstr = "enforced lock prevents truncation";
205                     break;
206                 case GHC_ENOTDIR:
207                     ghc_errtype = ERR_NOSUCHTHING;
208                     ghc_errstr = "no path to file";
209                     break;
210                 case GHC_EINVAL:
211                     ghc_errtype = ERR_PERMISSIONDENIED;
212                     ghc_errstr = "unsupported owner or group";
213                     break;
214                 }
215                 return NULL;
216             }
217         }
218         close(fd2);
219     }
220     errno = 0;                  /* Just in case fdopen() is lame */
221     while ((fp = fdopen(fd, how)) == NULL) {
222         if (errno != EINTR) {
223 #if defined(cygwin32_TARGET_OS) && defined(DEBUG)
224             fprintf(stderr, "openFile %s : %s : %d : %d\n", file, how, errno, fd);
225 #endif
226             cvtErrno();
227             if (created)
228                 (void) unlink(file);
229             (void) close(fd);
230             return NULL;
231         }
232     }
233
234     return (StgAddr) fp;
235 }
236
237 /*
238  fdopen() plus implement locking.
239 */
240 StgAddr
241 openFd(fd,how)
242 StgInt fd;
243 StgByteArray how;
244 {
245     int exclusive;
246     int oflags;
247     FILE* fp;
248
249     /*
250      * Since we aren't supposed to succeed when we're opening for writing and
251      * there's another writer, we can't just do an fopen() for "w" mode.
252      */
253
254     switch (how[0]) {
255     case 'a':
256         oflags = O_WRONLY | O_NOCTTY | O_APPEND;
257         exclusive = 1;
258         break;
259     case 'w':
260         oflags = O_WRONLY | O_NOCTTY;
261         exclusive = 1;
262         break;
263     case 'r':
264 #if defined(cygwin32_TARGET_OS)
265         /* With cygwin32-b19, fdopen() returns EBADF under some
266            hard-to-reproduce situations (causing hsc's renamer
267            to break on some ~10 modules when recompiling it.)
268            As a temporary workaround, we open files that was requested
269            opened as read-only instead as read-write, since fdopen()
270            only appears to fail on RO file descriptors.
271
272            This won't have any impact on the correctness of the Haskell IO
273            implementation since the Handle in Haskell land will record the
274            file as being read-only, so illegal writes will be caught.
275            
276            ToDo: isolate and report.
277         */
278         oflags = how[1] == '+' ? O_RDWR | O_NOCTTY : O_RDWR | O_NOCTTY;
279 #else
280         oflags = how[1] == '+' ? O_RDWR | O_NOCTTY : O_RDONLY | O_NOCTTY;
281 #endif
282         exclusive = 0;
283         break;
284     default:
285         fprintf(stderr, "openFd: unknown mode `%s'\n", how);
286         EXIT(EXIT_FAILURE);
287     }
288
289
290     if (lockFile(fd, exclusive) < 0) {
291         cvtErrno();
292         switch (ghc_errno) {
293         default:
294             stdErrno();
295             break;
296         case GHC_EACCES:
297         case GHC_EAGAIN:
298             ghc_errtype = ERR_RESOURCEBUSY;
299             ghc_errstr = "file is locked";
300             break;
301         }
302         (void) close(fd);
303         return NULL;
304     }
305
306     errno = 0;                  /* Just in case fdopen() is lame */
307     while ((fp = fdopen(fd, how)) == NULL) {
308         if (errno != EINTR) {
309 #if defined(cygwin32_TARGET_OS) && defined(DEBUG)
310             fprintf(stderr, "openFd %s : %s : %d : %d\n", file, how, errno, fd);
311 #endif
312             cvtErrno();
313             (void) close(fd);
314             return NULL;
315         }
316     }
317     return (StgAddr) fp;
318 }
319 \end{code}