From ba3249708c52d0c5cf85ed5eb13dd7191b6b990b Mon Sep 17 00:00:00 2001 From: joe Date: Sun, 20 Apr 2014 23:41:29 -0400 Subject: /etc/hosts file merging --- kiki.hs | 198 ---------------------------------------------------------------- 1 file changed, 198 deletions(-) (limited to 'kiki.hs') diff --git a/kiki.hs b/kiki.hs index 6b67449..60c0b6b 100644 --- a/kiki.hs +++ b/kiki.hs @@ -145,9 +145,6 @@ isCertificationSig _ = True issuer (IssuerPacket issuer) = Just issuer issuer _ = Nothing -backsig (EmbeddedSignaturePacket s) = Just s -backsig _ = Nothing - isSubkeySignature (SubkeySignature {}) = True isSubkeySignature _ = False @@ -814,85 +811,6 @@ doBTCImport doDecrypt db (ms,subspec,content) = do doImportG doDecrypt db m0 tag "" key -} --- We return into IO in case we want to make a signature here. -setHostnames :: (SockAddr -> Bool) -> Hosts.Hosts -> KeyData -> IO KeyData -setHostnames pred hosts kd@(KeyData topmp topsigs uids subs) = - -- TODO: we are removing the origin from the UID OriginMap, - -- when we should be removing origins from the locations - -- field of the sig's MappedPacket records. - -- Call getHostnames and compare to see if no-op. - if not (pred addr) || names0 == names \\ onions - then {- trace (unlines [ "setHostnames NO-OP: gpg: "++show (map Char8.unpack onions, map Char8.unpack names0) - , " file: "++show (map Char8.unpack names) - , " pred: "++show (pred addr)]) -} - (return kd) - else do - -- We should be sure to remove origins so that the data is written - -- (but only if something changed). - -- Filter all hostnames present in uids - -- Write notations into first uid - {- - trace (unlines [ "setHostnames ACTION: gpg: "++show (map Char8.unpack onions, map Char8.unpack names0) - , " file: "++show (map Char8.unpack names) ]) $ do - -} - return $ KeyData topmp topsigs uids1 subs - where - topk = packet topmp - addr = fingerdress topk - names :: [Char8.ByteString] - names = Hosts.namesForAddress addr hosts - (_,(onions,names0)) = getHostnames kd - notations = map (NotationDataPacket True "hostname@" . Char8.unpack) (names \\ onions) - isName (NotationDataPacket True "hostname@" _) = True - isName _ = False - uids0 = fmap zapIfHasName uids - fstuid = head $ do - p <- map packet $ flattenAllUids "" True uids - guard $ isUserID p - return $ uidkey p - uids1 = Map.adjust addnames fstuid uids0 - addnames (sigs,om) = (fmap f ss ++ ts, om ) -- XXX: removed om=Map.empty, preserve UserId origin - where - (ss,ts) = splitAt 1 sigs - f (sig,tm) = if isSignaturePacket (packet sig) then (sig { packet = p', locations=Map.empty }, tm) - else (sig, tm) - where p' = (packet sig) { unhashed_subpackets=uh } - uh = unhashed_subpackets (packet sig) ++ notations - zapIfHasName (sigs,om) = if or bs then (sigs',om) -- XXX: removed om=Map.empty to preserve UserID origin - else (sigs,om) - where - (bs, sigs') = unzip $ map unhash sigs - - unhash (sig,tm) = ( not (null ns) - , ( sig { packet = p', locations = Map.empty } - , tm ) ) - where - psig = packet sig - p' = if isSignaturePacket psig then psig { unhashed_subpackets = ps } - else psig - uh = unhashed_subpackets $ psig - (ns,ps) = partition isName uh - -socketFamily (SockAddrInet _ _) = AF_INET -socketFamily (SockAddrInet6 _ _ _ _) = AF_INET6 -socketFamily (SockAddrUnix _) = AF_UNIX - - -hasFingerDress :: KeyDB -> SockAddr -> Bool -hasFingerDress db addr | socketFamily addr/=AF_INET6 = False -hasFingerDress db addr = pre=="fd" && isJust (selectPublicKey (KeyGrip g',Nothing) db) - where - (pre,g) = splitAt 2 $ filter (/=':') $ Hosts.inet_ntop addr - g' = map toUpper g - -fingerdress :: Packet -> SockAddr -fingerdress topk = maybe zero id $ Hosts.inet_pton addr_str - where - zero = SockAddrInet 0 0 - addr_str = colons $ "fd" ++ (drop 10 $ map toLower $ fingerprint topk) - colons (a:b:c:d:xs@(_:_)) = [a,b,c,d,':'] ++ colons xs - colons xs = xs - {- onionName :: KeyData -> (SockAddr,L.ByteString) @@ -901,53 +819,6 @@ onionName kd = (addr,name) (addr,(name:_,_)) = getHostnames kd -} -getHostnames :: KeyData -> (SockAddr, ([L.ByteString],[L.ByteString])) -getHostnames (KeyData topmp _ uids subs) = (addr,(onames,othernames)) - where - othernames = do - mp <- flattenAllUids "" True uids - let p = packet mp - guard $ isSignaturePacket p - uh <- unhashed_subpackets p - case uh of - NotationDataPacket True "hostname@" v - -> return $ Char8.pack v - _ -> mzero - - addr = fingerdress topk - -- name = maybe "" id $ listToMaybe onames -- TODO: more than one tor key? - topk = packet topmp - torkeys = do - SubKey k sigs <- Map.elems subs - let subk = packet k - let sigs' = do - torsig <- filter (has_tag "tor") $ map (packet . fst) sigs - sig <- (signatures $ Message [topk,subk,torsig]) - let v = verify (Message [topk]) sig - -- Require parent's signature - guard (not . null $ signatures_over v) - let unhashed = unhashed_subpackets torsig - subsigs = mapMaybe backsig unhashed - -- This should consist only of 0x19 values - -- subtypes = map signature_type subsigs - sig' <- signatures . Message $ [topk,subk]++subsigs - let v' = verify (Message [subk]) sig' - -- Require subkey's signature - guard . not . null $ signatures_over v' - return torsig - guard (not $ null sigs') - return $ subk - has_tag tag p = isSignaturePacket p - && or [ tag `elem` mapMaybe usage (hashed_subpackets p) - , tag `elem` map usageString (mapMaybe keyflags (hashed_subpackets p)) ] - -- subkeyPacket (SubKey k _ ) = k - onames :: [L.ByteString] - onames = map ( (<> ".onion") - . Char8.pack - . take 16 - . torhash ) - torkeys - whoseKey :: RSAPublicKey -> KeyDB -> [KeyData] whoseKey rsakey db = filter matchkey (Map.elems db) where @@ -1255,75 +1126,6 @@ main = do Traversable.mapM (signTorIds wkun keys) (rtKeyDB rt) return use_db - let doHostNames db = do - let hns = maybe [] id $ Map.lookup "--hosts" margs - hostdbs0 <- mapM (fmap Hosts.decode . L.readFile) hns - - let gpgnames = map getHostnames $ Map.elems db - os = do - (addr,(ns,_)) <- gpgnames - n <- ns - return (addr,n) - setOnions hosts = foldl' (flip $ uncurry Hosts.assignName) hosts os - -- we ensure .onion names are set properly - hostdbs = map setOnions hostdbs0 - outgoing_names = do - (addr,(_,gns)) <- gpgnames - guard . not $ null gns - guard $ all (null . Hosts.namesForAddress addr) hostdbs0 - return addr - -- putStrLn $ "hostdbs = " ++ show hostdbs - - -- 1. let U = union all the host dbs - -- preserving whitespace and comments of the first - let u0 = foldl' Hosts.plus Hosts.empty hostdbs - -- we filter U to be only finger-dresses - u1 = Hosts.filterAddrs (hasFingerDress db) u0 - - -- let nf h = map Char8.unpack $ Hosts.namesForAddress (fromJust $ Hosts.inet_pton "fdf4:ed98:29c7:6226:9bde:a5b4:d564:3321") h - {- - putStrLn $ "_ = {\n" ++ show (head hostdbs) ++ "}" - putStrLn $ "--> " ++ show (nf (head hostdbs)) - putStrLn $ "u0 = {\n" ++ show u0 ++ "}" - putStrLn $ "--> " ++ show (nf u0) - putStrLn $ "u1 = {\n" ++ show u1 ++ "}" - putStrLn $ "--> " ++ show (nf u1) - -} - - -- 2. replace gpg annotations with those in U - -- forM use_db - db' <- Traversable.mapM (setHostnames (\a -> not $ elem a outgoing_names) u1) db - - -- 3. add hostnames from gpg for addresses not in U - let u = foldl' f u1 ans - ans = reverse $ do - (addr,(_,ns)) <- gpgnames - guard $ addr `elem` outgoing_names -- . null $ Hosts.namesForAddress addr u0 - n <- ns - return (addr,n) - f h (addr,n) = Hosts.assignNewName addr n h - - {- - putStrLn $ "u = {\n" ++ show u ++ "}" - putStrLn $ "--> " ++ show (nf u) - -} - - -- 4. for each host db H, union H with U and write it out as H' - -- only if there is a non-empty diff - forM_ (zip hns $ zip hostdbs0 hostdbs) $ \(fname,(h0,h1)) -> do - let h = h1 `Hosts.plus` u - d = Hosts.diff h0 h - fnamecolon = Char8.pack fname <> ": " - {- - putStrLn $ "h = {\n" ++ show h ++ "}" - putStrLn $ "--> " ++ show (nf h) - -} - Char8.hPutStrLn stderr $ Char8.unlines (map (fnamecolon <>) d) - when (not $ null d) $ L.writeFile fname $ Hosts.encode h - return () - - return db' - let homespec = join . take 1 <$> Map.lookup "--homedir" margs passfd = fmap (FileDesc . read) passphrase_fd pems = flip map keypairs -- cgit v1.2.3