summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--ymir.nix8
-rw-r--r--ymir/hw.nix (renamed from ymir-hw.nix)0
-rw-r--r--ymir/mlmmj-expose.nix87
3 files changed, 92 insertions, 3 deletions
diff --git a/ymir.nix b/ymir.nix
index faf139f4..115953e6 100644
--- a/ymir.nix
+++ b/ymir.nix
@@ -16,7 +16,8 @@ let
16in rec { 16in rec {
17 imports = 17 imports =
18 [ 18 [
19 ./ymir-hw.nix 19 ./ymir/hw.nix
20 ./ymir/mlmmj-expose.nix
20 ./custom/zsh.nix 21 ./custom/zsh.nix
21 ./users.nix 22 ./users.nix
22 ./custom/tinc/def.nix 23 ./custom/tinc/def.nix
@@ -419,8 +420,9 @@ in rec {
419 alias_maps = hash:/etc/postfix/aliases texthash:/srv/mail/spm 420 alias_maps = hash:/etc/postfix/aliases texthash:/srv/mail/spm
420 ''; 421 '';
421 extraMasterConf = '' 422 extraMasterConf = ''
422 uucp unix - n n - - pipe flags=Fqhu user=uucp argv=/var/setuid-wrappers/uux -z -a$sender - $nexthop!rmail ($recipient) 423 uucp unix - n n - - pipe flags=Fqhu user=uucp argv=/var/setuid-wrappers/uux -z -a$sender - $nexthop!rmail ($recipient)
423 mlmmj unix - n n - - pipe flags=ORhu user=mlmmj argv=${pkgs.mlmmj}/bin/mlmmj-receive -F -L /var/spool/lists/''${user} 424 mlmmj unix - n n - - pipe flags=ORhu user=mlmmj argv=${pkgs.mlmmj}/bin/mlmmj-receive -F -L /var/spool/lists/''${user}
425 mlmmj-subs unix - n n - - pipe flags=ORhu user=mlmmj argv=${pkgs.mlmmj-exposed}/bin/mlmmj-exposed /var/spool/lists/''${user} ''${extension}
424 ''; 426 '';
425 networks = ["127.0.0.0/8" "[::ffff:127.0.0.0]/104" "[::1]/128" "10.141.0.0/16"]; 427 networks = ["127.0.0.0/8" "[::ffff:127.0.0.0]/104" "[::1]/128" "10.141.0.0/16"];
426 }; 428 };
diff --git a/ymir-hw.nix b/ymir/hw.nix
index 3ddf1035..3ddf1035 100644
--- a/ymir-hw.nix
+++ b/ymir/hw.nix
diff --git a/ymir/mlmmj-expose.nix b/ymir/mlmmj-expose.nix
new file mode 100644
index 00000000..4fa317a0
--- /dev/null
+++ b/ymir/mlmmj-expose.nix
@@ -0,0 +1,87 @@
1{ config, pkgs, ... }:
2
3let
4 haskellEnv = pkgs.haskellPackages.ghcWithPackages (pkgs: with pkgs; [ filepath directory simpleAES bytestring base64-bytestring ]);
5 mlmmj-exposed = pkgs.stdenv.mkDerivation {
6 name = "mlmmj-exposed";
7 src = pkgs.writeScript "mlmmj-exposed" ''
8 #! ${haskellEnv}/bin/runghc
9
10 {-# LANGUAGE ViewPatterns #-}
11
12 import System.IO
13 import System.IO.Error
14 import System.FilePath
15 import System.Environment
16 import System.Exit
17 import System.Directory
18 import System.Process
19
20 import Data.Char
21
22 import Control.Monad
23
24 import Codec.Crypto.SimpleAES
25
26 import qualified Data.ByteString.Lazy as LBS
27 import qualified Data.ByteString.Lazy.Char8 as CLBS
28 import qualified Data.ByteString as BS
29
30 import qualified Data.ByteString.Base64 as Base64
31
32 main :: IO ()
33 main = do
34 progName <- takeFileName <$> getProgName
35 case progName of
36 "mlmmj-exposed" -> do
37 args <- getArgs
38 case args of
39 [listDir, (Base64.decodeLenient -> extension)] -> do
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)
42 let (((map toLower -> ident), (map toLower -> recipient)) :: (String, String)) = read . CLBS.unpack $ decryptMsg CBC key recipientExt
43 identities <- (read <$> readFile "exposed.ids") `catchIOError` (\e -> if isDoesNotExistError e then return [] else ioError e)
44 unless (ident `elem` identities) . die $ "Unknown sender: ‘" ++ ident ++ "’"
45 subscribers <- getSubscribers
46 unless (recipient `elem` subscribers) . dio $ "Unknown recipient: ‘" ++ recipient ++ "’"
47 getContents >>= writeFile "queue/exposed"
48 callProcess "${pkgs.mlmmj}/bin/mlmmj-send" ["-L", listDir, "-l", "6", "-m", "queue/exposed", "-T", recipient]
49 _ -> hPutStrLn stderr ("Called without expected arguments (<listDirectory> <recipientExtension>)") >> exitWith (ExitFailure 2)
50 "mlmmj-expose" -> do
51 args <- getArgs
52 case args of
53 [listDir, (map toLower -> ident)] -> do
54 setCurrentDirectory listDir
55 identities <- (read <$> readFile "exposed.ids") `catchIOError` (\e -> if isDoesNotExistError e then return [] else ioError e)
56 case ident `elem` identities of
57 True -> putStrLn "Identity is already known"
58 False -> writeFile "exosed.ids" . show $ ident : identities
59 _ -> hPutStrLn stderr ("Called without expected arguments (<listDirectory> <senderIdentity>)") >> exitWith (ExitFailure 2)
60 "mlmmj-get-exposed" -> do
61 args <- getArgs
62 case args of
63 [listDir, (map toLower -> ident), (map toLower -> recipient)] -> do
64 setCurrentDirectory listDir
65 key <- (BS.readFile "exposed.key") `catchIOError` (\e -> if isDoesNotExistError e then randomKey >>= (\k -> BS.writeFile "exposed.key" k >> return k) else ioError e)
66 identities <- (read <$> readFile "exposed.ids") `catchIOError` (\e -> if isDoesNotExistError e then return [] else ioError e)
67 unless (ident `elem` identities) . die $ "Unknown sender: ‘" ++ ident ++ "’"
68 subscribers <- getSubscribers
69 unless (recipient `elem` subscribers) . dio $ "Unknown recipient: ‘" ++ recipient ++ "’"
70 encryptMsg CBC key (CLBS.pack . show $ (ident, recipient)) >>= CLBS.putStrLn
71 _ -> hPutStrLn stderr ("Called without expected arguments (<listDirectory> <senderIdentity> <recipient>)") >> exitWith (ExitFailure 2)
72 _ -> hPutStrLn stderr ("Called under unsupported name ‘" ++ progName ++ "’") >> exitWith (ExitFailure 2)
73
74 getSubscribers :: IO [String]
75 getSubscribers = map (map toLower) . concat <$> mapM (flip catchIOError (\e -> if isDoesNotExistError e then return [] else ioError e) . readDir) ["subscribers.d", "digesters.d"]
76 where
77 readDir dir = concat <$> mapM (fmap lines . readFile) =<< (getDirectoryContents dir)
78 '';
79 buildCommand = ''
80 mkdir -p $out/bin
81 cp $src $out/bin/.mlmmj-exposed
82 ln -s $out/bin/mlmmj-exposed .mlmmj-exposed
83 '';
84 };
85in rec {
86 environment.systemPackages = [ mlmmj-exposed ];
87}