{-# LINE 1 "NgxExport/Internal/SafeFileLock.hsc" #-}
{-# LANGUAGE CPP, ForeignFunctionInterface, InterruptibleFFI #-}

module NgxExport.Internal.SafeFileLock (safeWaitToSetLock
                                       ,getBestLockImpl
                                       ) where

import Foreign.C
import Foreign.Ptr
import Foreign.Storable
import Foreign.Marshal.Alloc
import System.Posix.IO
import System.Posix.Types
import System.Posix.Internals
import GHC.IO.Device




{-# LINE 21 "NgxExport/Internal/SafeFileLock.hsc" #-}



fcntlOfdSetlkw :: CInt

{-# LINE 26 "NgxExport/Internal/SafeFileLock.hsc" #-}
fcntlOfdSetlkw = (38)
{-# LINE 27 "NgxExport/Internal/SafeFileLock.hsc" #-}

{-# LINE 30 "NgxExport/Internal/SafeFileLock.hsc" #-}

fcntlOfdGetlk :: CInt

{-# LINE 33 "NgxExport/Internal/SafeFileLock.hsc" #-}
fcntlOfdGetlk = (36)
{-# LINE 34 "NgxExport/Internal/SafeFileLock.hsc" #-}

{-# LINE 37 "NgxExport/Internal/SafeFileLock.hsc" #-}

fcntlSetlkw :: CInt
fcntlSetlkw :: CInt
fcntlSetlkw = (CInt
7)
{-# LINE 40 "NgxExport/Internal/SafeFileLock.hsc" #-}

-- functions below were mostly adopted from System.Posix.IO.Common

mode2Int :: SeekMode -> CInt
mode2Int :: SeekMode -> CInt
mode2Int SeekMode
AbsoluteSeek = (CInt
0)
{-# LINE 45 "NgxExport/Internal/SafeFileLock.hsc" #-}
mode2Int RelativeSeek = (1)
{-# LINE 46 "NgxExport/Internal/SafeFileLock.hsc" #-}
mode2Int SeekFromEnd  = (2)
{-# LINE 47 "NgxExport/Internal/SafeFileLock.hsc" #-}

lockReq2Int :: LockRequest -> CShort
lockReq2Int :: LockRequest -> CShort
lockReq2Int LockRequest
ReadLock  = (CShort
0)
{-# LINE 50 "NgxExport/Internal/SafeFileLock.hsc" #-}
lockReq2Int WriteLock = (1)
{-# LINE 51 "NgxExport/Internal/SafeFileLock.hsc" #-}
lockReq2Int Unlock    = (2)
{-# LINE 52 "NgxExport/Internal/SafeFileLock.hsc" #-}

allocaLock :: FileLock -> (Ptr CFLock -> IO a) -> IO a
allocaLock :: forall a. FileLock -> (Ptr CFLock -> IO a) -> IO a
allocaLock (LockRequest
lockreq, SeekMode
mode, FileOffset
start, FileOffset
len) Ptr CFLock -> IO a
io =
  Int -> (Ptr CFLock -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
32) ((Ptr CFLock -> IO a) -> IO a) -> (Ptr CFLock -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr CFLock
p -> do
{-# LINE 56 "NgxExport/Internal/SafeFileLock.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0))   p (lockReq2Int lockreq :: CShort)
{-# LINE 57 "NgxExport/Internal/SafeFileLock.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 2)) p (fromIntegral (mode2Int mode) :: CShort)
{-# LINE 58 "NgxExport/Internal/SafeFileLock.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 8))  p start
{-# LINE 59 "NgxExport/Internal/SafeFileLock.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 16))    p len
{-# LINE 60 "NgxExport/Internal/SafeFileLock.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 24))    p (0 :: CPid)
{-# LINE 61 "NgxExport/Internal/SafeFileLock.hsc" #-}
    io p

writeLock :: FileLock
writeLock :: FileLock
writeLock = (LockRequest
WriteLock, SeekMode
AbsoluteSeek, FileOffset
0, FileOffset
0)

foreign import ccall interruptible "HsBase.h fcntl"
    safe_c_fcntl_lock :: CInt -> CInt -> Ptr CFLock -> IO CInt

-- interruptible version of waitToSetLock as defined in System.Posix.IO
safeWaitToSetLock :: Fd -> CInt -> IO ()
safeWaitToSetLock :: Fd -> CInt -> IO ()
safeWaitToSetLock (Fd CInt
fd) CInt
cmd = FileLock -> (Ptr CFLock -> IO ()) -> IO ()
forall a. FileLock -> (Ptr CFLock -> IO a) -> IO a
allocaLock FileLock
writeLock ((Ptr CFLock -> IO ()) -> IO ()) -> (Ptr CFLock -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CFLock
p_flock ->
    String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"safeWaitToSetLock" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ CInt -> CInt -> Ptr CFLock -> IO CInt
safe_c_fcntl_lock CInt
fd CInt
cmd Ptr CFLock
p_flock

-- returns fcntlOfdSetlkw if OFD locks are available, or fcntlSetlkw otherwise
getBestLockImpl :: Fd -> IO CInt
getBestLockImpl :: Fd -> IO CInt
getBestLockImpl (Fd CInt
fd) = FileLock -> (Ptr CFLock -> IO CInt) -> IO CInt
forall a. FileLock -> (Ptr CFLock -> IO a) -> IO a
allocaLock FileLock
writeLock ((Ptr CFLock -> IO CInt) -> IO CInt)
-> (Ptr CFLock -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr CFLock
p_flock -> do
    CInt
res <- CInt -> CInt -> Ptr CFLock -> IO CInt
c_fcntl_lock CInt
fd CInt
fcntlOfdGetlk Ptr CFLock
p_flock
    if CInt
res CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== -CInt
1
        then do
            Errno
errno <- IO Errno
getErrno
            CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> IO CInt) -> CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$ if Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eINVAL
                         then CInt
fcntlSetlkw
                         else CInt
fcntlOfdSetlkw
        else CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
fcntlOfdSetlkw