From f07d60d9c0ff8673a264e984c90bc478987ef873 Mon Sep 17 00:00:00 2001
From: Andrew Cady <d@jerkface.net>
Date: Tue, 16 Jul 2019 11:41:05 -0400
Subject: use all names where previously only ".onion" names were used

---
 lib/KeyRing.hs            | 15 ++-------------
 lib/KeyRing/BuildKeyDB.hs | 12 ++++++++----
 lib/Kiki.hs               |  6 ++----
 3 files changed, 12 insertions(+), 21 deletions(-)

diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs
index 3da3565..cd69042 100644
--- a/lib/KeyRing.hs
+++ b/lib/KeyRing.hs
@@ -68,7 +68,7 @@ import Base58
 import FunctorToMaybe
 import DotLock
 import ProcessUtils (systemEnv, ExitCode(ExitFailure, ExitSuccess) )
-import           KeyRing.BuildKeyDB          (Hostnames(..),
+import           KeyRing.BuildKeyDB          (allNames', Hostnames,
                                               IPsToWriteToHostsFile(..),
                                               buildKeyDB,
                                               combineTransforms,
@@ -532,11 +532,7 @@ writeHostsFiles krd ctx (hostdbs0,hostdbs,u1,gpgnames,IPsToWriteToHostsFile outg
 
     -- 3. add hostnames from gpg for addresses not in U
     let u = foldl' f u1 ans
-        ans = reverse $ do
-            Hostnames addr _ ns _ <- gpgnames
-            guard $ addr `elem` outgoing_names -- . null $ Hosts.namesForAddress addr u0
-            n <- ns
-            return (addr,n)
+        ans = reverse . filter ((`elem` outgoing_names) . fst) . concat $ allNames' <$> gpgnames
         f h (addr,n) = Hosts.assignNewName addr n h
 
     -- 4. for each host db H, union H with U and write it out as H'
@@ -1202,10 +1198,3 @@ getHomeDir protohome = do
                         where topair (x:xs) = (x,xs)
         return $ lookup "default-key" config >>= listToMaybe
 
-{-
-onionName :: KeyData -> (SockAddr,L.ByteString)
-onionName kd = (addr,name)
- where
-    (addr,(name:_,_)) = getHostnames kd
--}
-
diff --git a/lib/KeyRing/BuildKeyDB.hs b/lib/KeyRing/BuildKeyDB.hs
index 587d812..90f7292 100644
--- a/lib/KeyRing/BuildKeyDB.hs
+++ b/lib/KeyRing/BuildKeyDB.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE DoAndIfThenElse          #-}
 {-# LANGUAGE ForeignFunctionInterface #-}
 {-# LANGUAGE LambdaCase               #-}
+{-# LANGUAGE NamedFieldPuns           #-}
 {-# LANGUAGE OverloadedStrings        #-}
 {-# LANGUAGE PatternGuards            #-}
 {-# LANGUAGE TupleSections            #-}
@@ -550,10 +551,7 @@ mergeHostFiles krd db ctx = do
     hostdbs0 <- mapM (fmap Hosts.decode . readInputFileL' ctx) hns
 
     let gpgnames = map getHostnames $ keyData db
-        os = do
-            Hostnames addr ns _ _ <- gpgnames
-            n <- ns
-            return (addr,n)
+        os = concat $ allNames' <$> gpgnames
         setOnions hosts = foldl' (flip $ uncurry Hosts.assignName) hosts os
         -- we ensure .onion names are set properly
         hostdbs = map setOnions hostdbs0
@@ -864,6 +862,12 @@ generateSubkey transcode kd' (genparam,StreamInfo { spill = KF_Match tag }) = do
         return $ KikiSuccess (kd,report0)
 generateSubkey _ kd _ = return kd
 
+allNames :: Hostnames -> [Char8.ByteString]
+allNames (Hostnames _ ns os cs) = ns ++ os ++ (maybe [] return cs)
+
+allNames' :: Hostnames -> [(SockAddr, Char8.ByteString)]
+allNames' h@Hostnames{gpgipv6addr} = (gpgipv6addr,) <$> allNames h
+
 data Hostnames = Hostnames {
   gpgipv6addr :: SockAddr,
   verifiedOnionNames :: [L.ByteString],
diff --git a/lib/Kiki.hs b/lib/Kiki.hs
index 64dc2bd..7825c85 100644
--- a/lib/Kiki.hs
+++ b/lib/Kiki.hs
@@ -49,6 +49,7 @@ import           DotLock
 import           GnuPGAgent                 (Query (..))
 import           KeyRing hiding (pemFromPacket)
 import           KeyDB
+import           KeyRing.BuildKeyDB (gpgipv6addr, Hostnames, allNames)
 
 withAgent :: [PassphraseSpec] -> [PassphraseSpec]
 withAgent [] = [PassphraseAgent]
@@ -448,9 +449,6 @@ generateHostsFile fw rt      = do
     KikiResult _ report <- runKeyRing op
     outputReport report
 
-allNames :: Hostnames -> [Char8.ByteString]
-allNames (Hostnames _ ns os cs) = ns ++ os ++ (maybe [] return cs)
-
 getSshKnownHosts :: Peer -> Char8.ByteString
 getSshKnownHosts peer@Peer{kd} = Char8.unlines taggedblobs
   where
@@ -496,7 +494,7 @@ installIpsecConf fw MyIdentity{myGpgAddress} cs = do
 getMyIdentity :: KeyRingRuntime -> Maybe MyIdentity
 getMyIdentity rt = do
     wk <- rtWorkingKey rt
-    Hostnames wkaddr _ _ _ <- getHostnames <$> lookupKeyData (keykey wk) (rtKeyDB rt)
+    wkaddr <- gpgipv6addr . getHostnames <$> lookupKeyData (keykey wk) (rtKeyDB rt)
     return $ MyIdentity wkaddr (show $ fingerprint wk)
 
 refreshCache :: KeyRingRuntime -> Maybe FilePath -> IO ()
-- 
cgit v1.2.3