diff options
author | Andrew Cady <d@jerkface.net> | 2019-07-07 15:11:08 -0400 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2019-07-07 15:11:08 -0400 |
commit | d644dd0595949d5388bf4bb2dcfc1d5fa29f5f17 (patch) | |
tree | bc0836c1f03e4c18c3b80f1306026d16d6575374 /lib | |
parent | b7da6a23a4ae94e8ce376376df77401ee779f028 (diff) |
use a type for the return value of getHostnames
Diffstat (limited to 'lib')
-rw-r--r-- | lib/KeyRing.hs | 4 | ||||
-rw-r--r-- | lib/KeyRing/BuildKeyDB.hs | 23 | ||||
-rw-r--r-- | lib/Kiki.hs | 6 |
3 files changed, 21 insertions, 12 deletions
diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs index 5cdb30c..8b041f1 100644 --- a/lib/KeyRing.hs +++ b/lib/KeyRing.hs | |||
@@ -582,7 +582,7 @@ writeHostsFiles | |||
582 | -> ([Hosts.Hosts], | 582 | -> ([Hosts.Hosts], |
583 | [Hosts.Hosts], | 583 | [Hosts.Hosts], |
584 | Hosts.Hosts, | 584 | Hosts.Hosts, |
585 | [(SockAddr, (t1, [Char8.ByteString]))], | 585 | [Hostnames], |
586 | [SockAddr]) | 586 | [SockAddr]) |
587 | -> IO [(FilePath, KikiReportAction)] | 587 | -> IO [(FilePath, KikiReportAction)] |
588 | writeHostsFiles krd ctx (hostdbs0,hostdbs,u1,gpgnames,outgoing_names) = do | 588 | writeHostsFiles krd ctx (hostdbs0,hostdbs,u1,gpgnames,outgoing_names) = do |
@@ -598,7 +598,7 @@ writeHostsFiles krd ctx (hostdbs0,hostdbs,u1,gpgnames,outgoing_names) = do | |||
598 | -- 3. add hostnames from gpg for addresses not in U | 598 | -- 3. add hostnames from gpg for addresses not in U |
599 | let u = foldl' f u1 ans | 599 | let u = foldl' f u1 ans |
600 | ans = reverse $ do | 600 | ans = reverse $ do |
601 | (addr,(_,ns)) <- gpgnames | 601 | Hostnames addr _ ns _ <- gpgnames |
602 | guard $ addr `elem` outgoing_names -- . null $ Hosts.namesForAddress addr u0 | 602 | guard $ addr `elem` outgoing_names -- . null $ Hosts.namesForAddress addr u0 |
603 | n <- ns | 603 | n <- ns |
604 | return (addr,n) | 604 | return (addr,n) |
diff --git a/lib/KeyRing/BuildKeyDB.hs b/lib/KeyRing/BuildKeyDB.hs index 9a806a3..f90f638 100644 --- a/lib/KeyRing/BuildKeyDB.hs +++ b/lib/KeyRing/BuildKeyDB.hs | |||
@@ -132,7 +132,7 @@ buildKeyDB :: InputFileContext -> Maybe String -> KeyRingOperation | |||
132 | ,{- hs -} ({- hostdbs0 -}[Hosts.Hosts], | 132 | ,{- hs -} ({- hostdbs0 -}[Hosts.Hosts], |
133 | {- hostdbs -}[Hosts.Hosts], | 133 | {- hostdbs -}[Hosts.Hosts], |
134 | {- u1 -}Hosts.Hosts, | 134 | {- u1 -}Hosts.Hosts, |
135 | {- gpgnames -}[(SockAddr, ([ByteString],[ByteString]))], | 135 | {- gpgnames -}[Hostnames], |
136 | {- outgoing_names -}[SockAddr]) | 136 | {- outgoing_names -}[SockAddr]) |
137 | ,{- accs -} Map.Map InputFile Access | 137 | ,{- accs -} Map.Map InputFile Access |
138 | ,{- transcode -} PacketTranscoder | 138 | ,{- transcode -} PacketTranscoder |
@@ -564,7 +564,7 @@ mergeHostFiles :: KeyRingOperation -> KeyDB -> InputFileContext | |||
564 | , ( [Hosts.Hosts] | 564 | , ( [Hosts.Hosts] |
565 | , [Hosts.Hosts] | 565 | , [Hosts.Hosts] |
566 | , Hosts.Hosts | 566 | , Hosts.Hosts |
567 | , [(SockAddr, ([Char8.ByteString], [Char8.ByteString]))] | 567 | , [Hostnames] |
568 | , [SockAddr])) | 568 | , [SockAddr])) |
569 | , [(FilePath,KikiReportAction)])) | 569 | , [(FilePath,KikiReportAction)])) |
570 | mergeHostFiles krd db ctx = do | 570 | mergeHostFiles krd db ctx = do |
@@ -586,14 +586,14 @@ mergeHostFiles krd db ctx = do | |||
586 | 586 | ||
587 | let gpgnames = map getHostnames $ Map.elems db | 587 | let gpgnames = map getHostnames $ Map.elems db |
588 | os = do | 588 | os = do |
589 | (addr,(ns,_)) <- gpgnames | 589 | Hostnames addr ns _ _ <- gpgnames |
590 | n <- ns | 590 | n <- ns |
591 | return (addr,n) | 591 | return (addr,n) |
592 | setOnions hosts = foldl' (flip $ uncurry Hosts.assignName) hosts os | 592 | setOnions hosts = foldl' (flip $ uncurry Hosts.assignName) hosts os |
593 | -- we ensure .onion names are set properly | 593 | -- we ensure .onion names are set properly |
594 | hostdbs = map setOnions hostdbs0 | 594 | hostdbs = map setOnions hostdbs0 |
595 | outgoing_names = do | 595 | outgoing_names = do |
596 | (addr,(_,gns)) <- gpgnames | 596 | Hostnames addr _ gns _ <- gpgnames |
597 | guard . not $ null gns | 597 | guard . not $ null gns |
598 | guard $ all (null . Hosts.namesForAddress addr) hostdbs0 | 598 | guard $ all (null . Hosts.namesForAddress addr) hostdbs0 |
599 | return addr | 599 | return addr |
@@ -902,13 +902,20 @@ generateSubkey transcode kd' (genparam,StreamInfo { spill = KF_Match tag }) = do | |||
902 | return $ KikiSuccess (kd,report0) | 902 | return $ KikiSuccess (kd,report0) |
903 | generateSubkey _ kd _ = return kd | 903 | generateSubkey _ kd _ = return kd |
904 | 904 | ||
905 | data Hostnames = Hostnames { | ||
906 | gpgipv6addr :: SockAddr, | ||
907 | verifiedOnionNames :: [L.ByteString], | ||
908 | notationPacketNames :: [L.ByteString], | ||
909 | cryptonomicName :: Maybe L.ByteString | ||
910 | } | ||
911 | |||
905 | -- | | 912 | -- | |
906 | -- Returns (ip6 fingerprint address,(onion names,other host names)) | 913 | -- Returns (ip6 fingerprint address,(onion names,other host names)) |
907 | -- | 914 | -- |
908 | -- Requires a validly cross-signed tor key for each onion name returned. | 915 | -- Requires a validly cross-signed tor key for each onion name returned. |
909 | -- (Signature checks are performed.) | 916 | -- (Signature checks are performed.) |
910 | getHostnames :: KeyData -> (SockAddr, ([L.ByteString],[L.ByteString])) | 917 | getHostnames :: KeyData -> Hostnames |
911 | getHostnames (KeyData topmp _ uids subs) = (addr,(onames,othernames)) | 918 | getHostnames (KeyData topmp _ uids subs) = Hostnames addr onames othernames Nothing |
912 | where | 919 | where |
913 | othernames = do | 920 | othernames = do |
914 | mp <- flattenAllUids "" True uids | 921 | mp <- flattenAllUids "" True uids |
@@ -966,7 +973,9 @@ setHostnames pred hosts kd@(KeyData topmp topsigs uids subs) = | |||
966 | addr = fingerdress topk | 973 | addr = fingerdress topk |
967 | names :: [Char8.ByteString] | 974 | names :: [Char8.ByteString] |
968 | names = Hosts.namesForAddress addr hosts | 975 | names = Hosts.namesForAddress addr hosts |
969 | (_, (gotOnions, gotNonOnions)) = getHostnames kd | 976 | |
977 | Hostnames _ gotOnions gotNonOnions cryptonomic = getHostnames kd | ||
978 | |||
970 | namesWithoutGotOnions = names \\ gotOnions | 979 | namesWithoutGotOnions = names \\ gotOnions |
971 | notations = map (NotationDataPacket True "hostname@" . Char8.unpack) namesWithoutGotOnions | 980 | notations = map (NotationDataPacket True "hostname@" . Char8.unpack) namesWithoutGotOnions |
972 | isName (NotationDataPacket True "hostname@" _) = True | 981 | isName (NotationDataPacket True "hostname@" _) = True |
diff --git a/lib/Kiki.hs b/lib/Kiki.hs index ca6e80f..8ceda99 100644 --- a/lib/Kiki.hs +++ b/lib/Kiki.hs | |||
@@ -431,7 +431,7 @@ generateHostsFile mkpath rt = do | |||
431 | KikiResult _ report <- runKeyRing op | 431 | KikiResult _ report <- runKeyRing op |
432 | outputReport report | 432 | outputReport report |
433 | 433 | ||
434 | names :: KeyRingRuntime -> Maybe (SockAddr, ([Char8.ByteString], [Char8.ByteString])) | 434 | names :: KeyRingRuntime -> Maybe Hostnames |
435 | names rt = do wk <- rtWorkingKey rt | 435 | names rt = do wk <- rtWorkingKey rt |
436 | -- XXX unnecessary signature check | 436 | -- XXX unnecessary signature check |
437 | return $ getHostnames (rtKeyDB rt Map.! keykey wk) | 437 | return $ getHostnames (rtKeyDB rt Map.! keykey wk) |
@@ -478,7 +478,7 @@ refreshCache rt rootdir = do | |||
478 | (mkpath, commit) <- getMkPathAndCommit (fromMaybe "" rootdir ++ "/var/cache/kiki/config") | 478 | (mkpath, commit) <- getMkPathAndCommit (fromMaybe "" rootdir ++ "/var/cache/kiki/config") |
479 | generateHostsFile mkpath rt | 479 | generateHostsFile mkpath rt |
480 | fromMaybe (error "No working key.") $ do | 480 | fromMaybe (error "No working key.") $ do |
481 | (wkaddr,(onames,_)) <- names rt | 481 | Hostnames wkaddr onames _ _ <- names rt |
482 | Just $ do | 482 | Just $ do |
483 | let oname = Char8.concat $ take 1 onames | 483 | let oname = Char8.concat $ take 1 onames |
484 | bUnprivileged = False -- TODO | 484 | bUnprivileged = False -- TODO |
@@ -535,7 +535,7 @@ writePublicKeyFiles rt mkpath grip oname wkaddr commit = do | |||
535 | namedContact kd = do | 535 | namedContact kd = do |
536 | -- The getHostnames command requires a valid cross-signed tor key | 536 | -- The getHostnames command requires a valid cross-signed tor key |
537 | -- for each onion name returned in (_,(ns,_)). | 537 | -- for each onion name returned in (_,(ns,_)). |
538 | let (addr,(ns,_)) = getHostnames kd | 538 | let Hostnames addr ns _ _ = getHostnames kd |
539 | fmap (\n -> (n,addr, kd)) $ listToMaybe ns -- only first onion name. | 539 | fmap (\n -> (n,addr, kd)) $ listToMaybe ns -- only first onion name. |
540 | 540 | ||
541 | known_hosts = L.concat $ map getssh onionkeys | 541 | known_hosts = L.concat $ map getssh onionkeys |