From 9cc0b24375b6b40eb7c3412983e75b6e3fe3a3f6 Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Tue, 19 May 2020 17:40:39 -0400 Subject: Commandline option to use v5 key packets. --- cokiki.hs | 33 +++++++++++++++++---------------- kiki.hs | 13 ++++++++++--- lib/KeyRing.hs | 3 +-- lib/KeyRing/BuildKeyDB.hs | 3 --- lib/KeyRing/Types.hs | 9 ++++++--- lib/Kiki.hs | 15 ++++++++++++--- 6 files changed, 46 insertions(+), 30 deletions(-) diff --git a/cokiki.hs b/cokiki.hs index 70ea256..c6d1aa5 100644 --- a/cokiki.hs +++ b/cokiki.hs @@ -25,6 +25,7 @@ usage = unlines [ "cokiki [--chroot=ROOTDIR]" , " [--homedir=HOMEDIR]" , " [--passphrase-fd=FD]" + , " [-(4|5)]" , "" , "cokiki modifies system configuration to recognize generated files" , "in /var/cache/kiki. In addition to each command's documented effects" @@ -61,12 +62,12 @@ usage = unlines main = do (cmd,args) <- splitAt 1 <$> getArgs uid <- getEffectiveUserID - let msel = case cmd of - ["ssh-client"] -> Just $ sshClient uid <$> Kiki.dashdashChroot <*> Kiki.dashdashHomedir - ["ssh-server"] -> Just $ sshServer uid <$> Kiki.dashdashChroot <*> Kiki.dashdashHomedir - ["strongswan"] -> Just $ strongswan uid <$> Kiki.dashdashChroot <*> Kiki.dashdashHomedir - ["tor"] -> Just $ configureTor uid <$> Kiki.dashdashChroot <*> Kiki.dashdashHomedir - ["hosts"] -> Just $ configureHosts uid <$> Kiki.dashdashChroot <*> Kiki.dashdashHomedir + let msel = fmap (\c -> c <$> Kiki.dashdashPGPVersion <*> Kiki.dashdashChroot <*> Kiki.dashdashHomedir) $ case cmd of + ["ssh-client"] -> Just $ sshClient uid + ["ssh-server"] -> Just $ sshServer uid + ["strongswan"] -> Just $ strongswan uid + ["tor"] -> Just $ configureTor uid + ["hosts"] -> Just $ configureHosts uid _ -> Nothing spec = uncurry fancy Kiki.kikiOptions "" errorQuit msg = do @@ -97,7 +98,7 @@ whenRoot uid root cmn action where no = hPutStrLn stderr "operation requires root." -sshClient uid root cmn = whenRoot uid root cmn $ do +sshClient uid pgpver root cmn = whenRoot uid root cmn $ do -- /etc/ssh/config/ssh_config <-- 'GlobalKnownHostsFile /var/cache/kiki/ssh_known_hosts' sshconfig <- parseSshConfig . fromMaybe "" <$> maybeReadFile (root "/etc/ssh/ssh_config") let (ps,qs) = sshSplitAtDirective "GlobalKnownHostsFile" sshconfig @@ -122,9 +123,9 @@ sshClient uid root cmn = whenRoot uid root cmn $ do maybe (return ()) (myWriteFile (root "/etc/ssh/ssh_config") . unparseSshConfig) sshconfig' -- /var/cache/kiki/config/ssh_known_hosts <-- contains known hosts from /root/.gnupg/... - Kiki.importAndRefresh root cmn Unencrypted + Kiki.importAndRefresh pgpver root cmn Unencrypted -sshServer uid root cmn = whenRoot uid root cmn $ do +sshServer uid pgpver root cmn = whenRoot uid root cmn $ do sshconfig <- parseSshConfig . fromMaybe "" <$> maybeReadFile (root "/etc/ssh/sshd_config") let p:gs = groupBy (\_ d -> not $ sshIsDirective "HostKey" d) $ ["#"]:sshconfig got = filter (\(d:ds) -> elem "/var/cache/kiki/config/ssh_host_rsa_key" d) gs @@ -135,9 +136,9 @@ sshServer uid root cmn = whenRoot uid root cmn $ do hPutStrLn stderr "adding HostKey directive" myWriteFile (root "/etc/ssh/sshd_config") $ unparseSshConfig sshconfig' -- /etc/ssh/sshd_config <-- 'HostKey /var/cache/kiki/config/ssh_host_ecdsa_key' etc. - Kiki.importAndRefresh root cmn Unencrypted + Kiki.importAndRefresh pgpver root cmn Unencrypted -strongswan uid root cmn = whenRoot uid root cmn $ do +strongswan uid pgpver root cmn = whenRoot uid root cmn $ do -- (1) /etc/ipsec.conf <-- 'include /var/cache/kiki/config/ipsec.conf' -- Parsing as if ssh config, that's not right, but good enough for now. ipsecconf <- parseSshConfig . fromMaybe "" <$> maybeReadFile (root "/etc/ipsec.conf") @@ -161,9 +162,9 @@ strongswan uid root cmn = whenRoot uid root cmn $ do stmt = ["include", " ", "/var/cache/kiki/config/ipsec.secrets"] hPutStrLn stderr "adding include directive" myWriteFile (root "/etc/ipsec.secrets") $ unparseSshConfig ipsecconf' - Kiki.importAndRefresh root cmn Unencrypted + Kiki.importAndRefresh pgpver root cmn Unencrypted -configureTor uid root cmn = whenRoot uid root cmn $ do +configureTor uid pgpver root cmn = whenRoot uid root cmn $ do -- Parsing as if ssh config, that's not right, but good enough for now. torrc <- parseSshConfig . fromMaybe "" <$> maybeReadFile (root "/etc/tor/torrc") let p:gs = groupBy (\_ d -> not $ sshIsDirective "HiddenServiceDir" d) $ ["#"]:torrc @@ -215,11 +216,11 @@ configureTor uid root cmn = whenRoot uid root cmn $ do , ["HiddenServicePort"," ","22"," ","127.0.0.1:22"] , ["HiddenServicePort"," ","25"," ","127.0.0.1:25"] ] myWriteFile (root "/etc/tor/torrc") $ unparseSshConfig torrc' - Kiki.importAndRefresh root cmn Unencrypted + Kiki.importAndRefresh pgpver root cmn Unencrypted return () -configureHosts uid root cmn = whenRoot uid root cmn $ do - Kiki.importAndRefresh root cmn Unencrypted +configureHosts uid pgpver root cmn = whenRoot uid root cmn $ do + Kiki.importAndRefresh pgpver root cmn Unencrypted hosts <- Hosts.decode . fromMaybe "" <$> maybeReadFile (root "/etc/hosts") kikihosts <- Hosts.decode . fromMaybe "" <$> maybeReadFile (root "/var/cache/kiki/config/hosts") let hosts' = hosts `Hosts.plus` kikihosts diff --git a/kiki.hs b/kiki.hs index d4d4084..451552c 100644 --- a/kiki.hs +++ b/kiki.hs @@ -1568,8 +1568,9 @@ kiki "init" args | "--help" `elem` args = do putStr . unlines $ [ "kiki init [ --passphrase-fd=FD" , " | --homedir[=HOMEDIR]" - , " | --chroot=ROOTDIR ]" - , " | --cipher="++intercalate "|" (map ciphername ciphers)++" ] ..." + , " | --chroot=ROOTDIR" + , " | --cipher="++intercalate "|" (map ciphername ciphers) + , " | -(4|5) ] ..." , "" , "Modify your GnuPG keyring and update /var/cache/kiki. The following" , "changes will occur to the keyring:" @@ -1589,10 +1590,16 @@ kiki "init" args | "--help" `elem` args = do , " variable is ignored and you must use --homedir to specify" , " a value other than /root/.gnupg." , "" + , " -4" + , " New PGP key packets should use the v4 (default) format." + , "" + , " -5" + , " New PGP key packets should use the v5 format and use the" + , " SHA256-based v5 fingerprints." , "" ] ++ documentHomeDir ++ [""] ++ documentPassphraseFDFlag True True True -kiki "init" args = run args $ importAndRefresh <$> dashdashChroot <*> dashdashHomedir <*> dashdashCipher +kiki "init" args = run args $ importAndRefresh <$> dashdashPGPVersion <*> dashdashChroot <*> dashdashHomedir <*> dashdashCipher kiki "spawn" args | "--help" `elem` args = putStr . unlines $ [ "kiki spawn [ --passphrase-fd=FD" diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs index 5b51a93..9669430 100644 --- a/lib/KeyRing.hs +++ b/lib/KeyRing.hs @@ -87,8 +87,7 @@ import KeyRing.BuildKeyDB (allNames', Hostnames, readSecretPEMFile, secp256k1_id, selectPublicKey, - usageFromFilter, - preferredPGPVersion) + usageFromFilter) import KeyRing.Types import KeyDB diff --git a/lib/KeyRing/BuildKeyDB.hs b/lib/KeyRing/BuildKeyDB.hs index c2b2703..3993c66 100644 --- a/lib/KeyRing/BuildKeyDB.hs +++ b/lib/KeyRing/BuildKeyDB.hs @@ -79,9 +79,6 @@ import GnuPGAgent import ByteStringUtil import Text.XXD -preferredPGPVersion :: KeyRingOperation -> Word8 -preferredPGPVersion _ = 4 -- TODO: v5 - newtype IPsToWriteToHostsFile = IPsToWriteToHostsFile [SockAddr] -- | buildKeyDB -- diff --git a/lib/KeyRing/Types.hs b/lib/KeyRing/Types.hs index dbcc22c..c272efc 100644 --- a/lib/KeyRing/Types.hs +++ b/lib/KeyRing/Types.hs @@ -32,13 +32,16 @@ data KeyRingOperation = KeyRingOperation -- ^ If provided, this is the directory where the 'HomeSec' and 'HomePub' -- files reside. Otherwise, the evironment variable $GNUPGHOME is consulted -- and if that is not set, it falls back to $HOME/.gnupg. + , preferredPGPVersion :: Word8 + -- ^ Newly created PGP key packets will use this version. It should be set + -- to either 4 or 5. } deriving (Eq,Show) instance Semigroup KeyRingOperation where - KeyRingOperation f p t h <> KeyRingOperation f' p' t' h' = - KeyRingOperation (f <> f') (p <> p') (t <> t') (h <> h') + KeyRingOperation f p t h v <> KeyRingOperation f' p' t' h' v' = + KeyRingOperation (f <> f') (p <> p') (t <> t') (h <> h') (max v v') instance Monoid KeyRingOperation where - mempty = KeyRingOperation Map.empty [] [] Nothing + mempty = KeyRingOperation Map.empty [] [] Nothing 4 data InputFile = HomeSec -- ^ A file named secring.gpg located in the home directory. diff --git a/lib/Kiki.hs b/lib/Kiki.hs index 222c1bb..a0e2d07 100644 --- a/lib/Kiki.hs +++ b/lib/Kiki.hs @@ -152,6 +152,7 @@ minimalOp isHomeless cap = op return $ PassphraseSpec Nothing Nothing pfile , opTransforms = [] , opHome = cap_homespec cap + , preferredPGPVersion = 4 } run :: [String] -> Args (IO ()) -> IO () @@ -203,8 +204,8 @@ peminfo bits usage = StreamInfo , transforms = [] } -importAndRefresh :: (FilePath -> FilePath) -> CommonArgsParsed -> SymmetricAlgorithm -> IO () -importAndRefresh root cmn cipher = do +importAndRefresh :: Word8 -> (FilePath -> FilePath) -> CommonArgsParsed -> SymmetricAlgorithm -> IO () +importAndRefresh pgpver root cmn cipher = do let rootdir = do guard (root "x" /= "x") Just $ root "" me <- getEffectiveUserID @@ -214,7 +215,6 @@ importAndRefresh root cmn cipher = do let homespec = mplus (slash <$> rootdir <*> cap_homespec cmn) (fmap (++"/root/.gnupg") rootdir) passfd = cap_passfd cmn - pgpver = preferredPGPVersion $ minimalOp False cmn (home,secring,pubring,mbwk) <- unconditionally $ getHomeDir homespec osHomeDir <- if bUnprivileged then getHomeDirectory else return "/root" @@ -326,6 +326,7 @@ importAndRefresh root cmn cipher = do return $ PassphraseSpec Nothing Nothing pfd , opHome = homespec , opTransforms = [] + , preferredPGPVersion = pgpver } nop = KeyRingOperation @@ -340,6 +341,7 @@ importAndRefresh root cmn cipher = do return $ PassphraseSpec Nothing Nothing pfd , opHome=homespec , opTransforms = [] + , preferredPGPVersion = pgpver } when bUnprivileged $ do hPutStrLn stderr "Insufficient privilege generating system service keys." @@ -473,6 +475,7 @@ generateHostsFile fw rt = do , opPassphrases = [] , opHome = Just $ takeDirectory (rtPubring rt) , opTransforms = [] + , preferredPGPVersion = 4 -- Does not matter (no fill of pgp files). } KikiResult _ report <- runKeyRing op outputReport report @@ -723,6 +726,12 @@ slash "" ('/':xs) = '/':xs slash "" xs = '/':xs slash (y:ys) xs = y:slash ys xs +dashdashPGPVersion :: Args Word8 +dashdashPGPVersion = liftA2 (\is4 is5 -> if is5 then 5 else if is4 then 4 else defaultV) (flag "-4") (flag "-5") + where + defaultV = 4 -- Use v4 packets by default for now. + + dashdashChroot :: Args (FilePath -> FilePath) dashdashChroot = pure (\r a -> slash r a) <*> arg "--chroot" <|> pure id -- cgit v1.2.3