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

-- | File locking via the Linux open-fd locking mechanism.
module GHC.IO.Handle.Lock.LinuxOFD where




{-# LINE 14 "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)

-- Linux open file descriptor locking.
--
-- We prefer this over BSD locking (e.g. flock) since the latter appears to
-- break in some NFS configurations. Note that we intentionally do not try to
-- use ordinary POSIX file locking due to its peculiar semantics under
-- multi-threaded environments.

foreign import ccall interruptible "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 52 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
    alignment _ = 8
{-# LINE 53 "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 56 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 2) ptr (l_whence x)
{-# LINE 57 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 8)  ptr (l_start x)
{-# LINE 58 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 16)    ptr (l_len x)
{-# LINE 59 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
        (\hsc_ptr -> pokeByteOff hsc_ptr 24)    ptr (l_pid x)
{-# LINE 60 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
    peek ptr = do
        FLock <$> (\hsc_ptr -> peekByteOff hsc_ptr 0)   ptr
{-# LINE 62 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
              <*> (\hsc_ptr -> peekByteOff hsc_ptr 2) ptr
{-# LINE 63 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
              <*> (\hsc_ptr -> peekByteOff hsc_ptr 8)  ptr
{-# LINE 64 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
              <*> (\hsc_ptr -> peekByteOff hsc_ptr 16)    ptr
{-# LINE 65 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
              <*> (\hsc_ptr -> peekByteOff hsc_ptr 24)    ptr
{-# LINE 66 "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 81 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
                               ExclusiveLock -> 1
{-# LINE 82 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
                  , l_whence = 0
{-# LINE 83 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
                  , l_start = 0
                  , l_len = 0
                  , l_pid = 0
                  }
    mode'
      | block     = 38
{-# LINE 89 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
      | otherwise = 37
{-# LINE 90 "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 95 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}
                    , l_whence = 0
{-# LINE 96 "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 102 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}


{-# LINE 104 "libraries/base/GHC/IO/Handle/Lock/LinuxOFD.hsc" #-}