mlmmj-expose

2 files changed, 126 insertions, 0 deletions

diff --git a/ymir/hw.nix b/ymir/hw.nix
new file mode 100644
index 00000000..3ddf1035
--- /dev/null
+++ b/ymir/hw.nix
@@ -0,0 +1,39 @@
+# Do not modify this file!  It was generated by ‘nixos-generate-config’
+# and may be overwritten by future invocations.  Please make changes
+# to /etc/nixos/configuration.nix instead.
+{ config, lib, pkgs, ... }:
+
+{
+  imports =
+    [ <nixpkgs/nixos/modules/installer/scan/not-detected.nix>
+      <nixpkgs/nixos/modules/profiles/qemu-guest.nix>
+    ];
+
+  boot.initrd.availableKernelModules = [ "ata_piix" "uhci_hcd" "virtio_pci" "virtio_blk" ];
+  boot.kernelModules = [ ];
+  boot.extraModulePackages = [ ];
+
+  fileSystems."/" =
+    { 
+      device = "/dev/disk/by-label/ymir-root";
+      fsType = "ext4";
+    };
+
+  fileSystems."/boot" =
+    { 
+      device = "/dev/disk/by-label/ymir-boot";
+      fsType = "ext2";
+    };
+
+  fileSystems."/home" =
+    { 
+      device = "/dev/disk/by-label/ymir-home";
+      fsType = "ext4";
+    };
+
+  swapDevices =
+    [ { device = "/dev/disk/by-label/ymir-swap"; }
+    ];
+
+  nix.maxJobs = 2;
+}
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 @@
+{ 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.Base64 as Base64
+
+      main :: IO ()
+      main = do
+        progName <- takeFileName <$> getProgName
+        case progName of
+          "mlmmj-exposed" -> do
+            args <- getArgs
+            case args of
+              [listDir, (Base64.decodeLenient -> 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)) :: (String, String)) = read . CLBS.unpack $ decryptMsg CBC key recipientExt
+                identities <- (read <$> 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) . dio $ "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 (<listDirectory> <recipientExtension>)") >> 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 "exosed.ids" . show $ ident : identities
+              _ -> hPutStrLn stderr ("Called without expected arguments (<listDirectory> <senderIdentity>)") >> 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 <- (read <$> 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) . dio $ "Unknown recipient: ‘" ++ recipient ++ "’"
+                encryptMsg CBC key (CLBS.pack . show $ (ident, recipient)) >>= CLBS.putStrLn
+              _ -> hPutStrLn stderr ("Called without expected arguments (<listDirectory> <senderIdentity> <recipient>)") >> 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) =<< (getDirectoryContents dir)
+    '';
+    buildCommand = ''
+      mkdir -p $out/bin
+      cp $src $out/bin/.mlmmj-exposed
+      ln -s $out/bin/mlmmj-exposed .mlmmj-exposed
+    '';
+  };
+in rec {
+  environment.systemPackages = [ mlmmj-exposed ];
+}