{-# LINE 1 "System/FileLock/Internal/Flock.hsc" #-}
module System.FileLock.Internal.Flock

{-# LINE 5 "System/FileLock/Internal/Flock.hsc" #-}
  (Lock, lock, tryLock, unlock) where



import Control.Applicative
import qualified Control.Exception as E
import Data.Bits
import Foreign.C.Error
import Foreign.C.Types
import System.Posix.Files
import System.Posix.IO (openFd, closeFd, defaultFileFlags, OpenMode(..), setFdOption, FdOption(..))
import System.Posix.Types
import Prelude

type Lock = Fd

lock :: FilePath -> Bool -> IO Lock
lock path exclusive = do
  fd <- open path
  (`E.onException` closeFd fd) $ do
    True <- flock fd exclusive True
    return fd

tryLock :: FilePath -> Bool -> IO (Maybe Lock)
tryLock path exclusive = do
  fd <- open path
  (`E.onException` closeFd fd) $ do
    success <- flock fd exclusive False
    if success
      then return $ Just $ fd
      else Nothing <$ closeFd fd

unlock :: Lock -> IO ()
unlock fd = closeFd fd

open :: FilePath -> IO Fd
open path = do
  fd <- openFd path WriteOnly (Just stdFileMode) defaultFileFlags
  -- Ideally, we would open the file descriptor with CLOEXEC enabled, but since
  -- unix 2.8 hasn't been released yet and we want backwards compatibility with
  -- older releases, we set CLOEXEC after opening the file descriptor.  This
  -- may seem like a race condition at first. However, since the lock is always
  -- taken after CLOEXEC is set, the worst that can happen is that a child
  -- process inherits the open FD in an unlocked state. While non-ideal from a
  -- performance standpoint, it doesn't introduce any locking bugs.
  setFdOption fd CloseOnExec True
  return fd

flock :: Fd -> Bool -> Bool -> IO Bool
flock (Fd fd) exclusive block = do
  r <- c_flock fd $ modeOp .|. blockOp
  if r == 0
    then return True -- success
    else do
      errno <- getErrno
      case () of
        _ | errno == eWOULDBLOCK
            -> return False -- already taken
          | errno == eINTR
            -> flock (Fd fd) exclusive block
          | otherwise -> throwErrno "flock"
  where
    modeOp = case exclusive of
      False -> 1
{-# LINE 69 "System/FileLock/Internal/Flock.hsc" #-}
      True -> 2
{-# LINE 70 "System/FileLock/Internal/Flock.hsc" #-}
    blockOp = case block of
      True -> 0
      False -> 4
{-# LINE 73 "System/FileLock/Internal/Flock.hsc" #-}

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


{-# LINE 78 "System/FileLock/Internal/Flock.hsc" #-}