Commandline option to use v5 key packets.

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 <command> [--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