{-# OPTIONS_GHC -optc-D_FILE_OFFSET_BITS=64 #-}
{-# LINE 1 "libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc" #-}
{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE InterruptibleFFI #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NoImplicitPrelude #-}
module GHC.Internal.IO.Handle.Lock.LinuxOFD where
{-# LINE 16 "libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc" #-}
import GHC.Internal.Data.Function
import GHC.Internal.Data.Functor
import GHC.Internal.Foreign.C.Error
import GHC.Internal.Foreign.C.Types
import GHC.Internal.Foreign.Marshal.Utils
import GHC.Internal.Foreign.Storable
import GHC.Internal.Base
import GHC.Internal.IO.Exception
import GHC.Internal.IO.FD
import GHC.Internal.IO.Handle.FD
import GHC.Internal.IO.Handle.Lock.Common
import GHC.Internal.IO.Handle.Types (Handle)
import GHC.Internal.Ptr
import GHC.Internal.System.Posix.Types (COff, CPid)
foreign import capi interruptible "fcntl.h fcntl"
c_fcntl :: CInt -> CInt -> Ptr FLock -> IO CInt
data FLock = FLock { FLock -> CShort
l_type :: CShort
, FLock -> CShort
l_whence :: CShort
, FLock -> COff
l_start :: COff
, FLock -> COff
l_len :: COff
, FLock -> CPid
l_pid :: CPid
}
instance Storable FLock where
sizeOf :: FLock -> Int
sizeOf FLock
_ = (Int
32)
{-# LINE 57 "libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc" #-}
alignment _ = 8
{-# LINE 58 "libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc" #-}
poke ptr x = do
fillBytes ptr 0 (sizeOf x)
(\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr (l_type x)
{-# LINE 61 "libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 2) ptr (l_whence x)
{-# LINE 62 "libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr (l_start x)
{-# LINE 63 "libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 16) ptr (l_len x)
{-# LINE 64 "libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 24) ptr (l_pid x)
{-# LINE 65 "libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc" #-}
peek ptr =
FLock <$> (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
{-# LINE 67 "libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc" #-}
<*> (\hsc_ptr -> peekByteOff hsc_ptr 2) ptr
{-# LINE 68 "libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc" #-}
<*> (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
{-# LINE 69 "libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc" #-}
<*> (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr
{-# LINE 70 "libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc" #-}
<*> (\hsc_ptr -> peekByteOff hsc_ptr 24) ptr
{-# LINE 71 "libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc" #-}
lockImpl :: Handle -> String -> LockMode -> Bool -> IO Bool
lockImpl :: Handle -> String -> LockMode -> Bool -> IO Bool
lockImpl Handle
h String
ctx LockMode
mode Bool
block = do
FD{fdFD = fd} <- Handle -> IO FD
handleToFd Handle
h
with flock $ \Ptr FLock
flock_ptr -> (IO Bool -> IO Bool) -> IO Bool
forall a. (a -> a) -> a
fix ((IO Bool -> IO Bool) -> IO Bool)
-> (IO Bool -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \IO Bool
retry -> do
ret <- CInt -> CInt -> Ptr FLock -> IO CInt
c_fcntl CInt
fd CInt
mode' Ptr FLock
flock_ptr
case ret of
CInt
0 -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
CInt
_ -> IO Errno
getErrno IO Errno -> (Errno -> IO Bool) -> IO Bool
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Errno
errno -> if
| Bool -> Bool
not Bool
block Bool -> Bool -> Bool
&& Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eWOULDBLOCK -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
| Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eINTR -> IO Bool
retry
| Bool
otherwise -> IOException -> IO Bool
forall a. HasCallStack => IOException -> IO a
ioException (IOException -> IO Bool) -> IOException -> IO Bool
forall a b. (a -> b) -> a -> b
$ String -> Errno -> Maybe Handle -> Maybe String -> IOException
errnoToIOError String
ctx Errno
errno (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
h) Maybe String
forall a. Maybe a
Nothing
where
flock :: FLock
flock = FLock { l_type :: CShort
l_type = case LockMode
mode of
LockMode
SharedLock -> CShort
0
{-# LINE 86 "libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc" #-}
LockMode
ExclusiveLock -> CShort
1
{-# LINE 87 "libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc" #-}
, l_whence :: CShort
l_whence = CShort
0
{-# LINE 88 "libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc" #-}
, l_start :: COff
l_start = COff
0
, l_len :: COff
l_len = COff
0
, l_pid :: CPid
l_pid = CPid
0
}
mode' :: CInt
mode'
| Bool
block = CInt
38
{-# LINE 94 "libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc" #-}
| otherwise = 37
{-# LINE 95 "libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc" #-}
unlockImpl :: Handle -> IO ()
unlockImpl :: Handle -> IO ()
unlockImpl Handle
h = do
FD{fdFD = fd} <- Handle -> IO FD
handleToFd Handle
h
let flock = FLock { l_type :: CShort
l_type = CShort
2
{-# LINE 100 "libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc" #-}
, l_whence :: CShort
l_whence = CShort
0
{-# LINE 101 "libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc" #-}
, l_start :: COff
l_start = COff
0
, l_len :: COff
l_len = COff
0
, l_pid :: CPid
l_pid = CPid
0
}
throwErrnoIfMinus1_ "hUnlock"
$ with flock $ c_fcntl fd 37
{-# LINE 107 "libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc" #-}
{-# LINE 109 "libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc" #-}