Save ordering information and public/private flag in origin slot of

the key database.

1 files changed, 48 insertions, 32 deletions

diff --git a/kiki.hs b/kiki.hs
index 7f55426..99ca2a6 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -825,8 +825,16 @@ scanPackets filename (p:ps) = scanl doit (doit (MarkerPacket,MarkerPacket,ret Ma
     updateTrust _                    _   (pre,t) p = (pre,Map.insert filename p t) -- secret
 
 
-type OriginFlags = ()
-originNil = ()
+data OriginFlags = OriginFlags {
+        originallyPublic :: Bool,
+        originalNum :: Int
+    }
+origin :: Packet -> Int -> OriginFlags
+origin p n = OriginFlags ispub n
+ where
+    ispub = case p of
+                    SecretKeyPacket {} -> False
+                    _                  -> True
 
 type OriginMap = Map.Map FilePath OriginFlags
 data MappedPacket = MappedPacket
@@ -874,55 +882,63 @@ subcomp a b = error $ unlines ["Unable to merge subs:"
 subcomp_m a b = subcomp (packet a) (packet b)
 
 merge :: KeyDB -> FilePath -> Message -> KeyDB
-merge db filename (Message ps) = foldl mergeit db qs
+merge db filename (Message ps) = foldl mergeit db (zip [0..] qs)
  where
     qs = scanPackets filename ps
-    asMapped p = MappedPacket p (Map.singleton filename originNil)
-    asSigAndTrust (p,tm) = (asMapped p,tm)
+    asMapped n p = MappedPacket p (Map.singleton filename (origin p n))
+    asSigAndTrust n (p,tm) = (asMapped n p,tm)
     emptyUids = (Map.empty,Map.empty)
     -- mergeit db (_,_,TrustPacket {}) = db -- Filter TrustPackets
-    mergeit :: KeyDB -> (Packet,Packet,(Packet,Map.Map FilePath Packet)) -> KeyDB
-    mergeit db (top,sub,ptt@(p,trustmap)) | isKey top = Map.alter update (keykey top) db
+    mergeit :: KeyDB -> (Int,(Packet,Packet,(Packet,Map.Map FilePath Packet))) -> KeyDB
+    mergeit db (n,(top,sub,ptt@(p,trustmap))) | isKey top = Map.alter update (keykey top) db
      where
+        -- NOTE:
+        --  if a keyring file has both a public key packet and a secret key packet
+        --  for the same key, then only one of them will survive, which ever is 
+        --  later in the file.
+        -- 
+        --  This is due to the use of statements like 
+        --      (Map.insert filename (origin p n) (locations key))
+        --
         update v | isKey p && not (is_subkey p)
           = case v of
-             Nothing -> Just $ KeyData (asMapped p) [] emptyUids Map.empty
+             Nothing -> Just $ KeyData (asMapped n p) [] emptyUids Map.empty
              Just (KeyData key sigs uids subkeys) | keykey (packet key) == keykey p
                      -> Just $ KeyData ( MappedPacket (minimumBy keycomp [packet key,p])
-                                                      (Map.insert filename originNil (locations key)) )
+                                                      (Map.insert filename (origin p n) (locations key)) )
                                        sigs
                                        uids
                                        subkeys
              _       -> error . concat $ ["Unexpected master key merge error: "
                                          ,show (fingerprint top, fingerprint p)]
         update (Just (KeyData key sigs uids subkeys)) | isKey p && is_subkey p
-          = Just $ KeyData key sigs uids (Map.alter (mergeSubkey p) (keykey p) subkeys)
+          = Just $ KeyData key sigs uids (Map.alter (mergeSubkey n p) (keykey p) subkeys)
         update (Just (KeyData key sigs (uids,locs) subkeys)) | isUserID p
           = Just $ KeyData key sigs ( Map.alter (mergeUid ptt) (uidkey p) uids
-                                    , Map.insert filename originNil locs )
+                                    , Map.insert filename (origin p n) locs )
                                     subkeys
         update (Just (KeyData key sigs uids subkeys))
           = case sub of
-             MarkerPacket    -> Just $ KeyData key (mergeSig ptt sigs) uids subkeys
+             MarkerPacket    -> Just $ KeyData key (mergeSig n ptt sigs) uids subkeys
              UserIDPacket {} -> Just $ KeyData key
                                                sigs
-                                               (Map.alter (mergeUidSig ptt) (uidkey sub) (fst uids)
-                                               ,Map.insert filename originNil (snd uids))
+                                               (Map.alter (mergeUidSig n ptt) (uidkey sub) (fst uids)
+                                               ,Map.insert filename (origin p n) (snd uids))
                                                subkeys
              _  | isKey sub  -> Just $ KeyData key
                                                sigs
                                                uids
-                                               (Map.alter (mergeSubSig ptt) (keykey sub) subkeys)
+                                               (Map.alter (mergeSubSig n ptt) (keykey sub) subkeys)
              _ -> error $ "Unexpected PGP packet 1: "++(words (show p) >>= take 1)
         update _ = error $ "Unexpected PGP packet 2: "++(words (show p) >>= take 1)
 
-    mergeit _  (_,_,p) = error $ "Unexpected PGP packet 3: "++whatP p
+    mergeit _  (_,(_,_,p)) = error $ "Unexpected PGP packet 3: "++whatP p
 
-    mergeSubkey :: Packet -> Maybe SubKey -> Maybe SubKey
-    mergeSubkey p Nothing                  = Just $ SubKey (asMapped p) []
-    mergeSubkey p (Just (SubKey key sigs)) = Just $
+    mergeSubkey :: Int -> Packet -> Maybe SubKey -> Maybe SubKey
+    mergeSubkey n p Nothing                  = Just $ SubKey (asMapped n p) []
+    mergeSubkey n p (Just (SubKey key sigs)) = Just $
         SubKey (MappedPacket (minimumBy subcomp [packet key,p])
-                             (Map.insert filename originNil (locations key)))
+                             (Map.insert filename (origin p n) (locations key)))
                sigs
 
     mergeUid (UserIDPacket s,_) Nothing     = Just []
