1 files changed, 30 insertions, 18 deletions

diff --git a/KeyRing.hs b/KeyRing.hs
index 53a1a34..0fbf2c2 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -99,6 +99,7 @@ module KeyRing
     , KeySpec(..)
     , getHostnames
     , secretPemFromPacket
+    , getCrossSignedSubkeys
     ) where
 
 import System.Environment
@@ -3328,27 +3329,12 @@ flattenUid :: FilePath -> Bool -> (String,([SigAndTrust],OriginMap)) -> [MappedP
 flattenUid fname ispub (str,(sigs,om)) =
     (mappedPacket "" $ UserIDPacket str) {locations=om} : concatSort fname head (unsig fname ispub) sigs
 
-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 = fromMaybe "" $ listToMaybe onames -- TODO: more than one tor key?
-    topk = packet topmp
-    torkeys = do
+getCrossSignedSubkeys :: Packet -> Map.Map KeyKey SubKey -> String -> [Packet]
+getCrossSignedSubkeys topk subs tag = do
         SubKey k sigs <- Map.elems subs
         let subk = packet k
         let sigs' = do
-                torsig <- filter (has_tag "tor") $ map (packet . fst) sigs
+                torsig <- filter (has_tag tag) $ map (packet . fst) sigs
                 sig <- (signatures $ Message [topk,subk,torsig])
                 let v = verify (Message [topk]) sig
                 -- Require parent's signature
@@ -3364,9 +3350,35 @@ getHostnames (KeyData topmp _ uids subs) = (addr,(onames,othernames))
                 return torsig
         guard (not $ null sigs')
         return subk
+ where
     has_tag tag p = isSignaturePacket p
                     && or [ tag `elem` mapMaybe usage (hashed_subpackets p)
                           , tag `elem` map usageString (mapMaybe keyflags (hashed_subpackets p)) ]
+
+
+-- |
+-- Returns (ip6 fingerprint address,(onion names,other host names))
+--
+-- Requires a validly cross-signed tor key for each onion name returned.
+-- (Signature checks are performed.)
+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 = fromMaybe "" $ listToMaybe onames -- TODO: more than one tor key?
+    topk = packet topmp
+    torkeys = getCrossSignedSubkeys topk subs "tor"
+
     -- subkeyPacket (SubKey k _ ) = k
     onames :: [L.ByteString]
     onames = map ( (<> ".onion")