summaryrefslogtreecommitdiff
path: root/ymir
diff options
context:
space:
mode:
Diffstat (limited to 'ymir')
-rw-r--r--ymir/mlmmj-expose.nix26
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