From 7d3a15c7afa25f32ba3a7570f9174aeeedb90bef Mon Sep 17 00:00:00 2001
From: Ben Gamari <ben@smart-cactus.org>
Date: Tue, 22 Oct 2019 16:07:26 -0400
Subject: [PATCH] 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.
---
 libraries/base/GHC/IO/Handle/Lock.hsc | 56 ++++++++++++++++++---------
 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
-- 
GitLab