Ticket #4363: 4363-base.patch

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

    From 8d14d55d8ce2be52a692f1b1d80215b74f84629a Mon Sep 17 00:00:00 2001
    From: Paolo Capriotti <p.capriotti@gmail.com>
    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}