1 files changed, 0 insertions, 198 deletions

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