diff options
Diffstat (limited to 'ymir')
| -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) |
