diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,6 +1,15 @@ # Revision history for haskell-amqp-utils +## 0.4.2.0 -- 2019-12-19 + +* introduce --cleanup (-j) to remove temp file +* change temp file name from konsum-* to amqp-utils-* +* handle all numeric types in amqp headers same +* update to amqp-0.19 +* use utf8-string for header string values + ## 0.4.1.0 -- 2019-12-09 + * printparam -> Flexprint * introduce --simple / -i * review data types @@ -8,9 +17,11 @@ * update doc ## 0.4.0.1 -- 2019-12-04 + * fix exit codes ## 0.4.0.0 -- 2019-11-11 + * agitprop: show exchange arg * agitprop does not need -q or -Q * allow RPC with dedicated exchange @@ -20,6 +31,7 @@ * duplicate plane body to outfile and stderr ## 0.3.7.1 -- 2019-09-10 + * connect timeout ## 0.3.6.0 -- 2019-02-15 diff --git a/Network/AMQP/Utils/Helpers.hs b/Network/AMQP/Utils/Helpers.hs --- a/Network/AMQP/Utils/Helpers.hs +++ b/Network/AMQP/Utils/Helpers.hs @@ -6,6 +6,7 @@ import qualified Control.Exception as X import Control.Monad import qualified Data.ByteString.Lazy.Char8 as BL +import qualified Data.ByteString.UTF8 as BS import Data.Int (Int64) import Data.List import qualified Data.Map as M @@ -18,6 +19,7 @@ import Network.AMQP.Types import Network.AMQP.Utils.Options import Network.Socket (PortNumber) +import System.Directory (removeFile) import System.Exit import System.IO import System.Process @@ -98,8 +100,13 @@ -- | showing a FieldValue valueshow :: FieldValue -> String -valueshow (FVString value) = T.unpack value +valueshow (FVString value) = BS.toString value +valueshow (FVInt8 value) = show value +valueshow (FVInt16 value) = show value valueshow (FVInt32 value) = show value +valueshow (FVInt64 value) = show value +valueshow (FVFloat value) = show value +valueshow (FVDouble value) = show value valueshow value = show value -- | skip showing body head if binary type @@ -254,7 +261,7 @@ (acke envi a) (\c -> forkFinally - (doProc a numstring envi c action) + (doProc a numstring envi c action path) (either (throwTo tid) return) >> return ()) callbackcmdline @@ -266,7 +273,7 @@ (p, h) <- openBinaryTempFileWithDefaultPermissions tempD - ("konsum-" ++ numstring ++ "-.tmp") + ("amqp-utils-" ++ numstring ++ "-.tmp") BL.hPut h body hClose h return $ Just p @@ -285,8 +292,9 @@ -> Envelope -> [String] -> Maybe (ExitCode -> BL.ByteString -> IO ()) + -> Maybe String -> IO () -doProc a numstring envi (exe:args) action = do +doProc a numstring envi (exe:args) action path = do (_, h, _, processhandle) <- createProcess (proc exe args) {std_out = out, std_err = Inherit} sout <- mapM BL.hGetContents h @@ -298,12 +306,17 @@ else case exitcode of ExitSuccess -> acke envi a ExitFailure _ -> reje envi a + if (cleanupTmpFile a) + then X.catch + (maybe (return ()) removeFile path) + (\e -> printparam "error removing temp file" (e :: X.SomeException)) + else return () where out = if isJust action then CreatePipe else Inherit -doProc _ _ _ _ _ = return () +doProc _ _ _ _ _ _ = return () -- | ack acke :: Envelope -> Args -> IO () diff --git a/Network/AMQP/Utils/Options.hs b/Network/AMQP/Utils/Options.hs --- a/Network/AMQP/Utils/Options.hs +++ b/Network/AMQP/Utils/Options.hs @@ -2,6 +2,7 @@ import Data.Default.Class import Data.Int (Int64) +import qualified Data.ByteString.Char8 as BS import qualified Data.Map as M import Data.Maybe import Data.Text (Text, pack) @@ -67,6 +68,7 @@ , rpc_timeout :: Double , connect_timeout :: Int , simple :: Bool + , cleanupTmpFile :: Bool } instance Default Args where @@ -117,6 +119,7 @@ 5 60 False + False -- | all options allOptions :: [(String, OptDescr (Args -> Args))] @@ -332,8 +335,15 @@ , Option ['i'] ["simple"] - (NoArg (\o -> o {simple = True})) + (NoArg + (\o -> o {simple = True, cleanupTmpFile = not (cleanupTmpFile o)})) "call callback with one arg (filename) only") + , ( "kr" + , Option + ['j'] + ["cleanup"] + (NoArg (\o -> o {cleanupTmpFile = not (cleanupTmpFile o)})) + "Toggle remove tempfile after script call. Default False, but default True if --simple (-i)") , ( "krp" , Option ['Q'] @@ -430,7 +440,7 @@ getkey s = pack $ takeWhile (/= '=') s getval :: String -> FieldValue -getval s = FVString $ pack $ tail $ dropWhile (/= '=') s +getval s = FVString $ BS.pack $ tail $ dropWhile (/= '=') s -- | 'parseargs' exename argstring -- applies options onto argstring diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -25,6 +25,7 @@ -l INT --charlimit=INT limit number of shown body chars (default: unlimited) -q QUEUENAME --queue=QUEUENAME Ignore Exchange and bind to existing Queue -i --simple call callback with one arg (filename) only + -j --cleanup Toggle remove tempfile after script call. Default False, but default True if --simple (-i) -Q TEMPQNAME --qname=TEMPQNAME Name for temporary exclusive Queue -x EXCHANGE --exchange=EXCHANGE AMQP Exchange (default: "") -o SERVER --server=SERVER AMQP Server (default: localhost) @@ -171,6 +172,7 @@ -l INT --charlimit=INT limit number of shown body chars (default: unlimited) -q QUEUENAME --queue=QUEUENAME Ignore Exchange and bind to existing Queue -i --simple call callback with one arg (filename) only + -j --cleanup Toggle remove tempfile after script call. Default False, but default True if --simple (-i) -Q TEMPQNAME --qname=TEMPQNAME Name for temporary exclusive Queue -x EXCHANGE --exchange=EXCHANGE AMQP Exchange (default: "") -o SERVER --server=SERVER AMQP Server (default: localhost) diff --git a/amqp-utils.cabal b/amqp-utils.cabal --- a/amqp-utils.cabal +++ b/amqp-utils.cabal @@ -1,6 +1,6 @@ name: amqp-utils -version: 0.4.1.0 +version: 0.4.2.0 synopsis: Generic Haskell AMQP tools @@ -42,11 +42,13 @@ data-default-class, time, process, + directory, bytestring, + utf8-string, x509-system, network > 2.6, tls >= 1.3.9, - amqp >=0.17 + amqp >=0.19 ghc-options: -threaded -Wall @@ -66,11 +68,13 @@ data-default-class, time, process, + directory, bytestring, + utf8-string, x509-system, network > 2.6, tls >= 1.3.9, - amqp >=0.17, + amqp >=0.19, unix >= 2.7, hinotify >= 0.3.8, magic @@ -93,11 +97,13 @@ data-default-class, time, process, + directory, bytestring, + utf8-string, x509-system, network > 2.6, tls >= 1.3.9, - amqp >=0.17, + amqp >=0.19, unix >= 2.7 ghc-options: -threaded -Wall @@ -118,11 +124,13 @@ data-default-class, time, process, + directory, bytestring, + utf8-string, x509-system, network > 2.6, tls >= 1.3.9, - amqp >=0.17, + amqp >=0.19, unix >= 2.7 ghc-options: -threaded -Wall diff --git a/arbeite.hs b/arbeite.hs --- a/arbeite.hs +++ b/arbeite.hs @@ -4,6 +4,7 @@ import Control.Concurrent import qualified Control.Exception as X import Control.Monad +import qualified Data.ByteString.Char8 as BS import Data.Map (singleton) import Data.Maybe import qualified Data.Text as T @@ -25,6 +26,7 @@ X.onException (printparam "worker" $ fromJust $ fileProcess args) (error "-X option required") + printparam "cleanup temp file" $ cleanupTmpFile args let addiArgs = reverse $ additionalArgs args printparam "client version" ["amqp-utils", showVersion version] (conn, chan) <- connect args @@ -92,5 +94,5 @@ , msgExpiration = msgExpiration msg , msgHeaders = Just $ - FieldTable $ singleton "exitcode" $ FVString $ T.pack $ show e + FieldTable $ singleton "exitcode" $ FVString $ BS.pack $ show e } diff --git a/konsum.hs b/konsum.hs --- a/konsum.hs +++ b/konsum.hs @@ -35,6 +35,8 @@ printparam "temp dir" $ tempDir args printparam "callback" $ fileProcess args printparam "callback args" $ addiArgs + printparam "cleanup temp file" $ + maybe Nothing (\_ -> Just (cleanupTmpFile args)) (fileProcess args) -- subscribe to the queue ctag <- consumeMsgs