summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2014-05-10 23:03:15 -0400
committerjoe <joe@jerkface.net>2014-05-10 23:03:15 -0400
commit43f95ca5faab255741394a210dab19b09799cc49 (patch)
tree5623b9c997662b6b7320290d34dd509c201224f4
parent6492f127b8decb19ad1fe4b5552cc31b4ababb5d (diff)
findTag now looks for an arbitrary set of subpackets rather than a usage
tag exclusively.
-rw-r--r--KeyRing.hs39
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
1587 1587
1588 let SubKey subkey_p subsigs = subkey 1588 let SubKey subkey_p subsigs = subkey
1589 wk = packet top 1589 wk = packet top
1590 (xs',minsig,ys') = findTag tag wk key subsigs 1590 (xs',minsig,ys') = findTag [mkUsage tag] wk key subsigs
1591 doInsert mbsig db = do 1591 doInsert mbsig db = do
1592 -- NEW SUBKEY BINDING SIGNATURE 1592 -- NEW SUBKEY BINDING SIGNATURE
1593 sig' <- makeSig doDecrypt top fname subkey_p tag mbsig 1593 sig' <- makeSig doDecrypt top fname subkey_p tag mbsig
@@ -1805,6 +1805,9 @@ getSubkeysForExport kk subspec db = do
1805 subkeysForExport subspec kd 1805 subkeysForExport subspec kd
1806-} 1806-}
1807 1807
1808-- | If provided Nothing for the first argument, this function returns the
1809-- master key of the given identity. Otherwise, it returns all the subkeys of
1810-- the given identity which have a usage tag that matches the first argument.
1808subkeysForExport :: Maybe String -> KeyData -> [MappedPacket] 1811subkeysForExport :: Maybe String -> KeyData -> [MappedPacket]
1809subkeysForExport subspec (KeyData key _ _ subkeys) = do 1812subkeysForExport subspec (KeyData key _ _ subkeys) = do
1810 let subs tag = do 1813 let subs tag = do
@@ -1814,7 +1817,7 @@ subkeysForExport subspec (KeyData key _ _ subkeys) = do
1814 maybe [key] subs subspec 1817 maybe [key] subs subspec
1815 where 1818 where
1816 doSearch key tag (SubKey sub_mp sigtrusts) = 1819 doSearch key tag (SubKey sub_mp sigtrusts) =
1817 let (_,v,_) = findTag tag 1820 let (_,v,_) = findTag [mkUsage tag]
1818 (packet key) 1821 (packet key)
1819 (packet sub_mp) 1822 (packet sub_mp)
1820 sigtrusts 1823 sigtrusts
@@ -2541,19 +2544,19 @@ splitAtMinBy comp xs = minimumBy comp' xxs
2541 2544
2542 2545
2543 2546
2544-- | Given a usage@ tag, the working master key, one of its subkeys and a list 2547-- | Given list of subpackets, the working master key, one of its subkeys and a
2545-- of signatures on that subkey, yields: 2548-- list of signatures on that subkey, yields:
2546-- 2549--
2547-- * preceding list of signatures 2550-- * preceding list of signatures
2548-- 2551--
2549-- * The most recent valid signature made by the working key along with a 2552-- * The most recent valid signature made by the working key along with a
2550-- flag that indicates whether or not the given usage tag occurs in it or, 2553-- flag that indicates whether or not all of the supplied subpackets occur in
2551-- if no valid signature from the working key is present, Nothing. 2554-- it or, if no valid signature from the working key is present, Nothing.
2552-- 2555--
2553-- * following list of signatures 2556-- * following list of signatures
2554-- 2557--
2555findTag :: 2558findTag ::
2556 String 2559 [SignatureSubpacket]
2557 -> Packet 2560 -> Packet
2558 -> Packet 2561 -> Packet
2559 -> [(MappedPacket, b)] 2562 -> [(MappedPacket, b)]
@@ -2581,13 +2584,15 @@ findTag tag wk subkey subsigs = (xs',minsig,ys')
2581 minsig = do 2584 minsig = do
2582 (sig,ov) <- listToMaybe ys 2585 (sig,ov) <- listToMaybe ys
2583 ov 2586 ov
2584 let hs = filter (\p->isNotation p && notation_name p=="usage@") 2587 let hshed = hashed_subpackets $ packet $ fst sig
2585 (hashed_subpackets . packet . fst $ sig) 2588 return ( null $ tag \\ hshed, sig)
2586 ks = map notation_value hs 2589
2587 isNotation (NotationDataPacket {}) = True 2590mkUsage :: String -> SignatureSubpacket
2588 isNotation _ = False 2591mkUsage tag = NotationDataPacket
2589 return (tag `elem` ks, sig) 2592 { human_readable = True
2590 2593 , notation_name = "usage@"
2594 , notation_value = tag
2595 }
2591 2596
2592makeSig :: 2597makeSig ::
2593 (MappedPacket -> IO (KikiCondition Packet)) 2598 (MappedPacket -> IO (KikiCondition Packet))
@@ -2618,11 +2623,7 @@ makeSig doDecrypt top fname subkey_p tag mbsig = do
2618 , split_key = False 2623 , split_key = False
2619 , authentication = True 2624 , authentication = True
2620 , group_key = False } 2625 , group_key = False }
2621 , NotationDataPacket 2626 , mkUsage tag
2622 { human_readable = True
2623 , notation_name = "usage@"
2624 , notation_value = tag
2625 }
2626 -- implicitly added: 2627 -- implicitly added:
2627 -- , SignatureCreationTimePacket (fromIntegral timestamp) 2628 -- , SignatureCreationTimePacket (fromIntegral timestamp)
2628 ] 2629 ]