diff options
Diffstat (limited to 'ymir/mlmmj-expose/mlmmj-expose.hs')
-rw-r--r-- | ymir/mlmmj-expose/mlmmj-expose.hs | 13 |
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 | |||
14 | import Control.Monad | 14 | import Control.Monad |
15 | import Control.Monad.State | 15 | import Control.Monad.State |
16 | 16 | ||
17 | import Control.Exception (bracket_) | ||
18 | |||
17 | import Crypto.Hash | 19 | import Crypto.Hash |
18 | 20 | ||
19 | import qualified Data.ByteString.Lazy as LBS | 21 | import 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) |