summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2019-10-22 16:07:26 -0400
committerMarge Bot <ben+marge-bot@smart-cactus.org>2019-10-29 03:48:55 -0400
commit7d3a15c7afa25f32ba3a7570f9174aeeedb90bef (patch)
treeb7c45b9edb92f7e1456bb8c9b5d24008b062b2fa
parentd7cedd9d74e51ae9704802af6eb4775a16e59039 (diff)
downloadhaskell-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.hsc56
-rw-r--r--libraries/base/configure.ac3
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