[project @ 1998-05-12 16:40:09 by sof]

- closeFile: make sure that (FILE*)s pointing to non-regular,
  unlocked files (sockets, FDs etc.) are closed.
- new function: openFd, which implements process local file locking
  for files that are initially opened by the Posix Fd-based ops before
  being converted into a Haskell handle by Posix.fdToHandle

diff --git a/ghc/lib/std/cbits/closeFile.lc b/ghc/lib/std/cbits/closeFile.lc
index 9f4c80e..6118574 100644 (file)
--- a/ghc/lib/std/cbits/closeFile.lc
+++ b/ghc/lib/std/cbits/closeFile.lc
@@ -13,14 +13,33 @@ closeFile(fp)
 StgForeignObj fp;
 {
     int rc;
-
-    if (unlockFile(fileno((FILE *) fp))) {
-       /* If it has been unlocked, don't bother fclose()ing */
-       return 0;
+    int unlocked=1;
+
+    if ( unlockFile(fileno((FILE *) fp)) ) {
+      /* If the file has already been unlocked (or an entry
+         for it in the locking tables couldn't be fond), could
+         mean two things:
+
+           - we're repeating an hClose on an already
+             closed file (this is likely to be a bug
+             in the implementation of hClose, as this 
+             condition should have been caught before
+             we ended up here.)
+             
+           - the file wasn't locked in the first place!
+             (file descriptors to non regular files.)
+
+        We proceed with attempting to close the file,
+        but don't flag the error should fclose() return
+        EBADF
+      */
+       unlocked=0;
+       
     }
 
     while ((rc = fclose((FILE *) fp)) != 0) {
-       if (errno != EINTR) {
+        /* See above comment */
+       if ( errno != EINTR && (!unlocked && errno != EBADF ) ) {
            cvtErrno();
            stdErrno();
            return rc;

diff --git a/ghc/lib/std/cbits/openFile.lc b/ghc/lib/std/cbits/openFile.lc
index fb4bdfb..43dd1dd 100644 (file)
--- a/ghc/lib/std/cbits/openFile.lc
+++ b/ghc/lib/std/cbits/openFile.lc
@@ -234,4 +234,86 @@ StgByteArray how;
     return (StgAddr) fp;
 }
 
+/*
+ fdopen() plus implement locking.
+*/
+StgAddr
+openFd(fd,how)
+StgInt fd;
+StgByteArray how;
+{
+    int exclusive;
+    int oflags;
+    FILE* fp;
+
+    /*
+     * Since we aren't supposed to succeed when we're opening for writing and
+     * there's another writer, we can't just do an fopen() for "w" mode.
+     */
+
+    switch (how[0]) {
+    case 'a':
+       oflags = O_WRONLY | O_NOCTTY | O_APPEND;
+       exclusive = 1;
+       break;
+    case 'w':
+       oflags = O_WRONLY | O_NOCTTY;
+       exclusive = 1;
+       break;
+    case 'r':
+#if defined(cygwin32_TARGET_OS)
+       /* With cygwin32-b19, fdopen() returns EBADF under some
+          hard-to-reproduce situations (causing hsc's renamer
+          to break on some ~10 modules when recompiling it.)
+          As a temporary workaround, we open files that was requested
+          opened as read-only instead as read-write, since fdopen()
+          only appears to fail on RO file descriptors.
+
+          This won't have any impact on the correctness of the Haskell IO
+          implementation since the Handle in Haskell land will record the
+          file as being read-only, so illegal writes will be caught.
+          
+          ToDo: isolate and report.
+       */
+       oflags = how[1] == '+' ? O_RDWR | O_NOCTTY : O_RDWR | O_NOCTTY;
+#else
+       oflags = how[1] == '+' ? O_RDWR | O_NOCTTY : O_RDONLY | O_NOCTTY;
+#endif
+       exclusive = 0;
+       break;
+    default:
+       fprintf(stderr, "openFd: unknown mode `%s'\n", how);
+       EXIT(EXIT_FAILURE);
+    }
+
+
+    if (lockFile(fd, exclusive) < 0) {
+       cvtErrno();
+       switch (ghc_errno) {
+       default:
+           stdErrno();
+           break;
+       case GHC_EACCES:
+       case GHC_EAGAIN:
+           ghc_errtype = ERR_RESOURCEBUSY;
+           ghc_errstr = "file is locked";
+           break;
+       }
+       (void) close(fd);
+       return NULL;
+    }
+
+    errno = 0;                 /* Just in case fdopen() is lame */
+    while ((fp = fdopen(fd, how)) == NULL) {
+       if (errno != EINTR) {
+#if defined(cygwin32_TARGET_OS) && defined(DEBUG)
+           fprintf(stderr, "openFd %s : %s : %d : %d\n", file, how, errno, fd);
+#endif
+           cvtErrno();
+           (void) close(fd);
+           return NULL;
+       }
+    }
+    return (StgAddr) fp;
+}
 \end{code}

diff --git a/ghc/lib/std/cbits/stgio.h b/ghc/lib/std/cbits/stgio.h
index 05213ec..e5f62df 100644 (file)
--- a/ghc/lib/std/cbits/stgio.h
+++ b/ghc/lib/std/cbits/stgio.h
@@ -85,6 +85,7 @@ StgInt        inputReady  PROTO((StgForeignObj,StgInt));
 
 /* openFile.lc */
 StgAddr openFile PROTO((StgByteArray, StgByteArray));
+StgAddr openFd   PROTO((StgInt, StgByteArray));
 
 /* readFile.lc */
 StgInt readBlock PROTO((StgAddr, StgForeignObj, StgInt));