New command to rename subkeys.

1 files changed, 0 insertions, 184 deletions

diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs
index bb32a2e..87b38bf 100644
--- a/lib/KeyRing.hs
+++ b/lib/KeyRing.hs
@@ -2333,190 +2333,6 @@ readPacketsFromFile ctx fname = do
     return $ decode input
 #endif
 
--- | Get the time stamp of a signature.
---
--- Warning: This function checks unhashed_subpackets if no timestamp occurs in
--- the hashed section.  TODO: change this?
---
-signature_time :: SignatureOver -> Word32
-signature_time ov = case (if null cs then ds else cs) of
-                                [] -> minBound
-                                xs -> maximum xs
-          where
-            ps = signatures_over ov
-            ss = filter isSignaturePacket ps
-            cs = concatMap (concatMap creationTime . hashed_subpackets) ss
-            ds = concatMap (concatMap creationTime . unhashed_subpackets) ss
-            creationTime (SignatureCreationTimePacket t) = [t]
-            creationTime _                               = []
-
-splitAtMinBy :: (t -> t -> Ordering) -> [t] -> ([t], [t])
-splitAtMinBy comp xs = minimumBy comp' xxs
- where
-    xxs = zip (inits xs) (tails xs)
-    comp' (_,as) (_,bs) = compM (listToMaybe as) (listToMaybe bs)
-    compM (Just a) (Just b) = comp a b
-    compM Nothing  mb       = GT
-    compM _        _        = LT
-
-
-
--- | Given list of subpackets, a 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 master key along with a
---   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 ::
-  [SignatureSubpacket]
-  -> Packet
-  -> Packet
-  -> [(MappedPacket, b)]
-  -> ([(MappedPacket, b)],
-      Maybe (Bool, (MappedPacket, b)),
-      [(MappedPacket, b)])
-findTag tag topk subkey subsigs = (xs',minsig,ys')
-         where
-            vs = map (\sig ->
-                          (sig, do
-                                sig <- Just (packet . fst $ sig)
-                                guard (isSignaturePacket sig)
-                                guard $ flip isSuffixOf
-                                             (fingerprint topk)
-                                        . fromMaybe "%bad%" 
-                                        . signature_issuer
-                                        $ sig
-                                listToMaybe $
-                                  map (signature_time . verify (Message [topk]))
-                                      (signatures $ Message [topk,subkey,sig])))
-                     subsigs
-            (xs,ys) = splitAtMinBy (comparing (Down . snd)) vs
-            xs' = map fst xs
-            ys' = map fst $ if isNothing minsig then ys else drop 1 ys
-            minsig = do
-                (sig,ov) <- listToMaybe ys
-                ov
-                let hshed = hashed_subpackets $ packet $ fst sig
-                return ( null $ tag \\ hshed, sig)
-
-mkUsage :: String -> SignatureSubpacket
-mkUsage tag | Just flags <- lookup tag specials
-  = KeyFlagsPacket
-        { certify_keys          = fromEnum flags .&. 0x1 /= 0
-        , sign_data             = fromEnum flags .&. 0x2 /= 0
-        , encrypt_communication = fromEnum flags .&. 0x4 /= 0
-        , encrypt_storage       = fromEnum flags .&. 0x8 /= 0
-        , split_key             = False
-        , authentication        = False
-        , group_key             = False
-        }
- where
-    flagsets = [Special .. VouchSignEncrypt]
-    specials = map (\f -> (usageString f, f)) flagsets
-
-mkUsage tag = NotationDataPacket
-                { human_readable = True
-                , notation_name = "usage@"
-                , notation_value = tag
-                }
-
-makeSig ::
-  (PacketDecrypter)
-  -> MappedPacket
-  -> [Char]
-  -> MappedPacket
-  -> [SignatureSubpacket]
-  -> Maybe (MappedPacket, Map.Map k a)
-  -> IO (KikiCondition ((MappedPacket, Map.Map k a), [KikiReportAction]))
-makeSig doDecrypt top fname subkey_p tags mbsig = do
-    let wk = packet top
-    wkun <- doDecrypt top
-    try wkun $ \wkun -> do
-    let grip = fingerprint wk
-        addOrigin new_sig =
-            flip (maybe $ return FailedToMakeSignature)
-                 (new_sig >>= listToMaybe . signatures_over)
-                 $ \new_sig -> do
-            let mp' = mappedPacket fname new_sig
-            return $ KikiSuccess (mp', Map.empty)
-        parsedkey = [packet subkey_p]
-        hashed0 | any isFlagsPacket tags = tags
-                | otherwise
-                  = KeyFlagsPacket
-                    { certify_keys = False
-                    , sign_data = False
-                    , encrypt_communication = False
-                    , encrypt_storage = False
-                    , split_key = False
-                    , authentication = True
-                    , group_key = False }
-                    : tags
-                    -- implicitly added:
-                    -- , SignatureCreationTimePacket (fromIntegral timestamp)
-        isFlagsPacket (KeyFlagsPacket {}) = True
-        isFlagsPacket _                   = False
-        subgrip = fingerprint (head parsedkey)
-
-    back_sig <- pgpSign (Message parsedkey)
-                        (SubkeySignature wk
-                                         (head parsedkey)
-                                         (sigpackets 0x19
-                                                     hashed0
-                                                     [IssuerPacket subgrip]))
-                        (if key_algorithm (head parsedkey)==ECDSA
-                            then SHA256
-                            else SHA1)
-                        subgrip
-    let iss = IssuerPacket (fingerprint wk)
-        cons_iss back_sig = iss : map EmbeddedSignaturePacket (signatures_over back_sig)
-        unhashed0 = maybe [iss] cons_iss back_sig
-
-    new_sig <- pgpSign (Message [wkun])
-                       (SubkeySignature wk
-                                        (head parsedkey)
-                                        (sigpackets 0x18
-                                                   hashed0
-                                                   unhashed0))
-                      SHA1
-                      grip
-    let newSig = do
-            r <- addOrigin new_sig
-            return $ fmap (,[]) r
-    flip (maybe newSig) mbsig $ \(mp,trustmap) -> do
-    let sig = packet mp
-        isCreation (SignatureCreationTimePacket {}) = True
-        isCreation _ = False
-        isExpiration (SignatureExpirationTimePacket {}) = True
-        isExpiration _ = False
-        (cs,ps) = partition isCreation (hashed_subpackets sig)
-        (es,qs) = partition isExpiration ps
-        stamp = listToMaybe . sortBy (comparing Down) $
-                 map unwrap cs where unwrap (SignatureCreationTimePacket x) = x
-        exp = listToMaybe $ sort $
-                 map unwrap es where unwrap (SignatureExpirationTimePacket x) = x
-        expires = liftA2 (+) stamp exp
-    timestamp <- now
-    if fmap ( (< timestamp) . fromIntegral) expires == Just True then
-        return $ KikiSuccess ((mp,trustmap), [ UnableToUpdateExpiredSignature ] )
-    else do
-        let times = (:) (SignatureExpirationTimePacket (fromIntegral timestamp))
-                        $ maybeToList $ do
-                            e <- expires
-                            return $ SignatureExpirationTimePacket (e - fromIntegral timestamp)
-            sig' = sig { hashed_subpackets = times ++ (qs `union` tags) }
-        new_sig <- pgpSign (Message [wkun])
-                           (SubkeySignature wk
-                                            (packet subkey_p)
-                                            [sig'] )
-                           SHA1
-                           (fingerprint wk)
-        newsig <- addOrigin new_sig
-        return $ fmap (,[]) newsig
 
 merge :: KeyDB -> InputFile -> Message -> KeyDB
 merge db inputfile (Message ps) = merge_ db filename qs