1 files changed, 31 insertions, 16 deletions

diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs
index b3dc97e..a0d1e1a 100644
--- a/lib/KeyRing.hs
+++ b/lib/KeyRing.hs
@@ -98,7 +98,8 @@ module KeyRing
     , KeySpec(..)
     , getHostnames
     , secretPemFromPacket
-    , getCrossSignedSubkeys
+    , SubkeyStatus(..)
+    , getSubkeys
     ) where
 
 import System.Environment
@@ -2216,8 +2217,10 @@ rsaPrivateKeyFromPacket pkt@(SecretKeyPacket {}) = do
         , rsaCoefficient = coefficient }
 rsaPrivateKeyFromPacket _ = Nothing
 
+secretPemFromPacket :: Packet -> Maybe String
 secretPemFromPacket packet = pemFromPacket Sec packet
 
+pemFromPacket :: Access -> Packet -> Maybe String
 pemFromPacket Sec packet =
     case key_algorithm packet of
      RSA -> do
@@ -3419,24 +3422,36 @@ 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
 
-getCrossSignedSubkeys :: Packet -> Map.Map KeyKey SubKey -> String -> [Packet]
-getCrossSignedSubkeys topk subs tag = do
+data SubkeyStatus = Unsigned | OwnerSigned | CrossSigned
+ deriving (Eq,Ord,Enum,Show,Read)
+
+getSubkeys :: SubkeyStatus -> Packet -> Map.Map KeyKey SubKey -> String -> [Packet]
+getSubkeys ck topk subs tag = do
         SubKey k sigs <- Map.elems subs
         let subk = packet k
         let sigs' = do
+                -- require tag
                 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
-                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'
+
+                -- require parent's signature
+                when (ck > Unsigned) $ do
+                    sig <- (signatures $ Message [topk,subk,torsig])
+                    let v = verify (Message [topk]) sig
+                    -- Require parent's signature
+                    guard (not . null $ signatures_over v)
+
+                -- require child's back signature
+                when (ck == CrossSigned ) $ do
+                    let unhashed = unhashed_subpackets torsig
+                        subsigs = mapMaybe backsig unhashed
+                        -- This should consist only of 0x19 values
+                        -- subtypes = map signature_type subsigs
+                    -- subtyp <- subtypes
+                    -- guard (subtyp == 0x19)
+                    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
@@ -3467,7 +3482,7 @@ getHostnames (KeyData topmp _ uids subs) = (addr,(onames,othernames))
     addr = fingerdress topk
     -- name = fromMaybe "" $ listToMaybe onames -- TODO: more than one tor key?
     topk = packet topmp
-    torkeys = getCrossSignedSubkeys topk subs "tor"
+    torkeys = getSubkeys CrossSigned topk subs "tor"
 
     -- subkeyPacket (SubKey k _ ) = k
     onames :: [L.ByteString]