diff options
| author | Gregor Kleen <gkleen@yggdrasil.li> | 2016-06-02 02:43:32 +0200 |
|---|---|---|
| committer | Gregor Kleen <gkleen@yggdrasil.li> | 2016-06-02 02:43:32 +0200 |
| commit | 4474762dae817d81ab0e28ed39363d21405b2a26 (patch) | |
| tree | 7dc8c963aae36372349c667a8c0785849eed21b8 | |
| parent | 6e34470bd59c85290c4611c5117ef4ce453cb1cc (diff) | |
| download | nixos-4474762dae817d81ab0e28ed39363d21405b2a26.tar nixos-4474762dae817d81ab0e28ed39363d21405b2a26.tar.gz nixos-4474762dae817d81ab0e28ed39363d21405b2a26.tar.bz2 nixos-4474762dae817d81ab0e28ed39363d21405b2a26.tar.xz nixos-4474762dae817d81ab0e28ed39363d21405b2a26.zip | |
massage because email
| -rw-r--r-- | ymir/mlmmj-expose.nix | 26 |
1 files changed, 21 insertions, 5 deletions
diff --git a/ymir/mlmmj-expose.nix b/ymir/mlmmj-expose.nix index fbc66ef0..4973b50a 100644 --- a/ymir/mlmmj-expose.nix +++ b/ymir/mlmmj-expose.nix | |||
| @@ -37,7 +37,7 @@ let | |||
| 37 | "mlmmj-exposed" -> do | 37 | "mlmmj-exposed" -> do |
| 38 | args <- getArgs | 38 | args <- getArgs |
| 39 | case args of | 39 | case args of |
| 40 | [listDir, (LBS.fromStrict . Base64.decodeLenient . CBS.pack -> extension)] -> do | 40 | [listDir, (LBS.fromStrict . Base64.decodeLenient . unmassage . CBS.pack -> extension)] -> do |
| 41 | setCurrentDirectory listDir | 41 | setCurrentDirectory listDir |
| 42 | key <- (BS.readFile "exposed.key") `catchIOError` (\e -> if isDoesNotExistError e then randomKey >>= (\k -> BS.writeFile "exposed.key" k >> return k) else ioError e) | 42 | key <- (BS.readFile "exposed.key") `catchIOError` (\e -> if isDoesNotExistError e then randomKey >>= (\k -> BS.writeFile "exposed.key" k >> return k) else ioError e) |
| 43 | let ((map toLower -> ident), (map toLower -> recipient)) = read . CLBS.unpack $ decryptMsg CBC key extension | 43 | let ((map toLower -> ident), (map toLower -> recipient)) = read . CLBS.unpack $ decryptMsg CBC key extension |
| @@ -61,21 +61,37 @@ let | |||
| 61 | "mlmmj-get-exposed" -> do | 61 | "mlmmj-get-exposed" -> do |
| 62 | args <- getArgs | 62 | args <- getArgs |
| 63 | case args of | 63 | case args of |
| 64 | [listDir, (map toLower -> ident), (map toLower -> recipient)] -> do | 64 | [listDir, (map toLower -> ident)] : (map (map toLower) -> recipients) -> do |
| 65 | setCurrentDirectory listDir | 65 | setCurrentDirectory listDir |
| 66 | key <- (BS.readFile "exposed.key") `catchIOError` (\e -> if isDoesNotExistError e then randomKey >>= (\k -> BS.writeFile "exposed.key" k >> return k) else ioError e) | 66 | key <- (BS.readFile "exposed.key") `catchIOError` (\e -> if isDoesNotExistError e then randomKey >>= (\k -> BS.writeFile "exposed.key" k >> return k) else ioError e) |
| 67 | identities <- (lines <$> readFile "exposed.ids") `catchIOError` (\e -> if isDoesNotExistError e then return [] else ioError e) | 67 | identities <- (lines <$> readFile "exposed.ids") `catchIOError` (\e -> if isDoesNotExistError e then return [] else ioError e) |
| 68 | unless (ident `elem` identities) . die $ "Unknown sender: ‘" ++ ident ++ "’" | 68 | unless (ident `elem` identities) . die $ "Unknown sender: ‘" ++ ident ++ "’" |
| 69 | subscribers <- getSubscribers | 69 | subscribers <- getSubscribers |
| 70 | unless (recipient `elem` subscribers) . die $ "Unknown recipient: ‘" ++ recipient ++ "’" | 70 | for_ recipients (\recipient -> do |
| 71 | encryptMsg CBC key (CLBS.pack . show $ (ident, recipient)) >>= CBS.putStrLn . Base64.encode . LBS.toStrict | 71 | unless (recipient `elem` subscribers) . die $ "Unknown recipient: ‘" ++ recipient ++ "’" |
| 72 | _ -> hPutStrLn stderr ("Called without expected arguments (<listDirectory> <senderIdentity> <recipient>)") >> exitWith (ExitFailure 2) | 72 | encryptMsg CBC key (CLBS.pack . show $ (ident, recipient)) >>= putStrLn . (\ext -> takeDirectory listDir ++ "+" ++ ext ++ "@subs.lists.yggdrasil.li") . CBS.unpack . massage . Base64.encode . LBS.toStrict |
| 73 | ) | ||
| 74 | _ -> hPutStrLn stderr ("Called without expected arguments (<listDirectory> <senderIdentity> [<recipient> [...]])") >> exitWith (ExitFailure 2) | ||
| 73 | _ -> hPutStrLn stderr ("Called under unsupported name ‘" ++ progName ++ "’") >> exitWith (ExitFailure 2) | 75 | _ -> hPutStrLn stderr ("Called under unsupported name ‘" ++ progName ++ "’") >> exitWith (ExitFailure 2) |
| 74 | 76 | ||
| 75 | getSubscribers :: IO [String] | 77 | getSubscribers :: IO [String] |
| 76 | getSubscribers = map (map toLower) . concat <$> mapM (flip catchIOError (\e -> if isDoesNotExistError e then return [] else ioError e) . readDir) ["subscribers.d", "digesters.d"] | 78 | getSubscribers = map (map toLower) . concat <$> mapM (flip catchIOError (\e -> if isDoesNotExistError e then return [] else ioError e) . readDir) ["subscribers.d", "digesters.d"] |
| 77 | where | 79 | where |
| 78 | readDir dir = concat <$> (mapM (fmap lines . readFile) . map (dir </>) . filter (not . (`elem` [".", ".."]))=<< (getDirectoryContents dir)) | 80 | readDir dir = concat <$> (mapM (fmap lines . readFile) . map (dir </>) . filter (not . (`elem` [".", ".."]))=<< (getDirectoryContents dir)) |
| 81 | |||
| 82 | massage :: BS.ByteString -> BS.ByteString | ||
| 83 | massage = CBS.pack . map massage' . CBS.unpack | ||
| 84 | where | ||
| 85 | massage' '+' = '-' | ||
| 86 | massage' '/' = '_' | ||
| 87 | massage' c = c | ||
| 88 | |||
| 89 | unmassage :: BS.ByteString -> BS.ByteString | ||
| 90 | unmassage = CBS.pack . map massage' . CBS.unpack | ||
| 91 | where | ||
| 92 | massage' '-' = '+' | ||
| 93 | massage' '_' = '/' | ||
| 94 | massage' c = c | ||
| 79 | ''; | 95 | ''; |
| 80 | buildCommand = '' | 96 | buildCommand = '' |
| 81 | mkdir -p $out/bin | 97 | mkdir -p $out/bin |