@@ -932,37 +948,37 @@ merge db filename (Message ps) = foldl mergeit db qs
     whatP (a,_) = concat . take 1 . words . show $ a
 
 
-    mergeSig :: (Packet,TrustMap) -> [SigAndTrust] -> [SigAndTrust]
-    mergeSig sig sigs =
+    mergeSig :: Int -> (Packet,TrustMap) -> [SigAndTrust] -> [SigAndTrust]
+    mergeSig n sig sigs =
       let (xs,ys) = break (isSameSig sig) sigs
           first f (x,y) = (f x,y)
       in if null ys
-          then sigs++[first asMapped sig]
+          then sigs++[first (asMapped n) sig]
           else let y:ys'=ys
-               in xs ++ (mergeSameSig sig y : ys')
+               in xs ++ (mergeSameSig n sig y : ys')
 
 
     isSameSig (a,_) (MappedPacket b _,_) | isSignaturePacket a && isSignaturePacket b =
         a { unhashed_subpackets=[] } == b { unhashed_subpackets = [] }
     isSameSig (a,_) (MappedPacket b _,_) = a==b
 
-    mergeSameSig :: (Packet,TrustMap) -> (MappedPacket,TrustMap) -> (MappedPacket, TrustMap)
-    mergeSameSig (a,ta) (MappedPacket b locs,tb) | isSignaturePacket a && isSignaturePacket b =
+    mergeSameSig :: Int -> (Packet,TrustMap) -> (MappedPacket,TrustMap) -> (MappedPacket, TrustMap)
+    mergeSameSig n (a,ta) (MappedPacket b locs,tb) | isSignaturePacket a && isSignaturePacket b =
        ( MappedPacket (b { unhashed_subpackets =
                             foldl mergeItem (unhashed_subpackets b) (unhashed_subpackets a) })
-                      (Map.insert filename originNil locs)
+                      (Map.insert filename (origin a n) locs)
         , tb `Map.union` ta )
 
      where
         mergeItem ys x = if x `elem` ys then ys else ys++[x]
 
-    mergeSameSig a b = trace ("discarding dup "++show a) b
+    mergeSameSig n a b = trace ("discarding dup "++show a) b
 
-    mergeUidSig sig (Just sigs) = Just $ mergeSig sig sigs
-    mergeUidSig sig Nothing = Just [asSigAndTrust sig]
+    mergeUidSig n sig (Just sigs) = Just $ mergeSig n sig sigs
+    mergeUidSig n sig Nothing = Just [asSigAndTrust n sig]
 
-    mergeSubSig sig (Just (SubKey key sigs)) = Just $ SubKey key (mergeSig sig sigs)
-    mergeSubSig sig Nothing = error $
+    mergeSubSig n sig (Just (SubKey key sigs)) = Just $ SubKey key (mergeSig n sig sigs)
+    mergeSubSig n sig Nothing = error $
         "Unable to merge subkey signature: "++(words (show sig) >>= take 1)
 
 flattenKeys :: Bool -> KeyDB -> Message