From 53ba13c2b0f76176f585a1d9d468c7e11d029478 Mon Sep 17 00:00:00 2001
From: Frank Doepper <fd@taz.de>
Date: Wed, 27 Jun 2018 13:01:54 +0200
Subject: [PATCH] agitprop: allowed file suffix list option

---
 Network/AMQP/Utils/Options.hs |  7 +++++++
 agitprop.hs                   | 24 +++++++++++++-----------
 2 files changed, 20 insertions(+), 11 deletions(-)

diff --git a/Network/AMQP/Utils/Options.hs b/Network/AMQP/Utils/Options.hs
index 6458483..91a36d4 100644
--- a/Network/AMQP/Utils/Options.hs
+++ b/Network/AMQP/Utils/Options.hs
@@ -48,6 +48,7 @@ data Args = Args
   , msgexp :: Maybe Text
   , msgheader :: Maybe FieldTable
   , fnheader :: [ String ]
+  , suffix :: [ String ]
   }
 
 instance Default Args where
@@ -90,6 +91,7 @@ instance Default Args where
       Nothing
       Nothing
       []
+      []
 
 -- | Common options
 cOptions :: [OptDescr (Args -> Args)]
@@ -300,6 +302,11 @@ aOptions =
       ["fnheader"]
       (ReqArg (\s o -> o {fnheader = s:(fnheader o)}) "HEADERNAME")
       ("Message Header for filename")
+  , Option
+      ['S']
+      ["suffix"]
+      (ReqArg (\s o -> o {suffix = s:(suffix o)}) "SUFFIX")
+      ("Allowed file suffixes for hotfolder mode")
   ]
 
 -- | Options for the executables
diff --git a/agitprop.hs b/agitprop.hs
index b787a51..a736f68 100644
--- a/agitprop.hs
+++ b/agitprop.hs
@@ -5,6 +5,7 @@ import qualified Control.Exception as X
 import Control.Monad (forever)
 import qualified Data.ByteString.Lazy.Char8 as BL
 import qualified Data.Text as T
+import Data.List (isSuffixOf)
 import Data.Time
 import Data.Time.Clock.POSIX
 import Data.Version (showVersion)
@@ -50,7 +51,7 @@ main = do
              inotify
              [CloseWrite, MoveIn]
              (inputFile args)
-             (handleEvent publishOneMsg)
+             (handleEvent publishOneMsg (suffix args))
          hr $ "watching " ++ (inputFile args)
          _ <- forever $ threadDelay 1000000
          removeWatch wd
@@ -79,16 +80,17 @@ confirmCallback (deliveryTag, isAll, ackType) =
      (show ackType))
 
 -- | Hotfolder event handler
-handleEvent :: (Maybe String -> BL.ByteString -> IO ()) -> Event -> IO ()
+handleEvent :: (Maybe String -> BL.ByteString -> IO ()) -> [ String ] -> Event -> IO ()
 -- just handle closewrite and movedin events
-handleEvent f (Closed False (Just x) True) = handleFile f x
-handleEvent f (MovedIn False x _) = handleFile f x
-handleEvent _ _ = return ()
+handleEvent f s (Closed False (Just x) True) = handleFile f s x
+handleEvent f s (MovedIn False x _) = handleFile f s x
+handleEvent _ _ _ = return ()
 
 -- | Hotfolder file handler
-handleFile :: (Maybe String -> BL.ByteString -> IO ()) -> FilePath -> IO ()
-handleFile _ ('.':_) = return () -- ignore hidden files
-handleFile f x =
+handleFile :: (Maybe String -> BL.ByteString -> IO ()) -> [String] -> FilePath -> IO ()
+handleFile _ _ ('.':_) = return () -- ignore hidden files
+handleFile f s@(_:_) x = if any (flip isSuffixOf x) s then handleFile f [] x else return ()
+handleFile f [] x =
   X.catch
     (hr ("sending " ++ x) >> BL.readFile x >>= f (Just x))
     (\exception ->
@@ -123,7 +125,7 @@ publishOneMsg' c a fn f = do
         }
   printparam "sent" $ fmap show r
   where
-    substheader ::
-         [String] -> Maybe String -> Maybe FieldTable -> Maybe FieldTable
-    substheader (s:r) (Just fname) old = substheader r (Just fname) (addheader old (s ++ "=" ++ fname))
+    substheader :: [String] -> Maybe String -> Maybe FieldTable -> Maybe FieldTable
+    substheader (s:r) (Just fname) old =
+      substheader r (Just fname) (addheader old (s ++ "=" ++ fname))
     substheader _ _ old = old
-- 
2.39.5