diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -1,3 +1,7 @@ +### 1.7.10.2 + +- Minor improvements in module *NgxExport.Internal.SafeFileLock*. + ### 1.7.10.1 - Use *DerivingStrategies* in the exception types. diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,7 +1,7 @@ The following license covers this documentation, and the source code, except where otherwise indicated. -Copyright 2016-2024, Alexey Radkov. All rights reserved. +Copyright 2016-2026, Alexey Radkov. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: diff --git a/NgxExport.hs b/NgxExport.hs --- a/NgxExport.hs +++ b/NgxExport.hs @@ -5,7 +5,7 @@ ----------------------------------------------------------------------------- -- | -- Module : NgxExport --- Copyright : (c) Alexey Radkov 2016-2024 +-- Copyright : (c) Alexey Radkov 2016-2026 -- License : BSD-style -- -- Maintainer : alexey.radkov@gmail.com @@ -18,6 +18,7 @@ -- ----------------------------------------------------------------------------- + module NgxExport ( -- * Type declarations ContentHandlerResult @@ -153,6 +154,10 @@ data NgxStrType = NgxStrType CSize CString +-- BEWARE: we do not peek inside Nginx struct ngx_str_t meaning to avoid +-- dependency on Nginx C source code, it should be ok as long as ngx_str_t +-- won't change from release to release, we also assume that ngx_str_t is +-- properly aligned instance Storable NgxStrType where alignment = const $ max (alignment (undefined :: CSize)) (alignment (undefined :: CString)) @@ -834,10 +839,17 @@ isIOError (Errno e) = (Just e ==) . ioe_errno {-# INLINE isIOError #-} +-- up to ghc 8.0, rts timers used SIGALRM which might cause interrupts in C +-- function calls, as this is no longer the case since then, this check is +-- rather redundant isEINTR :: IOError -> Bool isEINTR = isIOError eINTR {-# INLINE isEINTR #-} +-- fcntl() with F_SETLKW can detect deadlocks which are not a big problem when +-- a thread attempts to acquire a single lock and has no other tasks, so we +-- check this to ignore; note that fcntl() with F_OFD_SETLKW does not check +-- deadlocks so we prefer this implementation in getBestLockImpl isEDEADLK :: IOError -> Bool isEDEADLK = isIOError eDEADLK {-# INLINE isEDEADLK #-} @@ -952,9 +964,10 @@ if isEINTR e then return (False, False) else do - -- wait some time to avoid fastly repeated calls; - -- threadDelay is interruptible even in exception - -- handlers + -- wait some time to avoid fastly repeated calls + -- (e.g. on deadlocks detected by fcntl() with + -- F_SETLKW); note that threadDelay is interruptible + -- in exception handlers exiting <- (threadDelay 500000 >> return False) `catches` [E.Handler $ return . (== WorkerProcessIsExiting) diff --git a/NgxExport/Internal/SafeFileLock.hsc b/NgxExport/Internal/SafeFileLock.hsc --- a/NgxExport/Internal/SafeFileLock.hsc +++ b/NgxExport/Internal/SafeFileLock.hsc @@ -23,42 +23,41 @@ fcntlOfdSetlkw :: CInt #ifdef F_OFD_SETLKW -fcntlOfdSetlkw = (#const F_OFD_SETLKW) +fcntlOfdSetlkw = #const F_OFD_SETLKW #else fcntlOfdSetlkw = 38 #endif fcntlOfdGetlk :: CInt #ifdef F_OFD_SETLKW -fcntlOfdGetlk = (#const F_OFD_GETLK) +fcntlOfdGetlk = #const F_OFD_GETLK #else fcntlOfdGetlk = 36 #endif fcntlSetlkw :: CInt -fcntlSetlkw = (#const F_SETLKW) +fcntlSetlkw = #const F_SETLKW -- functions below were mostly adopted from System.Posix.IO.Common -mode2Int :: SeekMode -> CInt -mode2Int AbsoluteSeek = (#const SEEK_SET) -mode2Int RelativeSeek = (#const SEEK_CUR) -mode2Int SeekFromEnd = (#const SEEK_END) +mode2CShort :: SeekMode -> CShort +mode2CShort AbsoluteSeek = #const SEEK_SET +mode2CShort RelativeSeek = #const SEEK_CUR +mode2CShort SeekFromEnd = #const SEEK_END -lockReq2Int :: LockRequest -> CShort -lockReq2Int ReadLock = (#const F_RDLCK) -lockReq2Int WriteLock = (#const F_WRLCK) -lockReq2Int Unlock = (#const F_UNLCK) +lockReq2CShort :: LockRequest -> CShort +lockReq2CShort ReadLock = #const F_RDLCK +lockReq2CShort WriteLock = #const F_WRLCK +lockReq2CShort Unlock = #const F_UNLCK allocaLock :: FileLock -> (Ptr CFLock -> IO a) -> IO a allocaLock (lockreq, mode, start, len) io = - allocaBytes (#const sizeof(struct flock)) $ \p -> do - (#poke struct flock, l_type) p (lockReq2Int lockreq :: CShort) - (#poke struct flock, l_whence) p (fromIntegral (mode2Int mode) :: CShort) - (#poke struct flock, l_start) p start - (#poke struct flock, l_len) p len - (#poke struct flock, l_pid) p (0 :: CPid) - io p + allocaBytes (#size struct flock) $ \p -> do + (#poke struct flock, l_type) p $ lockReq2CShort lockreq + (#poke struct flock, l_whence) p $ mode2CShort mode + (#poke struct flock, l_start) p start + (#poke struct flock, l_len) p len + io p writeLock :: FileLock writeLock = (WriteLock, AbsoluteSeek, 0, 0) @@ -68,13 +67,13 @@ -- interruptible version of waitToSetLock as defined in System.Posix.IO safeWaitToSetLock :: Fd -> CInt -> IO () -safeWaitToSetLock (Fd fd) cmd = allocaLock writeLock $ \p_flock -> - throwErrnoIfMinus1_ "safeWaitToSetLock" $ safe_c_fcntl_lock fd cmd p_flock +safeWaitToSetLock (Fd fd) cmd = allocaLock writeLock $ + throwErrnoIfMinus1_ "safeWaitToSetLock" . safe_c_fcntl_lock fd cmd -- returns fcntlOfdSetlkw if OFD locks are available, or fcntlSetlkw otherwise getBestLockImpl :: Fd -> IO CInt -getBestLockImpl (Fd fd) = allocaLock writeLock $ \p_flock -> do - res <- c_fcntl_lock fd fcntlOfdGetlk p_flock +getBestLockImpl (Fd fd) = allocaLock writeLock $ \pFlock -> do + res <- c_fcntl_lock fd fcntlOfdGetlk pFlock if res == -1 then do errno <- getErrno diff --git a/ngx-export.cabal b/ngx-export.cabal --- a/ngx-export.cabal +++ b/ngx-export.cabal @@ -1,5 +1,5 @@ name: ngx-export -version: 1.7.10.1 +version: 1.7.10.2 synopsis: Helper module for Nginx Haskell module description: Helper module for . @@ -10,7 +10,7 @@ author: Alexey Radkov maintainer: Alexey Radkov stability: stable -copyright: 2016-2024 Alexey Radkov +copyright: 2016-2026 Alexey Radkov category: Network build-type: Simple cabal-version: 1.20