{-# LINE 1 "libraries/base/GHC/IO/Handle/Lock/Flock.hsc" #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE InterruptibleFFI #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NoImplicitPrelude #-}

-- | File locking via POSIX @flock@.
module GHC.IO.Handle.Lock.Flock where




{-# LINE 15 "libraries/base/GHC/IO/Handle/Lock/Flock.hsc" #-}



import Data.Bits
import Data.Function
import Foreign.C.Error
import Foreign.C.Types
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)

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 -> CInt
fdFD = CInt
fd} <- Handle -> IO FD
handleToFd Handle
h
  let flags :: CInt
flags = CInt
cmode CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|. (if Bool
block then CInt
0 else CInt
4)
{-# LINE 33 "libraries/base/GHC/IO/Handle/Lock/Flock.hsc" #-}
  fix $ \retry -> c_flock fd flags >>= \case
    0 -> return True
    _ -> getErrno >>= \errno -> if
      | not block
      , errno == eAGAIN || errno == eACCES -> return False
      | errno == eINTR -> retry
      | otherwise -> ioException $ errnoToIOError ctx errno (Just h) Nothing
  where
    cmode :: CInt
cmode = case LockMode
mode of
      LockMode
SharedLock    -> CInt
1
{-# LINE 43 "libraries/base/GHC/IO/Handle/Lock/Flock.hsc" #-}
      ExclusiveLock -> 2
{-# LINE 44 "libraries/base/GHC/IO/Handle/Lock/Flock.hsc" #-}

unlockImpl :: Handle -> IO ()
unlockImpl :: Handle -> IO ()
unlockImpl Handle
h = do
  FD{fdFD :: FD -> CInt
fdFD = CInt
fd} <- Handle -> IO FD
handleToFd Handle
h
  String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"flock" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ CInt -> CInt -> IO CInt
c_flock CInt
fd CInt
8
{-# LINE 49 "libraries/base/GHC/IO/Handle/Lock/Flock.hsc" #-}

foreign import ccall interruptible "flock"
  c_flock :: CInt -> CInt -> IO CInt


{-# LINE 54 "libraries/base/GHC/IO/Handle/Lock/Flock.hsc" #-}