From 9cc0b24375b6b40eb7c3412983e75b6e3fe3a3f6 Mon Sep 17 00:00:00 2001
From: Joe Crayne <joe@jerkface.net>
Date: Tue, 19 May 2020 17:40:39 -0400
Subject: Commandline option to use v5 key packets.

---
 lib/KeyRing.hs            |  3 +--
 lib/KeyRing/BuildKeyDB.hs |  3 ---
 lib/KeyRing/Types.hs      |  9 ++++++---
 lib/Kiki.hs               | 15 ++++++++++++---
 4 files changed, 19 insertions(+), 11 deletions(-)

(limited to 'lib')

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