findTag now looks for an arbitrary set of subpackets rather than a usage

tag exclusively.

1 files changed, 20 insertions, 19 deletions

diff --git a/KeyRing.hs b/KeyRing.hs
index 18dc60d..95c22d4 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -1587,7 +1587,7 @@ doImportG doDecrypt db m0 tag fname key = do
 
     let SubKey subkey_p subsigs = subkey
         wk = packet top
-        (xs',minsig,ys') = findTag tag wk key subsigs
+        (xs',minsig,ys') = findTag [mkUsage tag] wk key subsigs
         doInsert mbsig db = do
             -- NEW SUBKEY BINDING SIGNATURE
             sig' <- makeSig doDecrypt top fname subkey_p tag mbsig
@@ -1805,6 +1805,9 @@ getSubkeysForExport kk subspec db = do
     subkeysForExport subspec kd
 -}
 
+-- | If provided Nothing for the first argument, this function returns the
+-- master key of the given identity.  Otherwise, it returns all the subkeys of
+-- the given identity which have a usage tag that matches the first argument.
 subkeysForExport :: Maybe String -> KeyData -> [MappedPacket]
 subkeysForExport subspec (KeyData key _ _ subkeys) = do
     let subs tag = do
@@ -1814,7 +1817,7 @@ subkeysForExport subspec (KeyData key _ _ subkeys) = do
     maybe [key] subs subspec
  where
     doSearch key tag (SubKey sub_mp sigtrusts) =
-        let (_,v,_) = findTag tag
+        let (_,v,_) = findTag [mkUsage tag]
                           (packet key)
                           (packet sub_mp)
                           sigtrusts
@@ -2541,19 +2544,19 @@ splitAtMinBy comp xs = minimumBy comp' xxs
 
 
 
--- | Given a usage@ tag, the working master key, one of its subkeys and a list
--- of signatures on that subkey, yields:
+-- | Given list of subpackets, the working master key, one of its subkeys and a
+-- list of signatures on that subkey, yields:
 --
 --   * preceding list of signatures
 --
 --   * The most recent valid signature made by the working key along with a
---   flag that indicates whether or not the given usage tag occurs in it or,
---   if no valid signature from the working key is present, Nothing.
+--   flag that indicates whether or not all of the supplied subpackets occur in
+--   it or, if no valid signature from the working key is present, Nothing.
 --
 --   * following list of signatures
 --
 findTag ::
-  String
+  [SignatureSubpacket]
   -> Packet
   -> Packet
   -> [(MappedPacket, b)]
@@ -2581,13 +2584,15 @@ findTag tag wk subkey subsigs = (xs',minsig,ys')
             minsig = do
                 (sig,ov) <- listToMaybe ys
                 ov
-                let hs = filter (\p->isNotation p && notation_name p=="usage@")
-                                (hashed_subpackets . packet . fst $ sig)
-                    ks = map notation_value hs
-                    isNotation (NotationDataPacket {}) = True
-                    isNotation _ = False
-                return (tag `elem` ks, sig)
-
+                let hshed = hashed_subpackets $ packet $ fst sig
+                return ( null $ tag \\ hshed, sig)
+
+mkUsage :: String -> SignatureSubpacket
+mkUsage tag = NotationDataPacket
+                { human_readable = True
+                , notation_name = "usage@"
+                , notation_value = tag
+                }
 
 makeSig ::
   (MappedPacket -> IO (KikiCondition Packet))
@@ -2618,11 +2623,7 @@ makeSig doDecrypt top fname subkey_p tag mbsig = do
                         , split_key = False
                         , authentication = True
                         , group_key = False }
-                    , NotationDataPacket
-                        { human_readable = True
-                        , notation_name = "usage@"
-                        , notation_value = tag
-                        }
+                    , mkUsage tag
                     -- implicitly added:
                     -- , SignatureCreationTimePacket (fromIntegral timestamp)
                     ]