summaryrefslogtreecommitdiff
path: root/ymir/mlmmj-expose/mlmmj-expose.hs
diff options
context:
space:
mode:
Diffstat (limited to 'ymir/mlmmj-expose/mlmmj-expose.hs')
-rw-r--r--ymir/mlmmj-expose/mlmmj-expose.hs13
1 files changed, 8 insertions, 5 deletions
diff --git a/ymir/mlmmj-expose/mlmmj-expose.hs b/ymir/mlmmj-expose/mlmmj-expose.hs
index a7b9ec48..4ad9a201 100644
--- a/ymir/mlmmj-expose/mlmmj-expose.hs
+++ b/ymir/mlmmj-expose/mlmmj-expose.hs
@@ -14,6 +14,8 @@ import Data.Char
14import Control.Monad 14import Control.Monad
15import Control.Monad.State 15import Control.Monad.State
16 16
17import Control.Exception (bracket_)
18
17import Crypto.Hash 19import Crypto.Hash
18 20
19import qualified Data.ByteString.Lazy as LBS 21import qualified Data.ByteString.Lazy as LBS
@@ -66,7 +68,7 @@ main = do
66 subscribers <- getSubscribers 68 subscribers <- getSubscribers
67 let hashes = filter ((==) extension . snd) [((siIdent, siEmail), hashIdent SubscriberIdent{..}) | siIdent <- identities, siEmail <- subscribers ] 69 let hashes = filter ((==) extension . snd) [((siIdent, siEmail), hashIdent SubscriberIdent{..}) | siIdent <- identities, siEmail <- subscribers ]
68 case hashes of 70 case hashes of
69 [((_, recipient), _)] -> do 71 [((_, siEmail), _)] -> do
70 uuid <- UUID.nextRandom 72 uuid <- UUID.nextRandom
71 let fName = "queue" </> "exposed" <.> uuidTrans uuid 73 let fName = "queue" </> "exposed" <.> uuidTrans uuid
72 uuidTrans = uuidTrans' . UUID.toString 74 uuidTrans = uuidTrans' . UUID.toString
@@ -74,10 +76,11 @@ main = do
74 uuidTrans' [] = [] 76 uuidTrans' [] = []
75 uuidTrans' ('-':xs) = uuidTrans' xs 77 uuidTrans' ('-':xs) = uuidTrans' xs
76 uuidTrans' (x:xs) = x : uuidTrans' xs 78 uuidTrans' (x:xs) = x : uuidTrans' xs
77 getContents >>= writeFile fName 79 writeQueueFile = getContents >>= writeFile fName
78 hPrintf stdout "Forwarding mail to <%s>, subscribed to %s\n" recipient (takeBaseName listDir) 80 removeQueueFile = removeFile fName
79 callProcess "@mlmmj@/bin/mlmmj-send" ["-L", listDir, "-l", "6", "-m", fName, "-T", recipient] 81 hPrintf stdout "Forwarding mail for %s to <%s>, subscribed to %s\n" siIdent siEmail siList
80 removeFile fName 82 bracket_ writeQueueFile removeQueueFile $
83 callProcess "@mlmmj@/bin/mlmmj-send" ["-L", listDir, "-l", "6", "-m", fName, "-T", siEmail]
81 [] -> die "Unknown extension" 84 [] -> die "Unknown extension"
82 _ -> die "Ambiguous extension" 85 _ -> die "Ambiguous extension"
83 _ -> hPutStrLn stderr ("Called without expected arguments (<listDirectory> <recipientExtension>)") >> exitWith (ExitFailure 2) 86 _ -> hPutStrLn stderr ("Called without expected arguments (<listDirectory> <recipientExtension>)") >> exitWith (ExitFailure 2)