{-# OPTIONS_GHC -optc-D_FILE_OFFSET_BITS=64 #-}
{-# LINE 1 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE InterruptibleFFI #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NoImplicitPrelude #-}
module GHC.IO.Handle.Lock.LinuxOFD where
{-# LINE 15 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
import Data.Function
import Data.Functor
import Foreign.C.Error
import Foreign.C.Types
import Foreign.Marshal.Utils
import Foreign.Storable
import GHC.Base
import GHC.IO.Exception
import GHC.IO.FD
import GHC.IO.Handle.FD
import GHC.IO.Handle.Lock.Common
import GHC.IO.Handle.Types (Handle)
import GHC.Ptr
import System.Posix.Types (COff, CPid)
foreign import capi interruptible "fcntl.h fcntl"
c_fcntl :: CInt -> CInt -> Ptr FLock -> IO CInt
data FLock = FLock { l_type :: CShort
, l_whence :: CShort
, l_start :: COff
, l_len :: COff
, l_pid :: CPid
}
instance Storable FLock where
sizeOf _ = (32)
{-# LINE 56 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
alignment _ = 8
{-# LINE 57 "libraries/base/GHC/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 60 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 2) ptr (l_whence x)
{-# LINE 61 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr (l_start x)
{-# LINE 62 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 16) ptr (l_len x)
{-# LINE 63 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
(\hsc_ptr -> pokeByteOff hsc_ptr 24) ptr (l_pid x)
{-# LINE 64 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
peek ptr =
FLock <$> (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
{-# LINE 66 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
<*> (\hsc_ptr -> peekByteOff hsc_ptr 2) ptr
{-# LINE 67 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
<*> (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
{-# LINE 68 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
<*> (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr
{-# LINE 69 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
<*> (\hsc_ptr -> peekByteOff hsc_ptr 24) ptr
{-# LINE 70 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
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 <- c_fcntl fd mode' flock_ptr
case ret of
0 -> return True
_ -> getErrno >>= \errno -> if
| not block && errno == eWOULDBLOCK -> return False
| errno == eINTR -> retry
| otherwise -> ioException $ errnoToIOError ctx errno (Just h) Nothing
where
flock = FLock { l_type = case mode of
SharedLock -> 0
{-# LINE 85 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
ExclusiveLock -> 1
{-# LINE 86 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
, l_whence = 0
{-# LINE 87 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
, l_start = 0
, l_len = 0
, l_pid = 0
}
mode'
| block = 38
{-# LINE 93 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
| otherwise = 37
{-# LINE 94 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
unlockImpl :: Handle -> IO ()
unlockImpl h = do
FD{fdFD = fd} <- handleToFd h
let flock = FLock { l_type = 2
{-# LINE 99 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
, l_whence = 0
{-# LINE 100 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
, l_start = 0
, l_len = 0
, l_pid = 0
}
throwErrnoIfMinus1_ "hUnlock"
$ with flock $ c_fcntl fd 37
{-# LINE 106 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
{-# LINE 108 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}