diff options
author | Gregor Kleen <gkleen@yggdrasil.li> | 2016-06-02 03:06:05 +0200 |
---|---|---|
committer | Gregor Kleen <gkleen@yggdrasil.li> | 2016-06-02 03:06:05 +0200 |
commit | f966519df0657b57d74df3d0add18b148a032023 (patch) | |
tree | c5b68540583aa9d71956664d8e6cc960ad350f7e | |
parent | 03829886768102a76ce34b1b17516c9ff38de7b3 (diff) | |
download | nixos-f966519df0657b57d74df3d0add18b148a032023.tar nixos-f966519df0657b57d74df3d0add18b148a032023.tar.gz nixos-f966519df0657b57d74df3d0add18b148a032023.tar.bz2 nixos-f966519df0657b57d74df3d0add18b148a032023.tar.xz nixos-f966519df0657b57d74df3d0add18b148a032023.zip |
hex is stable across case fold
-rw-r--r-- | ymir/mlmmj-expose.nix | 10 |
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 | ||
3 | let | 3 | let |
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) |