summaryrefslogtreecommitdiff
path: root/KeyRing.hs
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2014-05-11 00:19:28 -0400
committerjoe <joe@jerkface.net>2014-05-11 00:19:28 -0400
commit8d0e428001e870188ecbc3c322c5dafcae6baa30 (patch)
treeeaceca8bda377776d8089f0c29f2811c225a8a95 /KeyRing.hs
parent43f95ca5faab255741394a210dab19b09799cc49 (diff)
makeSig now takes list of subpackets instead of a usage tag string.
Diffstat (limited to 'KeyRing.hs')
-rw-r--r--KeyRing.hs32
1 files changed, 13 insertions, 19 deletions
diff --git a/KeyRing.hs b/KeyRing.hs
index 95c22d4..f97c37c 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -1590,7 +1590,7 @@ doImportG doDecrypt db m0 tag fname key = do
1590 (xs',minsig,ys') = findTag [mkUsage 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 [mkUsage tag] mbsig
1594 try sig' $ \(sig',report) -> do 1594 try sig' $ \(sig',report) -> do
1595 report <- return $ fmap (fname,) report ++ [(fname, YieldSignature)] 1595 report <- return $ fmap (fname,) report ++ [(fname, YieldSignature)]
1596 let subs' = Map.insert subkk 1596 let subs' = Map.insert subkk
@@ -2599,10 +2599,10 @@ makeSig ::
2599 -> MappedPacket 2599 -> MappedPacket
2600 -> [Char] 2600 -> [Char]
2601 -> MappedPacket 2601 -> MappedPacket
2602 -> [Char] 2602 -> [SignatureSubpacket]
2603 -> Maybe (MappedPacket, Map.Map k a) 2603 -> Maybe (MappedPacket, Map.Map k a)
2604 -> IO (KikiCondition ((MappedPacket, Map.Map k a), [KikiReportAction])) 2604 -> IO (KikiCondition ((MappedPacket, Map.Map k a), [KikiReportAction]))
2605makeSig doDecrypt top fname subkey_p tag mbsig = do 2605makeSig doDecrypt top fname subkey_p tags mbsig = do
2606 let wk = packet top 2606 let wk = packet top
2607 wkun <- doDecrypt top 2607 wkun <- doDecrypt top
2608 try wkun $ \wkun -> do 2608 try wkun $ \wkun -> do
@@ -2614,19 +2614,17 @@ makeSig doDecrypt top fname subkey_p tag mbsig = do
2614 let mp' = mappedPacket fname new_sig 2614 let mp' = mappedPacket fname new_sig
2615 return $ KikiSuccess (mp', Map.empty) 2615 return $ KikiSuccess (mp', Map.empty)
2616 parsedkey = [packet subkey_p] 2616 parsedkey = [packet subkey_p]
2617 hashed0 = 2617 hashed0 = KeyFlagsPacket
2618 [ KeyFlagsPacket 2618 { certify_keys = False
2619 { certify_keys = False 2619 , sign_data = False
2620 , sign_data = False 2620 , encrypt_communication = False
2621 , encrypt_communication = False 2621 , encrypt_storage = False
2622 , encrypt_storage = False 2622 , split_key = False
2623 , split_key = False 2623 , authentication = True
2624 , authentication = True 2624 , group_key = False }
2625 , group_key = False } 2625 : tags
2626 , mkUsage tag
2627 -- implicitly added: 2626 -- implicitly added:
2628 -- , SignatureCreationTimePacket (fromIntegral timestamp) 2627 -- , SignatureCreationTimePacket (fromIntegral timestamp)
2629 ]
2630 subgrip = fingerprint (head parsedkey) 2628 subgrip = fingerprint (head parsedkey)
2631 2629
2632 back_sig <- pgpSign (Message parsedkey) 2630 back_sig <- pgpSign (Message parsedkey)
@@ -2675,11 +2673,7 @@ makeSig doDecrypt top fname subkey_p tag mbsig = do
2675 $ maybeToList $ do 2673 $ maybeToList $ do
2676 e <- expires 2674 e <- expires
2677 return $ SignatureExpirationTimePacket (e - fromIntegral timestamp) 2675 return $ SignatureExpirationTimePacket (e - fromIntegral timestamp)
2678 notation = NotationDataPacket 2676 sig' = sig { hashed_subpackets = times ++ (qs `union` tags) }
2679 { notation_name = "usage@"
2680 , notation_value = tag
2681 , human_readable = True }
2682 sig' = sig { hashed_subpackets = times ++ [notation] ++ qs }
2683 new_sig <- pgpSign (Message [wkun]) 2677 new_sig <- pgpSign (Message [wkun])
2684 (SubkeySignature wk 2678 (SubkeySignature wk
2685 (packet subkey_p) 2679 (packet subkey_p)