ghc/lib/std/cbits/closeFile.c

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