ghc/lib/std/cbits/closeFile.c

   1 /*
   2  * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
   3  *
   4  * $Id: closeFile.c,v 1.9 2000/03/28 08:49:56 simonmar Exp $
   5  *
   6  * hClose Runtime Support
   7  */
   8
   9 #include "Rts.h"
  10 #include "stgio.h"
  11 #include <errno.h>
  12
  13 #if defined(HAVE_WINSOCK_H) && !defined(__CYGWIN__) && !defined(__CYGWIN32__)
  14 #define USE_WINSOCK
  15 #endif
  16
  17 #ifdef USE_WINSOCK
  18 #include <winsock.h>
  19 #endif
  20
  21 StgInt __really_close_stdfiles=1;
  22
  23 StgInt
  24 closeFile(StgForeignPtr ptr, StgInt flush_buf)
  25 {
  26     IOFileObject* fo = (IOFileObject*)ptr;
  27     int rc = 0;
  28     int unlocked=1;
  29
  30     /* Already closed, shouldn't occur. */
  31     if ( fo == NULL ) {
  32        return 0;
  33     }
  34
  35     if ( flush_buf != 0 && (fo->flags & FILEOBJ_WRITE) ) {
  36        writeFileObject(ptr,fo->bufWPtr);
  37     }
  38
  39     /* If the flush failed, we ignore this and soldier on.. */
  40
  41     if ( unlockFile(fo->fd) ) {
  42       /* If the file has already been unlocked (or an entry
  43          for it in the locking tables couldn't be found), could
  44          mean two things:
  45
  46             - we're repeating an hClose on an already
  47               closed file (this is likely to be a bug
  48               in the implementation of hClose, as this
  49               condition should have been caught before
  50               we ended up here.)
  51
  52             - the file wasn't locked in the first place!
  53               (file descriptors to non regular files.)
  54
  55          We proceed with attempting to close the file,
  56          but don't flag the error should close() return
  57          EBADF
  58       */
  59         unlocked=0;
  60
  61     }
  62
  63     /* Free the buffer straight away.  We can't free the file object
  64      * itself until the finalizer runs.
  65      */
  66     if ( fo->buf != NULL ) {
  67        free(fo->buf);
  68        fo->buf = NULL;
  69     }
  70
  71     /* Closing file descriptors that refer to standard channels
  72        is problematic, so we back off from doing this by default,
  73        just closing them at the Handle level. If you insist on
  74        closing them, setting the (global) variable
  75        __really_close_stdfiles to 0 turns off this behaviour.
  76     */
  77     if ( (fo->flags & FILEOBJ_STD) && __really_close_stdfiles ) {
  78         ;
  79
  80     } else  {
  81       /* Regardless of success or otherwise, the fd field gets smashed. */
  82       while ( (rc =
  83                 (
  84 #ifdef USE_WINSOCK
  85                   fo->flags & FILEOBJ_WINSOCK ?
  86                   closesocket(fo->fd) :
  87                   close(fo->fd))) != 0 ) {
  88 #else
  89                   close(fo->fd))) != 0 ) {
  90 #endif
  91          /* See above unlockFile() comment */
  92          if ( errno != EINTR && (!unlocked && errno != EBADF ) ) {
  93             cvtErrno();
  94             stdErrno();
  95             fo->fd = -1;
  96             return rc;
  97         }
  98       }
  99     }
 100
 101     fo->fd = -1;
 102
 103     return 0;
 104 }