From 7c2ee942309df7a484f3ab50b1b090ca5e606c03 Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Mon, 24 Jun 2019 21:18:22 -0400 Subject: move functions around between files. nothing should be different merge-note: I'm having trouble with the merge, so I'm leaving a lot of functions duplicated in lib/Keyring.hs that were originally moved-out to lib/KeyRing/BuildKeyDB.hs in this commit. I'll clean-up later. Hopefully. --- lib/Kiki.hs | 186 +++++++++++++++++++++++++++++++----------------------------- 1 file changed, 95 insertions(+), 91 deletions(-) (limited to 'lib/Kiki.hs') diff --git a/lib/Kiki.hs b/lib/Kiki.hs index a683a91..27ebbcd 100644 --- a/lib/Kiki.hs +++ b/lib/Kiki.hs @@ -1,50 +1,51 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Kiki where -import Control.Applicative -import Control.Arrow -import Control.Concurrent -import Control.Exception -import Control.Monad -import Data.ASN1.BinaryEncoding -import Data.ASN1.Encoding -import Data.ASN1.Types -import Data.Binary -import Data.Char -import Data.List -import Data.Maybe -import Data.Monoid -import Data.OpenPGP -import Data.OpenPGP.Util -import Data.Ord -import System.Directory -import System.FilePath.Posix as FilePath -import System.IO -import System.IO.Temp -import System.IO.Error -import System.Posix.IO as Posix (createPipe) -import System.Posix.User -import System.Process -import System.Posix.Files -import qualified Data.Traversable as T (mapM) +import Control.Applicative +import Control.Arrow +import Control.Concurrent +import Control.Exception +import Control.Monad +import Data.ASN1.BinaryEncoding +import Data.ASN1.Encoding +import Data.ASN1.Types +import Data.Binary +import Data.Bool +import Data.Char +import Data.List +import Data.Maybe +import Data.Monoid +import Data.OpenPGP +import Data.OpenPGP.Util +import Data.Ord +import qualified Data.Traversable as T (mapM) +import System.Directory +import System.FilePath.Posix as FilePath +import System.IO +import System.IO.Error +import System.IO.Temp +import System.Posix.Files +import System.Posix.IO as Posix (createPipe) +import System.Posix.User +import System.Process #if defined(VERSION_memory) -import qualified Data.ByteString.Char8 as S8 -import Data.ByteArray.Encoding +import Data.ByteArray.Encoding +import qualified Data.ByteString.Char8 as S8 #elif defined(VERSION_dataenc) -import qualified Codec.Binary.Base64 as Base64 +import qualified Codec.Binary.Base64 as Base64 #endif -import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as Char8 -import qualified Data.Map.Strict as Map -import qualified SSHKey as SSH -import Network.Socket -- (SockAddr) -import ProcessUtils +import qualified Data.Map.Strict as Map +import Network.Socket +import ProcessUtils +import qualified SSHKey as SSH -import GnuPGAgent (Query(..)) -import CommandLine -import KeyRing -import DotLock +import CommandLine +import DotLock +import GnuPGAgent (Query (..)) +import KeyRing withAgent :: [PassphraseSpec] -> [PassphraseSpec] withAgent [] = [PassphraseAgent] @@ -97,7 +98,7 @@ refresh root homepass = do pth -> Just pth case r of KikiSuccess rt -> refreshCache rt mroot - _ -> return () -- XXX: silent fail? + _ -> return () -- XXX: silent fail? data CommonArgsParsed = CommonArgsParsed { cap_homespec :: Maybe String, cap_passfd :: Maybe InputFile } @@ -145,15 +146,12 @@ outputReport report = do importAndRefresh :: (FilePath -> FilePath) -> CommonArgsParsed -> SymmetricAlgorithm -> IO () importAndRefresh root cmn cipher = do - let rootdir = do guard (root "x" /= "x") - Just $ root "" - - me <- getEffectiveUserID - - let noChrootArg = rootdir == Nothing - bUnprivileged = (me/=0) && noChrootArg - if rootdir==Just "" then error "--chroot requires an argument" else do - + let rootdir = do guard (root "x" /= "x") + Just $ root "" + me <- getEffectiveUserID + let noChrootArg = rootdir == Nothing + bUnprivileged = (me/=0) && noChrootArg + bool id (error "--chroot requires an argument") (rootdir==Just "") $ do let homespec = mplus (slash <$> rootdir <*> cap_homespec cmn) (fmap (++"/root/.gnupg") rootdir) sshkeygen size = Just $ concat [ "mkdir -p \"$(dirname $file)\" && " @@ -173,10 +171,7 @@ importAndRefresh root cmn cipher = do let passfd = cap_passfd cmn - (torgen,pwds) <- - if gotsec - then return (Generate 0 $ GenRSA $ 1024 `div` 8, []) - else do + (torgen,pwds) <- bool id (const $ return (Generate 0 $ GenRSA $ 1024 `div` 8, [])) $ do {- ssh-keygen to create master key... let mkpath = home ++ "/master-key" mkdirFor mkpath @@ -255,30 +250,38 @@ importAndRefresh root cmn cipher = do -- First, we ensure that the tor key exists and is imported -- so that we know where to put the strongswan key. - let strm = StreamInfo { typ = KeyRingFile - , fill = KF_None - , spill = KF_All - , access = AutoAccess - , initializer = NoCreate - , transforms = [] } - buildStreamInfo rtyp ftyp = StreamInfo { typ = ftyp - , fill = rtyp - , spill = KF_All - , access = AutoAccess - , initializer = NoCreate - , transforms = [] } + let strm = + StreamInfo + { typ = KeyRingFile + , fill = KF_None + , spill = KF_All + , access = AutoAccess + , initializer = NoCreate + , transforms = [] + } + buildStreamInfo rtyp ftyp = + StreamInfo + { typ = ftyp + , fill = rtyp + , spill = KF_All + , access = AutoAccess + , initializer = NoCreate + , transforms = [] } peminfo bits usage = - StreamInfo { typ = PEMFile - , fill = KF_None -- KF_Match usage - , spill = KF_Match usage - , access = Sec - , initializer = Internal (GenRSA $ bits `div` 8) - , transforms = [] - } + StreamInfo + { typ = PEMFile + , fill = KF_None -- KF_Match usage + , spill = KF_Match usage + , access = Sec + , initializer = Internal (GenRSA $ bits `div` 8) + , transforms = [] + } sshcpath = fromMaybe "" rootdir ++ osHomeDir ++ ".ssh/id_rsa" sshspath = fromMaybe "" rootdir ++ "/etc/ssh/ssh_host_rsa_key" - op = KeyRingOperation - { opFiles = Map.fromList $ + op = + KeyRingOperation + { opFiles = + Map.fromList $ [ ( HomeSec, buildStreamInfo KF_All KeyRingFile ) , ( HomePub, (buildStreamInfo KF_All KeyRingFile) { access = Pub } ) , ( torgen , case torgen of @@ -295,18 +298,19 @@ importAndRefresh root cmn cipher = do , ( Generate 2 (GenRSA (4096 `div` 8)), strm { spill = KF_Match "encrypt" }) , ( Generate 3 (GenRSA (4096 `div` 8)), strm { spill = KF_Match "sign" }) ] - , opPassphrases = withAgent $ pwds ++ do pfd <- maybeToList passfd - return $ PassphraseSpec Nothing Nothing pfd - , opHome = homespec - , opTransforms = [] - } + , opPassphrases = withAgent $ pwds ++ do pfd <- maybeToList passfd + return $ PassphraseSpec Nothing Nothing pfd + , opHome = homespec + , opTransforms = [] + } -- doNothing = return () - nop = KeyRingOperation - { opFiles = Map.empty - , opPassphrases = withAgent $ do pfd <- maybeToList passfd - return $ PassphraseSpec Nothing Nothing pfd - , opHome=homespec, opTransforms = [] - } + nop = + KeyRingOperation + { opFiles = Map.empty + , opPassphrases = withAgent $ do pfd <- maybeToList passfd + return $ PassphraseSpec Nothing Nothing pfd + , opHome=homespec, opTransforms = [] + } -- if bUnprivileged then doNothing else mkdirFor torpath KikiResult rt report <- runKeyRing (if bUnprivileged then nop else op) outputReport report @@ -656,16 +660,16 @@ slash "" ('/':xs) = '/':xs slash "" xs = '/':xs slash (y:ys) xs = y:slash ys xs -opt_chroot :: Args (FilePath -> FilePath) -opt_chroot = pure (\r a -> slash r a) <*> arg "--chroot" <|> pure id +dashdashChroot :: Args (FilePath -> FilePath) +dashdashChroot = pure (\r a -> slash r a) <*> arg "--chroot" <|> pure id -opt_homedir :: Args CommonArgsParsed -opt_homedir = CommonArgsParsed +dashdashHomedir :: Args CommonArgsParsed +dashdashHomedir = CommonArgsParsed <$> optional (arg "--homedir") <*> optional (FileDesc <$> read <$> arg "--passphrase-fd") -opt_cipher :: Args SymmetricAlgorithm -opt_cipher = fromMaybe CAST5 <$> optional (cipherFromString <$> arg "--cipher") +dashdashCipher :: Args SymmetricAlgorithm +dashdashCipher = fromMaybe CAST5 <$> optional (cipherFromString <$> arg "--cipher") kikiOptions :: ( [(String,Int)], [String] ) kikiOptions = ( ss, ps ) -- cgit v1.2.3