{-# 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" #-}
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
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
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