module Network.AMQP.Utils.Options where
-import Paths_amqp_utils ( version )
-import Data.Version ( showVersion )
-import Data.Maybe
-import Data.Default.Class
-import System.Console.GetOpt
+import Data.Default.Class
+import qualified Data.Map as M
+import Data.Maybe
+import Data.Text (Text, pack)
+import Data.Version (showVersion)
+import Network.AMQP.Types
+import Paths_amqp_utils (version)
+import System.Console.GetOpt
-- | A data type for our options
-data Args = Args { server :: String
- , port :: Int
- , tls :: Bool
- , vHost :: String
- , currentExchange :: String
- , bindings :: [(String, String)]
- , rKey :: String
- , anRiss :: Maybe Int
- , fileProcess :: Maybe String
- , qName :: Maybe String
- , cert :: Maybe String
- , key :: Maybe String
- , user :: String
- , pass :: String
- , preFetch :: Int
- , heartBeat :: Maybe Int
- , tempDir :: Maybe String
- , additionalArgs :: [String]
- , connectionName :: Maybe String
- , tmpQName :: String
- , inputFile :: String
- , lineMode :: Bool
- }
+data Args = Args
+ { server :: String
+ , port :: Int
+ , tls :: Bool
+ , vHost :: String
+ , currentExchange :: String
+ , bindings :: [(String, String)]
+ , rKey :: String
+ , anRiss :: Maybe Int
+ , fileProcess :: Maybe String
+ , qName :: Maybe String
+ , cert :: Maybe String
+ , key :: Maybe String
+ , user :: String
+ , pass :: String
+ , preFetch :: Int
+ , heartBeat :: Maybe Int
+ , tempDir :: Maybe String
+ , additionalArgs :: [String]
+ , connectionName :: Maybe String
+ , tmpQName :: String
+ , inputFile :: String
+ , lineMode :: Bool
+ , confirm :: Bool
+ , msgid :: Maybe Text
+ , msgtype :: Maybe Text
+ , userid :: Maybe Text
+ , appid :: Maybe Text
+ , clusterid :: Maybe Text
+ , contenttype :: Maybe Text
+ , contentencoding :: Maybe Text
+ , replyto :: Maybe Text
+ , prio :: Maybe Octet
+ , corrid :: Maybe Text
+ , msgexp :: Maybe Text
+ , msgheader :: Maybe FieldTable
+ , fnheader :: [String]
+ , suffix :: [String]
+ , magic :: Bool
+ }
instance Default Args where
- def = Args "localhost"
- 5672
- False
- "/"
- "default"
- []
- ""
- Nothing
- Nothing
- Nothing
- Nothing
- Nothing
- "guest"
- "guest"
- 1
- Nothing
- Nothing
- []
- Nothing
- ""
- ""
- False
+ def =
+ Args
+ "localhost"
+ 5672
+ False
+ "/"
+ "default"
+ []
+ ""
+ Nothing
+ Nothing
+ Nothing
+ Nothing
+ Nothing
+ "guest"
+ "guest"
+ 1
+ Nothing
+ Nothing
+ []
+ Nothing
+ ""
+ "/dev/stdin"
+ False
+ False
+ Nothing
+ Nothing
+ Nothing
+ Nothing
+ Nothing
+ Nothing
+ Nothing
+ Nothing
+ Nothing
+ Nothing
+ Nothing
+ Nothing
+ []
+ []
+ False
-- | Common options
cOptions :: [OptDescr (Args -> Args)]
-cOptions = [ Option [ 'o' ]
- [ "server" ]
- (ReqArg (\s o -> o { server = s }) "SERVER")
- ("AMQP Server (default: " ++ server def ++ ")")
- , Option [ 'y' ]
- [ "vhost" ]
- (ReqArg (\s o -> o { vHost = s }) "VHOST")
- ("AMQP Virtual Host (default: " ++ vHost def ++ ")")
- , Option [ 'x' ]
- [ "exchange" ]
- (ReqArg (\s o -> o { currentExchange = s }) "EXCHANGE")
- ("AMQP Exchange (default: default)")
- , Option [ 'Q' ]
- [ "qname" ]
- (ReqArg (\s o -> o { tmpQName = s }) "TEMPQNAME")
- "Name for temporary exclusive Queue"
- , Option [ 'p' ]
- [ "port" ]
- (ReqArg (\s o -> o { port = read s }) "PORT")
- ("Server Port Number (default: " ++
- show (port def) ++ ")")
- , Option [ 'T' ]
- [ "tls" ]
- (NoArg (\o -> o { tls = not (tls o) }))
- ("Toggle TLS (default: " ++ show (tls def) ++ ")")
- , Option [ 'q' ]
- [ "queue" ]
- (ReqArg (\s o -> o { qName = Just s }) "QUEUENAME")
- "Ignore Exchange and bind to existing Queue"
- , Option [ 'c' ]
- [ "cert" ]
- (ReqArg (\s o -> o { cert = Just s }) "CERTFILE")
- ("TLS Client Certificate File")
- , Option [ 'k' ]
- [ "key" ]
- (ReqArg (\s o -> o { key = Just s }) "KEYFILE")
- ("TLS Client Private Key File")
- , Option [ 'U' ]
- [ "user" ]
- (ReqArg (\s o -> o { user = s }) "USERNAME")
- ("Username for Auth")
- , Option [ 'P' ]
- [ "pass" ]
- (ReqArg (\s o -> o { pass = s }) "PASSWORD")
- ("Password for Auth")
- , Option [ 's' ]
- [ "heartbeats" ]
- (ReqArg (\s o -> o { heartBeat = (Just (read s)) }) "INT")
- "heartbeat interval (0=disable, default: set by server)"
- , Option [ 'n' ]
- [ "name" ]
- (ReqArg (\s o -> o { connectionName = Just s }) "NAME")
- "connection name, will be shown in RabbitMQ web interface"
- ]
+cOptions =
+ [ Option
+ ['o']
+ ["server"]
+ (ReqArg (\s o -> o {server = s}) "SERVER")
+ ("AMQP Server (default: " ++ server def ++ ")")
+ , Option
+ ['y']
+ ["vhost"]
+ (ReqArg (\s o -> o {vHost = s}) "VHOST")
+ ("AMQP Virtual Host (default: " ++ vHost def ++ ")")
+ , Option
+ ['x']
+ ["exchange"]
+ (ReqArg (\s o -> o {currentExchange = s}) "EXCHANGE")
+ ("AMQP Exchange (default: default)")
+ , Option
+ ['Q']
+ ["qname"]
+ (ReqArg (\s o -> o {tmpQName = s}) "TEMPQNAME")
+ "Name for temporary exclusive Queue"
+ , Option
+ ['p']
+ ["port"]
+ (ReqArg (\s o -> o {port = read s}) "PORT")
+ ("Server Port Number (default: " ++ show (port def) ++ ")")
+ , Option
+ ['T']
+ ["tls"]
+ (NoArg (\o -> o {tls = not (tls o)}))
+ ("Toggle TLS (default: " ++ show (tls def) ++ ")")
+ , Option
+ ['q']
+ ["queue"]
+ (ReqArg (\s o -> o {qName = Just s}) "QUEUENAME")
+ "Ignore Exchange and bind to existing Queue"
+ , Option
+ ['c']
+ ["cert"]
+ (ReqArg (\s o -> o {cert = Just s}) "CERTFILE")
+ ("TLS Client Certificate File")
+ , Option
+ ['k']
+ ["key"]
+ (ReqArg (\s o -> o {key = Just s}) "KEYFILE")
+ ("TLS Client Private Key File")
+ , Option
+ ['U']
+ ["user"]
+ (ReqArg (\s o -> o {user = s}) "USERNAME")
+ ("Username for Auth")
+ , Option
+ ['P']
+ ["pass"]
+ (ReqArg (\s o -> o {pass = s}) "PASSWORD")
+ ("Password for Auth")
+ , Option
+ ['s']
+ ["heartbeats"]
+ (ReqArg (\s o -> o {heartBeat = (Just (read s))}) "INT")
+ "heartbeat interval (0=disable, default: set by server)"
+ , Option
+ ['n']
+ ["name"]
+ (ReqArg (\s o -> o {connectionName = Just s}) "NAME")
+ "connection name, will be shown in RabbitMQ web interface"
+ ]
-- | Options for konsum
kOptions :: [OptDescr (Args -> Args)]
-kOptions = [ Option [ 'r' ]
- [ "bindingkey" ]
- (ReqArg (\s o -> o { bindings = (currentExchange o, s) :
- (bindings o)
- })
- "BINDINGKEY")
- ("AMQP binding key (default: #)")
- , Option [ 'X' ]
- [ "execute" ]
- (OptArg (\s o -> o { fileProcess = Just (fromMaybe callback
- s)
- , tempDir = Just (fromMaybe "/tmp"
- (tempDir o))
- })
- "EXE")
- ("Callback Script File (implies -t) (-X without arg: " ++
- callback ++ ")")
- , Option [ 'a' ]
- [ "args" ]
- (ReqArg (\s o -> o { additionalArgs = s :
- (additionalArgs o)
- })
- "ARG")
- "additional argument for -X callback"
- , Option [ 'l' ]
- [ "charlimit" ]
- (ReqArg (\s o -> o { anRiss = Just (read s :: Int) }) "INT")
- "limit number of shown body chars (default: unlimited)"
- , Option [ 't' ]
- [ "tempdir", "target" ]
- (OptArg (\s o -> o { tempDir = Just (fromMaybe "/tmp" s) })
- "DIR")
- "tempdir (default: no file creation, -t without arg: /tmp)"
- , Option [ 'f' ]
- [ "prefetch" ]
- (ReqArg (\s o -> o { preFetch = read s }) "INT")
- ("Prefetch count. (0=unlimited, 1=off, default: " ++
- show (preFetch def) ++ ")")
- ]
+kOptions =
+ [ Option
+ ['r']
+ ["bindingkey"]
+ (ReqArg
+ (\s o -> o {bindings = (currentExchange o, s) : (bindings o)})
+ "BINDINGKEY")
+ ("AMQP binding key (default: #)")
+ , Option
+ ['X']
+ ["execute"]
+ (OptArg
+ (\s o ->
+ o
+ { fileProcess = Just (fromMaybe callback s)
+ , tempDir = Just (fromMaybe "/tmp" (tempDir o))
+ })
+ "EXE")
+ ("Callback Script File (implies -t) (-X without arg: " ++ callback ++ ")")
+ , Option
+ ['a']
+ ["args"]
+ (ReqArg (\s o -> o {additionalArgs = s : (additionalArgs o)}) "ARG")
+ "additional argument for -X callback"
+ , Option
+ ['l']
+ ["charlimit"]
+ (ReqArg (\s o -> o {anRiss = Just (read s :: Int)}) "INT")
+ "limit number of shown body chars (default: unlimited)"
+ , Option
+ ['t']
+ ["tempdir", "target"]
+ (OptArg (\s o -> o {tempDir = Just (fromMaybe "/tmp" s)}) "DIR")
+ "tempdir (default: no file creation, -t without arg: /tmp)"
+ , Option
+ ['f']
+ ["prefetch"]
+ (ReqArg (\s o -> o {preFetch = read s}) "INT")
+ ("Prefetch count. (0=unlimited, 1=off, default: " ++
+ show (preFetch def) ++ ")")
+ ]
-- | Options for agitprop
aOptions :: [OptDescr (Args -> Args)]
-aOptions = [ Option [ 'r' ]
- [ "routingkey" ]
- (ReqArg (\s o -> o { rKey = s }) "BINDINGKEY")
- ("AMQP binding key (default: #)")
- , Option [ 'f' ]
- [ "inputfile" ]
- (ReqArg (\s o -> o { inputFile = s }) "INPUTFILE")
- "Message input file"
- , Option [ 'l' ]
- [ "linemode" ]
- (NoArg (\o -> o { lineMode = not (lineMode o) }))
- "Toggle line-by-line mode"
- ]
+aOptions =
+ [ Option
+ ['r']
+ ["routingkey"]
+ (ReqArg (\s o -> o {rKey = s}) "ROUTINGKEY")
+ ("AMQP routing key (default: " ++ (rKey def) ++ ")")
+ , Option
+ ['f']
+ ["inputfile"]
+ (ReqArg (\s o -> o {inputFile = s}) "INPUTFILE")
+ ("Message input file (default: " ++ (inputFile def) ++ ")")
+ , Option
+ ['l']
+ ["linemode"]
+ (NoArg (\o -> o {lineMode = not (lineMode o)}))
+ ("Toggle line-by-line mode (default: " ++ show (lineMode def) ++ ")")
+ , Option
+ ['C']
+ ["confirm"]
+ (NoArg (\o -> o {confirm = not (confirm o)}))
+ ("Toggle confirms (default: " ++ show (confirm def) ++ ")")
+ , Option
+ []
+ ["msgid"]
+ (ReqArg (\s o -> o {msgid = Just $ pack s}) "ID")
+ "Message ID"
+ , Option
+ []
+ ["type"]
+ (ReqArg (\s o -> o {msgtype = Just $ pack s}) "TYPE")
+ "Message Type"
+ , Option
+ []
+ ["userid"]
+ (ReqArg (\s o -> o {userid = Just $ pack s}) "USERID")
+ "Message User-ID"
+ , Option
+ []
+ ["appid"]
+ (ReqArg (\s o -> o {appid = Just $ pack s}) "APPID")
+ "Message App-ID"
+ , Option
+ []
+ ["clusterid"]
+ (ReqArg (\s o -> o {clusterid = Just $ pack s}) "CLUSTERID")
+ "Message Cluster-ID"
+ , Option
+ []
+ ["contenttype"]
+ (ReqArg (\s o -> o {contenttype = Just $ pack s}) "CONTENTTYPE")
+ "Message Content-Type"
+ , Option
+ []
+ ["contentencoding"]
+ (ReqArg (\s o -> o {contentencoding = Just $ pack s}) "CONTENTENCODING")
+ "Message Content-Encoding"
+ , Option
+ []
+ ["replyto"]
+ (ReqArg (\s o -> o {replyto = Just $ pack s}) "REPLYTO")
+ "Message Reply-To"
+ , Option
+ []
+ ["prio"]
+ (ReqArg (\s o -> o {prio = Just $ read s}) "PRIO")
+ "Message Priority"
+ , Option
+ []
+ ["corrid"]
+ (ReqArg (\s o -> o {corrid = Just $ pack s}) "CORRID")
+ "Message CorrelationID"
+ , Option
+ []
+ ["exp"]
+ (ReqArg (\s o -> o {msgexp = Just $ pack s}) "EXP")
+ "Message Expiration"
+ , Option
+ ['h']
+ ["header"]
+ (ReqArg (\s o -> o {msgheader = addheader (msgheader o) s}) "HEADER=VALUE")
+ "Message Headers"
+ , Option
+ ['F']
+ ["fnheader"]
+ (ReqArg (\s o -> o {fnheader = s : (fnheader o)}) "HEADERNAME")
+ "Put filename into this header"
+ , Option
+ ['S']
+ ["suffix"]
+ (ReqArg (\s o -> o {suffix = s : (suffix o)}) "SUFFIX")
+ "Allowed file suffixes in hotfolder mode"
+ , Option
+ ['m']
+ ["magic"]
+ (NoArg (\o -> o {magic = not (magic o)}))
+ "Toggle setting content-type and content-encoding from file contents"
+ ]
--- |
+-- | Options for the executables
options :: String -> [OptDescr (Args -> Args)]
options "konsum" = kOptions ++ cOptions
options "agitprop" = aOptions ++ cOptions
options _ = cOptions
+-- | Add a header with a String value
+addheader :: Maybe FieldTable -> String -> Maybe FieldTable
+addheader Nothing string = Just $ FieldTable $ M.singleton (k string) (v string)
+addheader (Just (FieldTable oldheader)) string =
+ Just $ FieldTable $ M.insert (k string) (v string) oldheader
+
+k :: String -> Text
+k s = pack $ takeWhile (/= '=') s
+
+v :: String -> FieldValue
+v s = FVString $ pack $ tail $ dropWhile (/= '=') s
+
-- | 'parseargs' exename argstring
-- applies options onto argstring
parseargs :: String -> [String] -> IO Args
parseargs exename argstring =
- case getOpt Permute opt argstring of
- (o, [], []) -> return $ foldl (flip id) def o
- (_, _, errs) -> ioError $
- userError $ concat errs ++ usageInfo (usage exename) opt
+ case getOpt Permute opt argstring of
+ (o, [], []) -> return $ foldl (flip id) def o
+ (_, _, errs) ->
+ ioError $ userError $ concat errs ++ usageInfo (usage exename) opt
where
opt = options exename
callback = "/usr/lib/haskell-amqp-utils/callback"
usage :: String -> String
-usage exename = "\n\
+usage exename =
+ "\n\
\amqp-utils " ++
- (showVersion version) ++
- "\n\n\
+ (showVersion version) ++
+ "\n\n\
\Usage:\n" ++
- exename ++
- " [options]\n\n\
+ exename ++
+ " [options]\n\n\
\Options:"
projects / fd / haskell-amqp-utils.git / blobdiff