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