diff options
-rw-r--r-- | kiki.hs | 13 | ||||
-rw-r--r-- | lib/KeyRing.hs | 4 | ||||
-rw-r--r-- | lib/KeyRing/BuildKeyDB.hs | 23 | ||||
-rw-r--r-- | lib/Kiki.hs | 6 |
4 files changed, 30 insertions, 16 deletions
@@ -1665,7 +1665,7 @@ tarContent rt spec pubpem knownhosts secpem = ipsecs ++ sshs ++ secrets "root" | |||
1665 | ipsecs = do | 1665 | ipsecs = do |
1666 | (kk,ipsec,sigs) <- selectPublicKeyAndSigs (KeyUidMatch "",Just "ipsec") (rtKeyDB rt) | 1666 | (kk,ipsec,sigs) <- selectPublicKeyAndSigs (KeyUidMatch "",Just "ipsec") (rtKeyDB rt) |
1667 | let kd = (rtKeyDB rt Map.! kk) | 1667 | let kd = (rtKeyDB rt Map.! kk) |
1668 | (addr,(onames,ns)) = getHostnames kd | 1668 | Hostnames addr onames ns _ = getHostnames kd |
1669 | oname <- onames | 1669 | oname <- onames |
1670 | return ("etc/ipsec.d/certs/" ++ Char8.unpack oname ++ ".pem", pubpem ns addr ipsec sigs) | 1670 | return ("etc/ipsec.d/certs/" ++ Char8.unpack oname ++ ".pem", pubpem ns addr ipsec sigs) |
1671 | 1671 | ||
@@ -1698,10 +1698,15 @@ tarContent rt spec pubpem knownhosts secpem = ipsecs ++ sshs ++ secrets "root" | |||
1698 | sshsvr = spem (dir "etc/ssh/ssh_host_rsa_key") <$> lookupSecret "ssh-host" kd | 1698 | sshsvr = spem (dir "etc/ssh/ssh_host_rsa_key") <$> lookupSecret "ssh-host" kd |
1699 | ipseckey = do | 1699 | ipseckey = do |
1700 | k <- lookupSecret "ipsec" kd | 1700 | k <- lookupSecret "ipsec" kd |
1701 | oname <- fst . snd $ getHostnames kd | 1701 | keyName <- ipsecKeyNames (getHostnames kd) |
1702 | return $ spem (dir $ "etc/ipsec.d/private/"++Char8.unpack oname++".pem") k | 1702 | return $ spem (dir $ keyName) k |
1703 | torkey ++ sshcli ++ sshsvr ++ ipseckey | 1703 | torkey ++ sshcli ++ sshsvr ++ ipseckey |
1704 | 1704 | ||
1705 | ipsecKeyNames :: Hostnames -> [String] | ||
1706 | ipsecKeyNames (Hostnames _ onames _ _) = do | ||
1707 | oname <- Char8.unpack <$> onames | ||
1708 | return $ "etc/ipsec.d/private/"++oname++".pem" | ||
1709 | |||
1705 | tarT :: ([[String]],Map.Map String [String]) -> IO () | 1710 | tarT :: ([[String]],Map.Map String [String]) -> IO () |
1706 | tarT (sargs,margs) = do | 1711 | tarT (sargs,margs) = do |
1707 | KikiResult rt report <- runKeyRing $ minimalOp $ parseCommonArgs margs | 1712 | KikiResult rt report <- runKeyRing $ minimalOp $ parseCommonArgs margs |
@@ -1747,7 +1752,7 @@ tarC (sargs,margs) = do | |||
1747 | knownhost (kk,hostkey,sigs) = Char8.intercalate "," ns <> " " <> Char8.pack (sshblobFromPacket hostkey) | 1752 | knownhost (kk,hostkey,sigs) = Char8.intercalate "," ns <> " " <> Char8.pack (sshblobFromPacket hostkey) |
1748 | where | 1753 | where |
1749 | ns = onames ++ others | 1754 | ns = onames ++ others |
1750 | (_,(onames,others)) = getHostnames $ rtKeyDB rt Map.! kk | 1755 | Hostnames _ onames others _ = getHostnames $ rtKeyDB rt Map.! kk |
1751 | 1756 | ||
1752 | build_secret :: Num t => KeyRingRuntime -> Packet -> (t, Either (IO (Maybe Char8.ByteString)) b) | 1757 | build_secret :: Num t => KeyRingRuntime -> Packet -> (t, Either (IO (Maybe Char8.ByteString)) b) |
1753 | build_secret rt k = ( fromIntegral $ timestamp k | 1758 | build_secret rt k = ( fromIntegral $ timestamp k |
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 |