{ config, pkgs, ... }: let haskellEnv = pkgs.haskellPackages.ghcWithPackages (pkgs: with pkgs; [ filepath directory SimpleAES bytestring base64-bytestring ]); mlmmj-exposed = pkgs.stdenv.mkDerivation { name = "mlmmj-exposed"; src = pkgs.writeScript "mlmmj-exposed" '' #! ${haskellEnv}/bin/runghc {-# LANGUAGE ViewPatterns #-} import System.IO import System.IO.Error import System.FilePath import System.Environment import System.Exit import System.Directory import System.Process import Data.Char import Control.Monad import Codec.Crypto.SimpleAES import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Lazy.Char8 as CLBS import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as CBS import qualified Data.ByteString.Base64 as Base64 main :: IO () main = do progName <- takeFileName <$> getProgName case progName of "mlmmj-exposed" -> do args <- getArgs case args of [listDir, (LBS.fromStrict . Base64.decodeLenient . CBS.pack -> extension)] -> do setCurrentDirectory listDir key <- (BS.readFile "exposed.key") `catchIOError` (\e -> if isDoesNotExistError e then randomKey >>= (\k -> BS.writeFile "exposed.key" k >> return k) else ioError e) let ((map toLower -> ident), (map toLower -> recipient)) = read . CLBS.unpack $ decryptMsg CBC key extension identities <- (lines <$> readFile "exposed.ids") `catchIOError` (\e -> if isDoesNotExistError e then return [] else ioError e) unless (ident `elem` identities) . die $ "Unknown sender: ‘" ++ ident ++ "’" subscribers <- getSubscribers unless (recipient `elem` subscribers) . die $ "Unknown recipient: ‘" ++ recipient ++ "’" getContents >>= writeFile "queue/exposed" callProcess "${pkgs.mlmmj}/bin/mlmmj-send" ["-L", listDir, "-l", "6", "-m", "queue/exposed", "-T", recipient] _ -> hPutStrLn stderr ("Called without expected arguments ( )") >> exitWith (ExitFailure 2) "mlmmj-expose" -> do args <- getArgs case args of [listDir, (map toLower -> ident)] -> do setCurrentDirectory listDir identities <- (read <$> readFile "exposed.ids") `catchIOError` (\e -> if isDoesNotExistError e then return [] else ioError e) case ident `elem` identities of True -> putStrLn "Identity is already known" False -> writeFile "exposed.ids" . unlines $ ident : identities _ -> hPutStrLn stderr ("Called without expected arguments ( )") >> exitWith (ExitFailure 2) "mlmmj-get-exposed" -> do args <- getArgs case args of [listDir, (map toLower -> ident), (map toLower -> recipient)] -> do setCurrentDirectory listDir key <- (BS.readFile "exposed.key") `catchIOError` (\e -> if isDoesNotExistError e then randomKey >>= (\k -> BS.writeFile "exposed.key" k >> return k) else ioError e) identities <- (lines <$> readFile "exposed.ids") `catchIOError` (\e -> if isDoesNotExistError e then return [] else ioError e) unless (ident `elem` identities) . die $ "Unknown sender: ‘" ++ ident ++ "’" subscribers <- getSubscribers unless (recipient `elem` subscribers) . die $ "Unknown recipient: ‘" ++ recipient ++ "’" encryptMsg CBC key (CLBS.pack . show $ (ident, recipient)) >>= CLBS.putStrLn _ -> hPutStrLn stderr ("Called without expected arguments ( )") >> exitWith (ExitFailure 2) _ -> hPutStrLn stderr ("Called under unsupported name ‘" ++ progName ++ "’") >> exitWith (ExitFailure 2) getSubscribers :: IO [String] getSubscribers = map (map toLower) . concat <$> mapM (flip catchIOError (\e -> if isDoesNotExistError e then return [] else ioError e) . readDir) ["subscribers.d", "digesters.d"] where readDir dir = concat <$> (mapM (fmap lines . readFile) . (dir ) =<< (getDirectoryContents dir)) ''; buildCommand = '' mkdir -p $out/bin cp $src $out/bin/.mlmmj-exposed for f in mlmmj-exposed mlmmj-expose mlmmj-get-exposed; do ln -s .mlmmj-exposed $out/bin/$f done ''; }; in rec { nixpkgs.config.packageOverrides = pkgs: rec { inherit mlmmj-exposed; }; environment.systemPackages = [ mlmmj-exposed ]; }