summaryrefslogtreecommitdiff
path: root/lib/Kiki.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Kiki.hs')
-rw-r--r--lib/Kiki.hs11
1 files changed, 8 insertions, 3 deletions
diff --git a/lib/Kiki.hs b/lib/Kiki.hs
index 80f79b3..9832ef9 100644
--- a/lib/Kiki.hs
+++ b/lib/Kiki.hs
@@ -336,7 +336,7 @@ importAndRefresh root cmn cipher = do
336 336
337data Peer = 337data Peer =
338 Peer 338 Peer
339 { peerContactName :: UidHostname 339 { peerContactName :: ()
340 , peerHostnames :: Hostnames 340 , peerHostnames :: Hostnames
341 , addr :: SockAddr 341 , addr :: SockAddr
342 , kd :: KeyData 342 , kd :: KeyData
@@ -458,6 +458,9 @@ generateHostsFile fw rt = do
458 KikiResult _ report <- runKeyRing op 458 KikiResult _ report <- runKeyRing op
459 outputReport report 459 outputReport report
460 460
461allNames :: Hostnames -> [Char8.ByteString]
462allNames (Hostnames _ ns os cs) = ns ++ os ++ (maybe [] return cs)
463
461getSshKnownHosts :: Peer -> Char8.ByteString 464getSshKnownHosts :: Peer -> Char8.ByteString
462getSshKnownHosts peer@Peer{kd} = Char8.unlines taggedblobs 465getSshKnownHosts peer@Peer{kd} = Char8.unlines taggedblobs
463 where 466 where
@@ -465,7 +468,9 @@ getSshKnownHosts peer@Peer{kd} = Char8.unlines taggedblobs
465 sshs :: [Packet] 468 sshs :: [Packet]
466 sshs = sortOn (Down . timestamp) $ getSubkeys CrossSigned their_master (keySubKeys $ kd) "ssh-server" 469 sshs = sortOn (Down . timestamp) $ getSubkeys CrossSigned their_master (keySubKeys $ kd) "ssh-server"
467 blobs = mapMaybe sshblobFromPacketL sshs 470 blobs = mapMaybe sshblobFromPacketL sshs
468 taggedblobs = map ((coerce (peerContactName peer) <> " ") <>) blobs 471 taggedblobs = do
472 n <- allNames $ peerHostnames peer
473 map ((coerce n <> " ") <>) blobs
469 474
470data MyIdentity = MyIdentity { 475data MyIdentity = MyIdentity {
471 myGpgAddress :: SockAddr, 476 myGpgAddress :: SockAddr,
@@ -558,7 +563,7 @@ chooseOneName _ = Nothing
558listPeers :: KeyRingRuntime -> [Peer] 563listPeers :: KeyRingRuntime -> [Peer]
559listPeers rt = map conv . filter notme . mapMaybe namedContact . Map.elems . byKeyKey . rtKeyDB $ rt 564listPeers rt = map conv . filter notme . mapMaybe namedContact . Map.elems . byKeyKey . rtKeyDB $ rt
560 where 565 where
561 conv = \(a,b,c,d) -> Peer a b c d 566 conv = \(a,b,c,d) -> Peer () b c d
562 kk = keykey (fromJust $ rtWorkingKey rt) 567 kk = keykey (fromJust $ rtWorkingKey rt)
563 notme (_,_,_,kd) = keykey (keyPacket kd) /= kk 568 notme (_,_,_,kd) = keykey (keyPacket kd) /= kk
564 namedContact kd = do 569 namedContact kd = do