diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -1,3 +1,14 @@ +### 1.7.0 + +- Now basic synchronous and all asynchronous content handlers are expected to + return a list of custom response headers in the *4th* field of the + *ContentHandlerResult*. +- All asynchronous handlers get proper masking against asynchronous exceptions, + which is especially important for service handlers in presence of asynchronous + exceptions from service hooks. +- Now a new StablePtr for the content type gets returned only when its value is + not empty. + ### 1.6.4 - Added exception *WorkerProcessIsExiting* to signal services that Nginx is diff --git a/NgxExport.hs b/NgxExport.hs --- a/NgxExport.hs +++ b/NgxExport.hs @@ -20,6 +20,7 @@ -- * Type declarations ContentHandlerResult ,UnsafeContentHandlerResult + ,HTTPHeaders -- * Exporters -- *** Synchronous handlers ,ngxExportSS @@ -116,8 +117,9 @@ {-# COMPLETE ToBool :: CUInt #-} #endif --- | The /3-tuple/ contains /(content, content-type, HTTP-status)/. -type ContentHandlerResult = (L.ByteString, B.ByteString, Int) +-- | The /4-tuple/ contains +-- /(content, content-type, HTTP-status, response-headers)/. +type ContentHandlerResult = (L.ByteString, B.ByteString, Int, HTTPHeaders) -- | The /3-tuple/ contains /(content, content-type, HTTP-status)/. -- @@ -126,6 +128,9 @@ -- termination and must not be garbage-collected in the Haskell RTS. type UnsafeContentHandlerResult = (B.ByteString, B.ByteString, Int) +-- | A list of HTTP headers comprised of /name-value/ pairs. +type HTTPHeaders = [(B.ByteString, B.ByteString)] + data NgxExport = SS (String -> String) | SSS (String -> String -> String) | SLS ([String] -> String) @@ -143,17 +148,17 @@ | AsyncHandlerRB (L.ByteString -> B.ByteString -> IO ContentHandlerResult) -data NgxExportDisambiguation = Unambiguous - | YYSync - | YYDefHandler - | IOYYSync - | IOYYAsync +data NgxExportTypeAmbiguityTag = Unambiguous + | YYSync + | YYDefHandler + | IOYYSync + | IOYYAsync do TyConI (DataD _ _ _ EXTRA_WILDCARD_BEFORE_CON tCs _) <- reify ''NgxExport TyConI (DataD _ _ _ EXTRA_WILDCARD_BEFORE_CON aCs _) <- - reify ''NgxExportDisambiguation + reify ''NgxExportTypeAmbiguityTag let tName = mkName "exportType" aName = mkName "exportTypeAmbiguity" tCons = map (\(NormalC con [(_, typ)]) -> (con, typ)) tCs @@ -164,7 +169,7 @@ map (\(fst -> c, i) -> clause [conP c [wildP]] (normalB [|return i|]) [] ) (zip tCons [1 ..] :: [((Name, Type), Int)]) - ,sigD aName [t|NgxExportDisambiguation -> IO CInt|] + ,sigD aName [t|NgxExportTypeAmbiguityTag -> IO CInt|] ,funD aName $ map (\(c, i) -> clause [conP c []] (normalB [|return i|]) [] @@ -386,6 +391,7 @@ ngxExport 'Handler 'Unambiguous 'handler [t|CString -> CInt -> Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr CString -> Ptr CSize -> Ptr (StablePtr B.ByteString) -> Ptr CInt -> + Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr (StablePtr L.ByteString) -> Ptr (StablePtr L.ByteString) -> IO CUInt|] -- | Exports a function of type @@ -428,6 +434,7 @@ ngxExport 'AsyncHandler 'Unambiguous 'asyncHandler [t|CString -> CInt -> CInt -> CUInt -> Ptr CString -> Ptr CSize -> Ptr (StablePtr B.ByteString) -> Ptr CInt -> + Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr (StablePtr L.ByteString) -> Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr CUInt -> Ptr (StablePtr L.ByteString) -> IO (StablePtr (Async ()))|] @@ -447,6 +454,7 @@ [t|Ptr NgxStrType -> Ptr NgxStrType -> CInt -> CString -> CInt -> CInt -> CUInt -> Ptr CString -> Ptr CSize -> Ptr (StablePtr B.ByteString) -> Ptr CInt -> + Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr (StablePtr L.ByteString) -> Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr CUInt -> Ptr (StablePtr L.ByteString) -> IO (StablePtr (Async ()))|] @@ -589,7 +597,7 @@ return (nullPtr, 0) toBuffers s p = do let n = L.foldlChunks (const . succ) 0 s - if n == 1 + if n == 1 && p /= nullPtr then do B.unsafeUseAsCStringLen (head $ L.toChunks s) $ \(x, I l) -> poke p $ NgxStrType l x @@ -617,10 +625,11 @@ when (t /= nullPtr) $ newStablePtr s >>= poke spd pokeContentTypeAndStatus :: B.ByteString -> - Ptr CString -> Ptr CSize -> Ptr CInt -> CInt -> IO () + Ptr CString -> Ptr CSize -> Ptr CInt -> CInt -> IO CSize pokeContentTypeAndStatus ct pct plct pst st = do PtrLen sct lct <- B.unsafeUseAsCStringLen ct return pokeCStringLen sct lct pct plct >> poke pst st + return lct peekRequestBodyChunks :: Ptr NgxStrType -> Ptr NgxStrType -> Int -> IO L.ByteString @@ -634,10 +643,12 @@ else peekNgxStringArrayLenY b m pokeAsyncHandlerData :: B.ByteString -> Ptr CString -> Ptr CSize -> - Ptr (StablePtr B.ByteString) -> Ptr CInt -> CInt -> IO () -pokeAsyncHandlerData ct pct plct spct pst st = do - pokeContentTypeAndStatus ct pct plct pst st - newStablePtr ct >>= poke spct + Ptr (StablePtr B.ByteString) -> Ptr CInt -> CInt -> HTTPHeaders -> + Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr (StablePtr L.ByteString) -> IO () +pokeAsyncHandlerData ct pct plct spct pst st rhs prhs plrhs sprhs = do + lct <- pokeContentTypeAndStatus ct pct plct pst st + when (lct > 0) $ newStablePtr ct >>= poke spct + pokeLazyByteString (fromHTTPHeaders rhs) prhs plrhs sprhs safeHandler :: Ptr CString -> Ptr CInt -> IO CUInt -> IO CUInt safeHandler p pl = handle $ \e -> do @@ -645,9 +656,14 @@ pokeCStringLen x l p pl return 1 -safeYYHandler :: IO (L.ByteString, (CUInt, Bool)) -> - IO (L.ByteString, (CUInt, Bool)) +safeYYHandler :: IO (L.ByteString, CUInt) -> IO (L.ByteString, CUInt) safeYYHandler = handle $ \e -> + return (C8L.pack $ show (e :: SomeException), 1) +{-# INLINE safeYYHandler #-} + +safeAsyncYYHandler :: IO (L.ByteString, (CUInt, Bool)) -> + IO (L.ByteString, (CUInt, Bool)) +safeAsyncYYHandler = handle $ \e -> return (C8L.pack $ show e, (case fromException e of Just ServiceHookInterrupt -> 2 @@ -666,8 +682,13 @@ _ -> False ) ) -{-# INLINE safeYYHandler #-} +{-# INLINE safeAsyncYYHandler #-} +fromHTTPHeaders :: HTTPHeaders -> L.ByteString +fromHTTPHeaders = L.fromChunks . foldr (\(z -> a, z -> b) -> ([a, b] ++)) [] + where z s | B.null s = B.singleton 0 + | otherwise = s + isEINTR :: IOError -> Bool isEINTR = (Just ((\(Errno i) -> i) eINTR) ==) . ioe_errno {-# INLINE isEINTR #-} @@ -704,9 +725,9 @@ Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr (StablePtr L.ByteString) -> IO CUInt yY f x (I n) p pl spd = do - (s, (r, _)) <- safeYYHandler $ do + (s, r) <- safeYYHandler $ do s <- f <$> B.unsafePackCStringLen (x, n) - fmap (, (0, False)) $ return $!! s + fmap (, 0) $ return $!! s pokeLazyByteString s p pl spd return r @@ -715,9 +736,9 @@ Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr (StablePtr L.ByteString) -> IO CUInt ioyYCommon pack f x (I n) p pl spd = do - (s, (r, _)) <- safeYYHandler $ do + (s, r) <- safeYYHandler $ do s <- pack (x, n) >>= flip f False - fmap (, (0, False)) $ return $!! s + fmap (, 0) $ return $!! s pokeLazyByteString s p pl spd return r @@ -740,12 +761,13 @@ 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 = +asyncIOCommon a (I fd) efd p pl pr spd = mask $ \restore -> async (do - (s, (r, exiting)) <- safeYYHandler $ do - (s, exiting) <- a - fmap (, (0, exiting)) $ return $!! s + (s, (r, exiting)) <- safeAsyncYYHandler $ + restore $ do + (s, exiting) <- a + fmap (, (0, exiting)) $ return $!! s pokeLazyByteString s p pl spd poke pr r if exiting @@ -768,11 +790,11 @@ writeFlag1b = B.unsafeUseAsCString asyncIOFlag1b $ writeBufN 1 writeFlag8b = B.unsafeUseAsCString asyncIOFlag8b $ writeBufN 8 closeChannel = closeFd fd `catchIOError` const (return ()) - -- FIXME: cleanupOnWriteError should free contents of p, spd, - -- and spct. However, leaving this not implemented seems to be safe - -- because Nginx won't close the event channel or delete the request - -- object (for request-driven handlers) regardless of the Haskell - -- handler's duration. + -- FIXME: cleanupOnWriteError should free all previously allocated + -- data and stable pointers. However, leaving this not implemented + -- seems to be safe because Nginx won't close the event channel or + -- delete the request object (for request-driven handlers) + -- regardless of the Haskell handler's duration. cleanupOnWriteError = return () asyncIOYY :: IOYY -> CString -> CInt -> @@ -818,29 +840,35 @@ asyncHandler :: AsyncHandler -> CString -> CInt -> CInt -> CUInt -> Ptr CString -> Ptr CSize -> Ptr (StablePtr B.ByteString) -> Ptr CInt -> + Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr (StablePtr L.ByteString) -> Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr CUInt -> Ptr (StablePtr L.ByteString) -> IO (StablePtr (Async ())) -asyncHandler f x (I n) fd (ToBool efd) pct plct spct pst = +asyncHandler f x (I n) fd (ToBool efd) pct plct spct pst + prhs plrhs sprhs = asyncIOCommon (do x' <- B.unsafePackCStringLen (x, n) - (s, ct, I st) <- f x' - (return $!! s) >> pokeAsyncHandlerData ct pct plct spct pst st + v@(s, ct, I st, rhs) <- f x' + (return $!! v) >> mask_ + (pokeAsyncHandlerData ct pct plct spct pst st rhs prhs plrhs sprhs) return (s, False) ) fd efd asyncHandlerRB :: AsyncHandlerRB -> Ptr NgxStrType -> Ptr NgxStrType -> CInt -> CString -> CInt -> CInt -> CUInt -> Ptr CString -> Ptr CSize -> Ptr (StablePtr B.ByteString) -> Ptr CInt -> + Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr (StablePtr L.ByteString) -> Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr CUInt -> Ptr (StablePtr L.ByteString) -> IO (StablePtr (Async ())) -asyncHandlerRB f tmpf b (I m) x (I n) fd (ToBool efd) pct plct spct pst = +asyncHandlerRB f tmpf b (I m) x (I n) fd (ToBool efd) pct plct spct pst + prhs plrhs sprhs = asyncIOCommon (do b' <- peekRequestBodyChunks tmpf b m x' <- B.unsafePackCStringLen (x, n) - (s, ct, I st) <- f b' x' - (return $!! s) >> pokeAsyncHandlerData ct pct plct spct pst st + v@(s, ct, I st, rhs) <- f b' x' + (return $!! v) >> mask_ + (pokeAsyncHandlerData ct pct plct spct pst st rhs prhs plrhs sprhs) return (s, False) ) fd efd @@ -879,13 +907,16 @@ handler :: Handler -> CString -> CInt -> Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr CString -> Ptr CSize -> Ptr (StablePtr B.ByteString) -> Ptr CInt -> + Ptr (Ptr NgxStrType) -> Ptr CInt -> Ptr (StablePtr L.ByteString) -> Ptr (StablePtr L.ByteString) -> IO CUInt -handler f x (I n) p pl pct plct spct pst spd = +handler f x (I n) p pl pct plct spct pst prhs plrhs sprhs spd = safeHandler pct pst $ do - (s, ct, I st) <- f <$> B.unsafePackCStringLen (x, n) - (return $!! s) >> pokeContentTypeAndStatus ct pct plct pst st + v@(s, ct, I st, rhs) <- f <$> B.unsafePackCStringLen (x, n) + lct <- (return $!! v) >> pokeContentTypeAndStatus ct pct plct pst st + (return $!! lct) >> + pokeLazyByteString (fromHTTPHeaders rhs) prhs plrhs sprhs pokeLazyByteString s p pl spd - newStablePtr ct >>= poke spct + when (lct > 0) $ newStablePtr ct >>= poke spct return 0 defHandler :: YY -> CString -> CInt -> @@ -901,8 +932,8 @@ Ptr CString -> Ptr CSize -> Ptr CInt -> IO CUInt unsafeHandler f x (I n) p pl pct plct pst = safeHandler pct pst $ do - (s, ct, I st) <- f <$> B.unsafePackCStringLen (x, n) - (return $!! s) >> pokeContentTypeAndStatus ct pct plct pst st + v@(s, ct, I st) <- f <$> B.unsafePackCStringLen (x, n) + (return $!! v) >> void (pokeContentTypeAndStatus ct pct plct pst st) PtrLen t l <- B.unsafeUseAsCStringLen s return pokeCStringLen t l p pl return 0 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.6.4 +version: 1.7.0 synopsis: Helper module for Nginx haskell module description: Helper module for .