diff options
author | Ben Gamari <ben@smart-cactus.org> | 2019-10-22 16:07:26 -0400 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-10-29 03:48:55 -0400 |
commit | 7d3a15c7afa25f32ba3a7570f9174aeeedb90bef (patch) | |
tree | b7c45b9edb92f7e1456bb8c9b5d24008b062b2fa | |
parent | d7cedd9d74e51ae9704802af6eb4775a16e59039 (diff) | |
download | haskell-7d3a15c7afa25f32ba3a7570f9174aeeedb90bef.tar.gz |
base: Fix open-file locking
The OFD locking path introduced in
3b784d440d4b01b4c549df7c9a3ed2058edfc780 due to #13945 appears to have
never actually worked but we never noticed due to an oversight in the
autoconf check. Fix it.
Thanks to Oleg Grenrus for noticing this.
-rw-r--r-- | libraries/base/GHC/IO/Handle/Lock.hsc | 56 | ||||
-rw-r--r-- | libraries/base/configure.ac | 3 |
2 files changed, 40 insertions, 19 deletions
diff --git a/libraries/base/GHC/IO/Handle/Lock.hsc b/libraries/base/GHC/IO/Handle/Lock.hsc index 0b700f8944..d75fbcf5a6 100644 --- a/libraries/base/GHC/IO/Handle/Lock.hsc +++ b/libraries/base/GHC/IO/Handle/Lock.hsc @@ -13,7 +13,23 @@ module GHC.IO.Handle.Lock ( #include "HsBaseConfig.h" -#if HAVE_FLOCK +#if HAVE_OFD_LOCKING + +#include <sys/unistd.h> +#include <sys/fcntl.h> + +import Data.Function +import Foreign.C.Error +import Foreign.C.Types +import Foreign.Marshal.Utils +import Foreign.Storable +import GHC.Ptr +import GHC.IO.Exception +import GHC.IO.FD +import GHC.IO.Handle.FD +import System.Posix.Types (COff, CPid) + +#elif HAVE_FLOCK #include <sys/file.h> @@ -116,7 +132,7 @@ hUnlock = unlockImpl -- multi-threaded environments. foreign import ccall interruptible "fcntl" - c_fcntl :: CInt -> CInt -> Ptr () -> IO CInt + c_fcntl :: CInt -> CInt -> Ptr FLock -> IO CInt data FLock = FLock { l_type :: CShort , l_whence :: CShort @@ -126,27 +142,27 @@ data FLock = FLock { l_type :: CShort } instance Storable FLock where - sizeOf _ = #{size flock} - alignment _ = #{alignment flock} + sizeOf _ = #{size struct flock} + alignment _ = #{alignment struct flock} poke ptr x = do fillBytes ptr 0 (sizeOf x) - #{poke flock, l_type} ptr (l_type x) - #{poke flock, l_whence} ptr (l_whence x) - #{poke flock, l_start} ptr (l_start x) - #{poke flock, l_len} ptr (l_len x) - #{poke flock, l_pid} ptr (l_pid x) + #{poke struct flock, l_type} ptr (l_type x) + #{poke struct flock, l_whence} ptr (l_whence x) + #{poke struct flock, l_start} ptr (l_start x) + #{poke struct flock, l_len} ptr (l_len x) + #{poke struct flock, l_pid} ptr (l_pid x) peek ptr = do - FLock <$> #{peek flock, l_type} ptr - <*> #{peek flock, l_whence} ptr - <*> #{peek flock, l_start} ptr - <*> #{peek flock, l_len} ptr - <*> #{peek flock, l_pid} ptr + FLock <$> #{peek struct flock, l_type} ptr + <*> #{peek struct flock, l_whence} ptr + <*> #{peek struct flock, l_start} ptr + <*> #{peek struct flock, l_len} ptr + <*> #{peek struct flock, l_pid} ptr lockImpl :: Handle -> String -> LockMode -> Bool -> IO Bool lockImpl h ctx mode block = do FD{fdFD = fd} <- handleToFd h with flock $ \flock_ptr -> fix $ \retry -> do - ret <- with flock $ fcntl fd mode flock_ptr + ret <- c_fcntl fd mode' flock_ptr case ret of 0 -> return True _ -> getErrno >>= \errno -> if @@ -160,10 +176,11 @@ lockImpl h ctx mode block = do , l_whence = #{const SEEK_SET} , l_start = 0 , l_len = 0 + , l_pid = 0 } - mode - | block = #{const F_SETLKW} - | otherwise = #{const F_SETLK} + mode' + | block = #{const F_OFD_SETLKW} + | otherwise = #{const F_OFD_SETLK} unlockImpl :: Handle -> IO () unlockImpl h = do @@ -172,9 +189,10 @@ unlockImpl h = do , l_whence = #{const SEEK_SET} , l_start = 0 , l_len = 0 + , l_pid = 0 } throwErrnoIfMinus1_ "hUnlock" - $ with flock $ c_fcntl fd #{const F_SETLK} + $ with flock $ c_fcntl fd #{const F_OFD_SETLK} #elif HAVE_FLOCK diff --git a/libraries/base/configure.ac b/libraries/base/configure.ac index 631e921423..d34224acc7 100644 --- a/libraries/base/configure.ac +++ b/libraries/base/configure.ac @@ -72,6 +72,9 @@ fi # Linux open file descriptor locks AC_CHECK_DECL([F_OFD_SETLK], [ AC_DEFINE([HAVE_OFD_LOCKING], [1], [Define if you have open file descriptor lock support.]) +], [], [ + #include <unistd.h> + #include <fcntl.h> ]) # flock |