diff options
author | Andrew Cady <d@jerkface.net> | 2019-07-16 11:41:05 -0400 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2019-07-16 17:52:10 -0400 |
commit | f07d60d9c0ff8673a264e984c90bc478987ef873 (patch) | |
tree | 2a8d0b7bbffd80f26cf439f514edf9133045f3f2 | |
parent | 0110bd961c87e1ca47e649519933b490ec38fd2d (diff) |
use all names where previously only ".onion" names were used
-rw-r--r-- | lib/KeyRing.hs | 15 | ||||
-rw-r--r-- | lib/KeyRing/BuildKeyDB.hs | 12 | ||||
-rw-r--r-- | 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 | |||
68 | import FunctorToMaybe | 68 | import FunctorToMaybe |
69 | import DotLock | 69 | import DotLock |
70 | import ProcessUtils (systemEnv, ExitCode(ExitFailure, ExitSuccess) ) | 70 | import ProcessUtils (systemEnv, ExitCode(ExitFailure, ExitSuccess) ) |
71 | import KeyRing.BuildKeyDB (Hostnames(..), | 71 | import KeyRing.BuildKeyDB (allNames', Hostnames, |
72 | IPsToWriteToHostsFile(..), | 72 | IPsToWriteToHostsFile(..), |
73 | buildKeyDB, | 73 | buildKeyDB, |
74 | combineTransforms, | 74 | combineTransforms, |
@@ -532,11 +532,7 @@ writeHostsFiles krd ctx (hostdbs0,hostdbs,u1,gpgnames,IPsToWriteToHostsFile outg | |||
532 | 532 | ||
533 | -- 3. add hostnames from gpg for addresses not in U | 533 | -- 3. add hostnames from gpg for addresses not in U |
534 | let u = foldl' f u1 ans | 534 | let u = foldl' f u1 ans |
535 | ans = reverse $ do | 535 | ans = reverse . filter ((`elem` outgoing_names) . fst) . concat $ allNames' <$> gpgnames |
536 | Hostnames addr _ ns _ <- gpgnames | ||
537 | guard $ addr `elem` outgoing_names -- . null $ Hosts.namesForAddress addr u0 | ||
538 | n <- ns | ||
539 | return (addr,n) | ||
540 | f h (addr,n) = Hosts.assignNewName addr n h | 536 | f h (addr,n) = Hosts.assignNewName addr n h |
541 | 537 | ||
542 | -- 4. for each host db H, union H with U and write it out as H' | 538 | -- 4. for each host db H, union H with U and write it out as H' |
@@ -1202,10 +1198,3 @@ getHomeDir protohome = do | |||
1202 | where topair (x:xs) = (x,xs) | 1198 | where topair (x:xs) = (x,xs) |
1203 | return $ lookup "default-key" config >>= listToMaybe | 1199 | return $ lookup "default-key" config >>= listToMaybe |
1204 | 1200 | ||
1205 | {- | ||
1206 | onionName :: KeyData -> (SockAddr,L.ByteString) | ||
1207 | onionName kd = (addr,name) | ||
1208 | where | ||
1209 | (addr,(name:_,_)) = getHostnames kd | ||
1210 | -} | ||
1211 | |||
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 @@ | |||
2 | {-# LANGUAGE DoAndIfThenElse #-} | 2 | {-# LANGUAGE DoAndIfThenElse #-} |
3 | {-# LANGUAGE ForeignFunctionInterface #-} | 3 | {-# LANGUAGE ForeignFunctionInterface #-} |
4 | {-# LANGUAGE LambdaCase #-} | 4 | {-# LANGUAGE LambdaCase #-} |
5 | {-# LANGUAGE NamedFieldPuns #-} | ||
5 | {-# LANGUAGE OverloadedStrings #-} | 6 | {-# LANGUAGE OverloadedStrings #-} |
6 | {-# LANGUAGE PatternGuards #-} | 7 | {-# LANGUAGE PatternGuards #-} |
7 | {-# LANGUAGE TupleSections #-} | 8 | {-# LANGUAGE TupleSections #-} |
@@ -550,10 +551,7 @@ mergeHostFiles krd db ctx = do | |||
550 | hostdbs0 <- mapM (fmap Hosts.decode . readInputFileL' ctx) hns | 551 | hostdbs0 <- mapM (fmap Hosts.decode . readInputFileL' ctx) hns |
551 | 552 | ||
552 | let gpgnames = map getHostnames $ keyData db | 553 | let gpgnames = map getHostnames $ keyData db |
553 | os = do | 554 | os = concat $ allNames' <$> gpgnames |
554 | Hostnames addr ns _ _ <- gpgnames | ||
555 | n <- ns | ||
556 | return (addr,n) | ||
557 | setOnions hosts = foldl' (flip $ uncurry Hosts.assignName) hosts os | 555 | setOnions hosts = foldl' (flip $ uncurry Hosts.assignName) hosts os |
558 | -- we ensure .onion names are set properly | 556 | -- we ensure .onion names are set properly |
559 | hostdbs = map setOnions hostdbs0 | 557 | hostdbs = map setOnions hostdbs0 |
@@ -864,6 +862,12 @@ generateSubkey transcode kd' (genparam,StreamInfo { spill = KF_Match tag }) = do | |||
864 | return $ KikiSuccess (kd,report0) | 862 | return $ KikiSuccess (kd,report0) |
865 | generateSubkey _ kd _ = return kd | 863 | generateSubkey _ kd _ = return kd |
866 | 864 | ||
865 | allNames :: Hostnames -> [Char8.ByteString] | ||
866 | allNames (Hostnames _ ns os cs) = ns ++ os ++ (maybe [] return cs) | ||
867 | |||
868 | allNames' :: Hostnames -> [(SockAddr, Char8.ByteString)] | ||
869 | allNames' h@Hostnames{gpgipv6addr} = (gpgipv6addr,) <$> allNames h | ||
870 | |||
867 | data Hostnames = Hostnames { | 871 | data Hostnames = Hostnames { |
868 | gpgipv6addr :: SockAddr, | 872 | gpgipv6addr :: SockAddr, |
869 | verifiedOnionNames :: [L.ByteString], | 873 | 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 | |||
49 | import GnuPGAgent (Query (..)) | 49 | import GnuPGAgent (Query (..)) |
50 | import KeyRing hiding (pemFromPacket) | 50 | import KeyRing hiding (pemFromPacket) |
51 | import KeyDB | 51 | import KeyDB |
52 | import KeyRing.BuildKeyDB (gpgipv6addr, Hostnames, allNames) | ||
52 | 53 | ||
53 | withAgent :: [PassphraseSpec] -> [PassphraseSpec] | 54 | withAgent :: [PassphraseSpec] -> [PassphraseSpec] |
54 | withAgent [] = [PassphraseAgent] | 55 | withAgent [] = [PassphraseAgent] |
@@ -448,9 +449,6 @@ generateHostsFile fw rt = do | |||
448 | KikiResult _ report <- runKeyRing op | 449 | KikiResult _ report <- runKeyRing op |
449 | outputReport report | 450 | outputReport report |
450 | 451 | ||
451 | allNames :: Hostnames -> [Char8.ByteString] | ||
452 | allNames (Hostnames _ ns os cs) = ns ++ os ++ (maybe [] return cs) | ||
453 | |||
454 | getSshKnownHosts :: Peer -> Char8.ByteString | 452 | getSshKnownHosts :: Peer -> Char8.ByteString |
455 | getSshKnownHosts peer@Peer{kd} = Char8.unlines taggedblobs | 453 | getSshKnownHosts peer@Peer{kd} = Char8.unlines taggedblobs |
456 | where | 454 | where |
@@ -496,7 +494,7 @@ installIpsecConf fw MyIdentity{myGpgAddress} cs = do | |||
496 | getMyIdentity :: KeyRingRuntime -> Maybe MyIdentity | 494 | getMyIdentity :: KeyRingRuntime -> Maybe MyIdentity |
497 | getMyIdentity rt = do | 495 | getMyIdentity rt = do |
498 | wk <- rtWorkingKey rt | 496 | wk <- rtWorkingKey rt |
499 | Hostnames wkaddr _ _ _ <- getHostnames <$> lookupKeyData (keykey wk) (rtKeyDB rt) | 497 | wkaddr <- gpgipv6addr . getHostnames <$> lookupKeyData (keykey wk) (rtKeyDB rt) |
500 | return $ MyIdentity wkaddr (show $ fingerprint wk) | 498 | return $ MyIdentity wkaddr (show $ fingerprint wk) |
501 | 499 | ||
502 | refreshCache :: KeyRingRuntime -> Maybe FilePath -> IO () | 500 | refreshCache :: KeyRingRuntime -> Maybe FilePath -> IO () |