summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--ymir/mlmmj-expose.nix10
1 files changed, 5 insertions, 5 deletions
diff --git a/ymir/mlmmj-expose.nix b/ymir/mlmmj-expose.nix
index b19b08f2..ad015f4e 100644
--- a/ymir/mlmmj-expose.nix
+++ b/ymir/mlmmj-expose.nix
@@ -1,7 +1,7 @@
1{ config, pkgs, ... }: 1{ config, pkgs, ... }:
2 2
3let 3let
4 haskellEnv = pkgs.haskellPackages.ghcWithPackages (pkgs: with pkgs; [ filepath directory SimpleAES bytestring base64-bytestring ]); 4 haskellEnv = pkgs.haskellPackages.ghcWithPackages (pkgs: with pkgs; [ filepath directory SimpleAES bytestring hex ]);
5 mlmmj-exposed = pkgs.stdenv.mkDerivation { 5 mlmmj-exposed = pkgs.stdenv.mkDerivation {
6 name = "mlmmj-exposed"; 6 name = "mlmmj-exposed";
7 src = pkgs.writeText "mlmmj-exposed.hs" '' 7 src = pkgs.writeText "mlmmj-exposed.hs" ''
@@ -26,7 +26,7 @@ let
26 import qualified Data.ByteString as BS 26 import qualified Data.ByteString as BS
27 import qualified Data.ByteString.Char8 as CBS 27 import qualified Data.ByteString.Char8 as CBS
28 28
29 import qualified Data.ByteString.Base64 as Base64 29 import Data.Hex
30 30
31 main :: IO () 31 main :: IO ()
32 main = do 32 main = do
@@ -34,9 +34,9 @@ let
34 case progName of 34 case progName of
35 "mlmmj-exposed" -> do 35 "mlmmj-exposed" -> do
36 args <- getArgs 36 args <- getArgs
37 hPutStrLn stderr $ show args
38 case args of 37 case args of
39 [listDir, (LBS.fromStrict . Base64.decodeLenient . unmassage . CBS.pack -> extension)] -> do 38 [listDir, rawExtension] -> do
39 extension <- LCBS.pack <$> unhex rawExtension
40 setCurrentDirectory listDir 40 setCurrentDirectory listDir
41 key <- (BS.readFile "exposed.key") `catchIOError` (\e -> if isDoesNotExistError e then randomKey >>= (\k -> BS.writeFile "exposed.key" k >> return k) else ioError e) 41 key <- (BS.readFile "exposed.key") `catchIOError` (\e -> if isDoesNotExistError e then randomKey >>= (\k -> BS.writeFile "exposed.key" k >> return k) else ioError e)
42 let ((map toLower -> ident), (map toLower -> recipient)) = read . CLBS.unpack $ decryptMsg CBC key extension 42 let ((map toLower -> ident), (map toLower -> recipient)) = read . CLBS.unpack $ decryptMsg CBC key extension
@@ -68,7 +68,7 @@ let
68 subscribers <- getSubscribers 68 subscribers <- getSubscribers
69 forM_ recipients (\recipient -> do { 69 forM_ recipients (\recipient -> do {
70 unless (recipient `elem` subscribers) . die $ "Unknown recipient: ‘" ++ recipient ++ "’"; 70 unless (recipient `elem` subscribers) . die $ "Unknown recipient: ‘" ++ recipient ++ "’";
71 encryptMsg CBC key (CLBS.pack . show $ (ident, recipient)) >>= putStrLn . (\ext -> takeFileName listDir ++ "+" ++ ext ++ "@subs.lists.yggdrasil.li") . CBS.unpack . massage . Base64.encode . LBS.toStrict; 71 encryptMsg CBC key (CLBS.pack . show $ (ident, recipient)) >>= putStrLn . (\ext -> takeFileName listDir ++ "+" ++ ext ++ "@subs.lists.yggdrasil.li") . hex . LCBS.unpack;
72 }) 72 })
73 _ -> hPutStrLn stderr ("Called without expected arguments (<listDirectory> <senderIdentity> [<recipient> [...]])") >> exitWith (ExitFailure 2) 73 _ -> hPutStrLn stderr ("Called without expected arguments (<listDirectory> <senderIdentity> [<recipient> [...]])") >> exitWith (ExitFailure 2)
74 _ -> hPutStrLn stderr ("Called under unsupported name ‘" ++ progName ++ "’") >> exitWith (ExitFailure 2) 74 _ -> hPutStrLn stderr ("Called under unsupported name ‘" ++ progName ++ "’") >> exitWith (ExitFailure 2)