diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -1,3 +1,9 @@ +### 1.7.2 + +- More robust masking in async handlers. As this uses function *interruptible* + from module *Control.Exception*, support of GHC versions *7.x* was dropped. +- Fixed waiting on file-locks of inactive shared services. + ### 1.7.1 - Added function *ngxCachedPid* to return the PID of the current worker process 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-2019, Alexey Radkov. All rights reserved. +Copyright 2016-2021, 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 @@ -4,7 +4,7 @@ ----------------------------------------------------------------------------- -- | -- Module : NgxExport --- Copyright : (c) Alexey Radkov 2016-2019 +-- Copyright : (c) Alexey Radkov 2016-2021 -- License : BSD-style -- -- Maintainer : alexey.radkov@gmail.com @@ -62,7 +62,7 @@ ,Foreign.C.CUInt (..) ) where -import Language.Haskell.TH +import Language.Haskell.TH hiding (interruptible) import Foreign.C import Foreign.Ptr import Foreign.StablePtr @@ -497,6 +497,12 @@ instance Show ServiceHookInterrupt where show = const "Service was interrupted by a service hook" +newtype ServiceSomeInterrupt = ServiceSomeInterrupt String + +instance Exception ServiceSomeInterrupt +instance Show ServiceSomeInterrupt where + show (ServiceSomeInterrupt s) = s + -- | Terminates the worker process. -- -- Being thrown from a service, this exception makes Nginx log the supplied @@ -680,7 +686,9 @@ 0x80000000 .|. fromIntegral st Just (FinalizeHTTPRequest st Nothing) -> 0xC0000000 .|. fromIntegral st - _ -> 1 + _ -> case fromException e of + Just (ServiceSomeInterrupt _) -> 5 + _ -> 1 ,case asyncExceptionFromException e of Just WorkerProcessIsExiting -> True _ -> False @@ -765,13 +773,12 @@ asyncIOCommon :: IO (L.ByteString, Bool) -> CInt -> Bool -> Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr CUInt -> Ptr (StablePtr L.ByteString) -> IO (StablePtr (Async ())) -asyncIOCommon a (I fd) efd p pl pr spd = mask $ \restore -> +asyncIOCommon a (I fd) efd p pl pr spd = mask_ $ async (do - (s, (r, exiting)) <- safeAsyncYYHandler $ - restore $ do - (s, exiting) <- a - fmap (, (0, exiting)) $ return $!! s + (s, (r, exiting)) <- safeAsyncYYHandler $ do + (s, exiting) <- a + interruptible $ fmap (, (0, exiting)) $ return $!! s pokeLazyByteString s p pl spd poke pr r if exiting @@ -810,24 +817,30 @@ (do exiting <- if fstRun && fdlk /= -1 then snd <$> - iterateUntil ((True ==) . fst) - (safeWaitToSetLock fdlk - (WriteLock, AbsoluteSeek, 0, 0) >> - return (True, False) + iterateUntil fst + (interruptible + (safeWaitToSetLock fdlk + (WriteLock, AbsoluteSeek, 0, 0) >> + return (True, False) + ) + `catches` + [E.Handler $ + return . (, False) . not . isEINTR + ,E.Handler $ + return . (True, ) . (== WorkerProcessIsExiting) + ,E.Handler + (throwIO . ServiceSomeInterrupt . show :: + SomeException -> IO (Bool, Bool) + ) + ] ) - `catches` - [E.Handler $ - return . (, False) . not . isEINTR - ,E.Handler $ - return . (True, ) . (== WorkerProcessIsExiting) - ] else return False if exiting then return (L.empty, True) else do when fstRun $ poke active 1 x' <- B.unsafePackCStringLen (x, n) - (, False) <$> f x' fstRun + interruptible $ (, False) <$> f x' fstRun ) fd efd asyncIOYYY :: IOYYY -> Ptr NgxStrType -> Ptr NgxStrType -> CInt -> @@ -838,7 +851,7 @@ (do b' <- peekRequestBodyChunks tmpf b m x' <- B.unsafePackCStringLen (x, n) - (, False) <$> f b' x' + interruptible $ (, False) <$> f b' x' ) fd efd asyncHandler :: AsyncHandler -> CString -> CInt -> @@ -852,9 +865,10 @@ asyncIOCommon (do x' <- B.unsafePackCStringLen (x, n) - v@(s, ct, I st, rhs) <- f x' - (return $!! v) >> mask_ - (pokeAsyncHandlerData ct pct plct spct pst st rhs prhs plrhs sprhs) + (s, ct, I st, rhs) <- interruptible $ do + v <- f x' + return $!! v + pokeAsyncHandlerData ct pct plct spct pst st rhs prhs plrhs sprhs return (s, False) ) fd efd @@ -870,9 +884,10 @@ (do b' <- peekRequestBodyChunks tmpf b m x' <- B.unsafePackCStringLen (x, n) - v@(s, ct, I st, rhs) <- f b' x' - (return $!! v) >> mask_ - (pokeAsyncHandlerData ct pct plct spct pst st rhs prhs plrhs sprhs) + (s, ct, I st, rhs) <- interruptible $ do + v <- f b' x' + return $!! v + pokeAsyncHandlerData ct pct plct spct pst st rhs prhs plrhs sprhs return (s, False) ) fd efd @@ -1003,37 +1018,40 @@ -- | Returns an opaque pointer to the Nginx /cycle object/ -- for using it in C plugins. -- --- Actual type of the returned pointer is +-- The actual type of the returned pointer is -- -- > ngx_cycle_t * -- --- (value of argument __/cycle/__ in the worker's initialization function). +-- (the value of argument __/cycle/__ in the worker's initialization function). ngxCyclePtr :: IO (Ptr ()) ngxCyclePtr = readIORef ngxCyclePtrStore -- | Returns an opaque pointer to the Nginx /upstream main configuration/ -- for using it in C plugins. -- --- Actual type of the returned pointer is +-- The actual type of the returned pointer is -- -- > ngx_http_upstream_main_conf_t * -- --- (value of expression --- --- > ngx_http_cycle_get_module_main_conf(cycle, ngx_http_upstream_module) --- --- in the worker's initialization function). +-- (the value of expression +-- @ngx_http_cycle_get_module_main_conf(cycle, ngx_http_upstream_module)@ in +-- the worker's initialization function). ngxUpstreamMainConfPtr :: IO (Ptr ()) ngxUpstreamMainConfPtr = readIORef ngxUpstreamMainConfPtrStore -- | Returns an opaque pointer to the Nginx /cached time object/ -- for using it in C plugins. -- --- Actual type of the returned pointer is +-- The actual type of the returned pointer is -- -- > volatile ngx_time_t ** -- --- (/address/ of the Nginx global variable __/ngx_cached_time/__). +-- (the /address/ of the Nginx global variable __/ngx_cached_time/__). +-- +-- Be aware that time gotten from this pointer is not reliable in asynchronous +-- tasks and services as soon as it gets updated only when some event happens +-- inside the Nginx worker to which the task is bound and thus can be heavily +-- outdated. ngxCachedTimePtr :: IO (Ptr (Ptr ())) ngxCachedTimePtr = readIORef ngxCachedTimePtrStore 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.1 +version: 1.7.2 synopsis: Helper module for Nginx haskell module description: Helper module for . @@ -10,14 +10,14 @@ author: Alexey Radkov maintainer: Alexey Radkov stability: stable -copyright: 2016-2019 Alexey Radkov +copyright: 2016-2021 Alexey Radkov category: Network build-type: Simple cabal-version: 1.20 library default-language: Haskell2010 - build-depends: base >= 4.8 && < 5 + build-depends: base >= 4.9 && < 5 , template-haskell , bytestring >= 0.10.0.0 , monad-loops >= 0.4.2