summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/KeyRing/BuildKeyDB.hs22
1 files changed, 13 insertions, 9 deletions
diff --git a/lib/KeyRing/BuildKeyDB.hs b/lib/KeyRing/BuildKeyDB.hs
index 5e90655..2074ce3 100644
--- a/lib/KeyRing/BuildKeyDB.hs
+++ b/lib/KeyRing/BuildKeyDB.hs
@@ -525,6 +525,14 @@ parseSpec grip spec = (topspec,subspec)
525 unprefix c spec = if null (snd p) then swap p else (fst p, tail (snd p)) 525 unprefix c spec = if null (snd p) then swap p else (fst p, tail (snd p))
526 where p = break (==c) spec 526 where p = break (==c) spec
527-} 527-}
528outgoing_names :: KeyDB -> [Hosts.Hosts] -> IPsToWriteToHostsFile
529outgoing_names db hostdbs0 = IPsToWriteToHostsFile $ do
530 Hostnames addr _ gns _ <- gpgnames
531 guard . not $ null gns
532 guard $ all (null . Hosts.namesForAddress addr) hostdbs0
533 return addr
534 where
535 gpgnames = map getHostnames $ Map.elems db
528 536
529filterMatches :: KeySpec -> [(KeyKey,KeyData)] -> [(KeyKey,KeyData)] 537filterMatches :: KeySpec -> [(KeyKey,KeyData)] -> [(KeyKey,KeyData)]
530filterMatches spec ks = filter (matchSpec spec . snd) ks 538filterMatches spec ks = filter (matchSpec spec . snd) ks
@@ -593,11 +601,7 @@ mergeHostFiles krd db ctx = do
593 setOnions hosts = foldl' (flip $ uncurry Hosts.assignName) hosts os 601 setOnions hosts = foldl' (flip $ uncurry Hosts.assignName) hosts os
594 -- we ensure .onion names are set properly 602 -- we ensure .onion names are set properly
595 hostdbs = map setOnions hostdbs0 603 hostdbs = map setOnions hostdbs0
596 outgoing_names = do 604 addrs = outgoing_names db hostdbs0
597 Hostnames addr _ gns _ <- gpgnames
598 guard . not $ null gns
599 guard $ all (null . Hosts.namesForAddress addr) hostdbs0
600 return addr
601 -- putStrLn $ "hostdbs = " ++ show hostdbs 605 -- putStrLn $ "hostdbs = " ++ show hostdbs
602 606
603 -- 1. let U = union all the host dbs 607 -- 1. let U = union all the host dbs
@@ -618,9 +622,9 @@ mergeHostFiles krd db ctx = do
618 622
619 -- 2. replace gpg annotations with those in U 623 -- 2. replace gpg annotations with those in U
620 -- forM use_db 624 -- forM use_db
621 db' <- Traversable.mapM (setHostnames outgoing_names u1) db 625 db' <- Traversable.mapM (setHostnames addrs u1) db
622 626
623 return $ KikiSuccess ((db',(hostdbs0,hostdbs,u1,gpgnames,IPsToWriteToHostsFile outgoing_names)),[]) 627 return $ KikiSuccess ((db',(hostdbs0,hostdbs,u1,gpgnames,addrs)),[])
624 628
625readInputFileL :: InputFileContext -> InputFile -> IO L.ByteString 629readInputFileL :: InputFileContext -> InputFile -> IO L.ByteString
626readInputFileL ctx (Pipe fd _) = fdToHandle fd >>= L.hGetContents 630readInputFileL ctx (Pipe fd _) = fdToHandle fd >>= L.hGetContents
@@ -948,8 +952,8 @@ hasFingerDress db addr = pre=="fd" && isJust (selectPublicKey (KeyGrip g',Nothin
948 g' = map toUpper g 952 g' = map toUpper g
949 953
950-- We return into IO in case we want to make a signature here. 954-- We return into IO in case we want to make a signature here.
951setHostnames :: [SockAddr] -> Hosts.Hosts -> KeyData -> IO KeyData 955setHostnames :: IPsToWriteToHostsFile -> Hosts.Hosts -> KeyData -> IO KeyData
952setHostnames outgoing_names hosts kd@(KeyData topmp topsigs uids subs) = 956setHostnames (IPsToWriteToHostsFile outgoing_names) hosts kd@(KeyData topmp topsigs uids subs) =
953 -- TODO: we are removing the origin from the UID OriginMap, 957 -- TODO: we are removing the origin from the UID OriginMap,
954 -- when we should be removing origins from the locations 958 -- when we should be removing origins from the locations
955 -- field of the sig's MappedPacket records. 959 -- field of the sig's MappedPacket records.