Ticket #4363: 4363-base.patch

File 4363-base.patch, 9.2 KB (added by pcapriotti, 3 years ago)
  • GHC/IO/FD.hs

    From 8d14d55d8ce2be52a692f1b1d80215b74f84629a Mon Sep 17 00:00:00 2001
    From: Paolo Capriotti <[email protected]>
    Date: Fri, 27 Apr 2012 13:14:47 +0100
    Subject: [PATCH] Use in-process file locking on Windows (#4363)
    
    ---
     GHC/IO/FD.hs                                       |   61 +++++++++-----------
     cbits/Win32Utils.c                                 |   17 ++++++
     include/HsBase.h                                   |    4 +-
     .../IO/countReaders001.stdout-i386-unknown-mingw32 |    1 -
     tests/IO/openFile005.stdout-i386-unknown-mingw32   |   12 ----
     tests/IO/openFile007.stdout-i386-unknown-mingw32   |    2 -
     tests/IO/readFile001.stdout-i386-unknown-mingw32   |   30 ----------
     7 files changed, 47 insertions(+), 80 deletions(-)
     delete mode 100644 tests/IO/countReaders001.stdout-i386-unknown-mingw32
     delete mode 100644 tests/IO/openFile005.stdout-i386-unknown-mingw32
     delete mode 100644 tests/IO/openFile007.stdout-i386-unknown-mingw32
     delete mode 100644 tests/IO/readFile001.stdout-i386-unknown-mingw32
    
    diff --git a/GHC/IO/FD.hs b/GHC/IO/FD.hs
    index 9422ddf..bbd55cc 100644
    a b openFile filepath iomode non_blocking = 
    155155    let
    156156      oflags1 = case iomode of
    157157                  ReadMode      -> read_flags
    158 #ifdef mingw32_HOST_OS
    159                   WriteMode     -> write_flags .|. o_TRUNC
    160 #else
    161158                  WriteMode     -> write_flags
    162 #endif
    163159                  ReadWriteMode -> rw_flags
    164160                  AppendMode    -> append_flags
    165161
    openFile filepath iomode non_blocking = 
    167163      binary_flags = o_BINARY
    168164#else
    169165      binary_flags = 0
    170 #endif     
     166#endif
    171167
    172168      oflags2 = oflags1 .|. binary_flags
    173169
    openFile filepath iomode non_blocking = 
    190186            `catchAny` \e -> do _ <- c_close fd
    191187                                throwIO e
    192188
    193 #ifndef mingw32_HOST_OS
    194         -- we want to truncate() if this is an open in WriteMode, but only
    195         -- if the target is a RegularFile.  ftruncate() fails on special files
    196         -- like /dev/null.
    197     if iomode == WriteMode && fd_type == RegularFile
    198       then setSize fD 0
    199       else return ()
    200 #endif
     189    -- we want to truncate() if this is an open in WriteMode, but only
     190    -- if the target is a RegularFile.  ftruncate() fails on special files
     191    -- like /dev/null.
     192    when (iomode == WriteMode && fd_type == RegularFile) $
     193      setSize fD 0
    201194
    202195    return (fD,fd_type)
    203196
    mkFD fd iomode mb_stat is_socket is_nonblock = do 
    241234                   ReadMode -> False
    242235                   _ -> True
    243236
    244 #ifdef mingw32_HOST_OS
    245     _ <- setmode fd True -- unconditionally set binary mode
    246     let _ = (dev,ino,write) -- warning suppression
    247 #endif
    248 
    249237    case fd_type of
    250238        Directory ->
    251239           ioException (IOError Nothing InappropriateType "openFile"
    252240                           "is a directory" Nothing Nothing)
    253241
    254 #ifndef mingw32_HOST_OS
    255242        -- regular files need to be locked
    256243        RegularFile -> do
    257            -- On Windows we use explicit exclusion via sopen() to implement
    258            -- this locking (see __hscore_open()); on Unix we have to
    259            -- implment it in the RTS.
    260            r <- lockFile fd dev ino (fromBool write)
     244           -- On Windows we need an additional call to get a unique device id
     245           -- and inode, since fstat just returns 0 for both.
     246           (unique_dev, unique_ino) <- getUniqueFileInfo fd dev ino
     247           r <- lockFile fd unique_dev unique_ino (fromBool write)
    261248           when (r == -1)  $
    262249                ioException (IOError Nothing ResourceBusy "openFile"
    263250                                   "file is locked" Nothing Nothing)
    264 #endif
    265251
    266252        _other_type -> return ()
    267253
     254#ifdef mingw32_HOST_OS
     255    _ <- setmode fd True -- unconditionally set binary mode
     256#endif
     257
    268258    return (FD{ fdFD = fd,
    269259#ifndef mingw32_HOST_OS
    270260                fdIsNonBlocking = fromEnum is_nonblock
    mkFD fd iomode mb_stat is_socket is_nonblock = do 
    274264              },
    275265            fd_type)
    276266
     267getUniqueFileInfo :: CInt -> CDev -> CIno -> IO (Word64, Word64)
     268#ifndef mingw32_HOST_OS
     269getUniqueFileInfo _ dev ino = return (fromInteger dev, fromInteger ino)
     270#else
     271getUniqueFileInfo fd _ _ = do
     272  with 0 $ \devptr -> do
     273  with 0 $ \inoptr -> do
     274  c_getUniqueFileInfo fd devptr inoptr
     275  liftM2 (,) (peek devptr) (peek inoptr)
     276#endif
     277
    277278#ifdef mingw32_HOST_OS
    278279foreign import ccall unsafe "__hscore_setmode"
    279280  setmode :: CInt -> Bool -> IO CInt
    stderr = stdFD 2 
    304305
    305306close :: FD -> IO ()
    306307close fd =
    307 #ifndef mingw32_HOST_OS
    308308  (flip finally) (release fd) $
    309 #endif
    310309  do let closer realFd =
    311310           throwErrnoIfMinus1Retry_ "GHC.IO.FD.close" $
    312311#ifdef mingw32_HOST_OS
    close fd = 
    318317     closeFdWith closer (fromIntegral (fdFD fd))
    319318
    320319release :: FD -> IO ()
    321 #ifdef mingw32_HOST_OS
    322 release _ = return ()
    323 #else
    324320release fd = do _ <- unlockFile (fdFD fd)
    325321                return ()
    326 #endif
    327322
    328323#ifdef mingw32_HOST_OS
    329324foreign import stdcall unsafe "HsBase.h closesocket"
    throwErrnoIfMinus1RetryOnBlock loc f on_block = 
    657652-- -----------------------------------------------------------------------------
    658653-- Locking/unlocking
    659654
    660 #ifndef mingw32_HOST_OS
    661655foreign import ccall unsafe "lockFile"
    662   lockFile :: CInt -> CDev -> CIno -> CInt -> IO CInt
     656  lockFile :: CInt -> Word64 -> Word64 -> CInt -> IO CInt
    663657
    664658foreign import ccall unsafe "unlockFile"
    665659  unlockFile :: CInt -> IO CInt
    666 #endif
    667660
     661foreign import ccall unsafe "get_unique_file_info"
     662  c_getUniqueFileInfo :: CInt -> Ptr Word64 -> Ptr Word64 -> IO ()
  • cbits/Win32Utils.c

    diff --git a/cbits/Win32Utils.c b/cbits/Win32Utils.c
    index 84b6b69..dc3160a 100644
    a b HsWord64 getMonotonicUSec() 
    156156    }
    157157}
    158158
     159int get_unique_file_info(int fd, HsWord64 *dev, HsWord64 *ino)
     160{
     161    HANDLE h = (HANDLE)_get_osfhandle(fd);
     162    BY_HANDLE_FILE_INFORMATION info;
     163
     164    if (GetFileInformationByHandle(h, &info))
     165    {
     166        *dev = info.dwVolumeSerialNumber;
     167        *ino = info.nFileIndexLow
     168             | ((HsWord64)info.nFileIndexHigh << 32);
     169
     170        return 0;
     171    }
     172
     173    return -1;
     174}
     175
    159176#endif
  • include/HsBase.h

    diff --git a/include/HsBase.h b/include/HsBase.h
    index 70e85db..88dccf1 100644
    a b extern void __hscore_set_saved_termios(int fd, void* ts); 
    529529#ifdef __MINGW32__
    530530INLINE int __hscore_open(wchar_t *file, int how, mode_t mode) {
    531531        if ((how & O_WRONLY) || (how & O_RDWR) || (how & O_APPEND))
    532           return _wsopen(file,how | _O_NOINHERIT,_SH_DENYRW,mode);
     532          return _wsopen(file,how | _O_NOINHERIT,_SH_DENYNO,mode);
    533533          // _O_NOINHERIT: see #2650
    534534        else
    535           return _wsopen(file,how | _O_NOINHERIT,_SH_DENYWR,mode);
     535          return _wsopen(file,how | _O_NOINHERIT,_SH_DENYNO,mode);
    536536          // _O_NOINHERIT: see #2650
    537537}
    538538#else
  • deleted file tests/IO/countReaders001.stdout-i386-unknown-mingw32

    diff --git a/tests/IO/countReaders001.stdout-i386-unknown-mingw32 b/tests/IO/countReaders001.stdout-i386-unknown-mingw32
    deleted file mode 100644
    index bf80d9d..0000000
    + -  
    1 Left countReaders001.txt: openFile: permission denied (Permission denied)
  • deleted file tests/IO/openFile005.stdout-i386-unknown-mingw32

    diff --git a/tests/IO/openFile005.stdout-i386-unknown-mingw32 b/tests/IO/openFile005.stdout-i386-unknown-mingw32
    deleted file mode 100644
    index bf22798..0000000
    + -  
    1 two writes (should fail)
    2 Left openFile005.out1: openFile: permission denied (Permission denied)
    3 write and an append (should fail)
    4 Left openFile005.out1: openFile: permission denied (Permission denied)
    5 read/write and a write (should fail)
    6 Left openFile005.out1: openFile: permission denied (Permission denied)
    7 read and a read/write (should fail)
    8 Left openFile005.out1: openFile: permission denied (Permission denied)
    9 write and a read (should fail)
    10 Left openFile005.out1: openFile: permission denied (Permission denied)
    11 two writes, different files (silly, but should succeed)
    12 two reads, should succeed
  • deleted file tests/IO/openFile007.stdout-i386-unknown-mingw32

    diff --git a/tests/IO/openFile007.stdout-i386-unknown-mingw32 b/tests/IO/openFile007.stdout-i386-unknown-mingw32
    deleted file mode 100644
    index 26f0afe..0000000
    + -  
    1 Left openFile007.out: openFile: permission denied (Permission denied)
    2 hello, world
  • deleted file tests/IO/readFile001.stdout-i386-unknown-mingw32

    diff --git a/tests/IO/readFile001.stdout-i386-unknown-mingw32 b/tests/IO/readFile001.stdout-i386-unknown-mingw32
    deleted file mode 100644
    index d086f3a..0000000
    + -  
    1 Left readFile001.out: openFile: permission denied (Permission denied)
    2 -- !!! readFile test
    3 
    4 import System.IO
    5 import System.IO.Error
    6 
    7 source   = "readFile001.hs"
    8 filename = "readFile001.out"
    9 
    10 main = do
    11   s <- readFile source
    12   h <- openFile filename WriteMode
    13   hPutStrLn h s
    14   hClose h
    15   s <- readFile filename
    16 
    17   -- This open should fail, because the readFile hasn't been forced
    18   -- and the file is therefore still locked.
    19   tryIOError (openFile filename WriteMode) >>= print
    20 
    21   putStrLn s
    22 
    23   -- should be able to open it for writing now, because we've forced the
    24   -- whole file.
    25   h <- openFile filename WriteMode
    26 
    27   print h
    28 
    29 
    30 {handle: readFile001.out}