summaryrefslogtreecommitdiff
path: root/kiki.hs
diff options
context:
space:
mode:
Diffstat (limited to 'kiki.hs')
-rw-r--r--kiki.hs80
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
825 updateTrust _ _ (pre,t) p = (pre,Map.insert filename p t) -- secret 825 updateTrust _ _ (pre,t) p = (pre,Map.insert filename p t) -- secret
826 826
827 827
828type OriginFlags = () 828data OriginFlags = OriginFlags {
829originNil = () 829 originallyPublic :: Bool,
830 originalNum :: Int
831 }
832origin :: Packet -> Int -> OriginFlags
833origin p n = OriginFlags ispub n
834 where
835 ispub = case p of
836 SecretKeyPacket {} -> False
837 _ -> True
830 838
831type OriginMap = Map.Map FilePath OriginFlags 839type OriginMap = Map.Map FilePath OriginFlags
832data MappedPacket = MappedPacket 840data MappedPacket = MappedPacket
@@ -874,55 +882,63 @@ subcomp a b = error $ unlines ["Unable to merge subs:"
874subcomp_m a b = subcomp (packet a) (packet b) 882subcomp_m a b = subcomp (packet a) (packet b)
875 883
876merge :: KeyDB -> FilePath -> Message -> KeyDB 884merge :: KeyDB -> FilePath -> Message -> KeyDB
877merge db filename (Message ps) = foldl mergeit db qs 885merge db filename (Message ps) = foldl mergeit db (zip [0..] qs)
878 where 886 where
879 qs = scanPackets filename ps 887 qs = scanPackets filename ps
880 asMapped p = MappedPacket p (Map.singleton filename originNil) 888 asMapped n p = MappedPacket p (Map.singleton filename (origin p n))
881 asSigAndTrust (p,tm) = (asMapped p,tm) 889 asSigAndTrust n (p,tm) = (asMapped n p,tm)
882 emptyUids = (Map.empty,Map.empty) 890 emptyUids = (Map.empty,Map.empty)
883 -- mergeit db (_,_,TrustPacket {}) = db -- Filter TrustPackets 891 -- mergeit db (_,_,TrustPacket {}) = db -- Filter TrustPackets
884 mergeit :: KeyDB -> (Packet,Packet,(Packet,Map.Map FilePath Packet)) -> KeyDB 892 mergeit :: KeyDB -> (Int,(Packet,Packet,(Packet,Map.Map FilePath Packet))) -> KeyDB
885 mergeit db (top,sub,ptt@(p,trustmap)) | isKey top = Map.alter update (keykey top) db 893 mergeit db (n,(top,sub,ptt@(p,trustmap))) | isKey top = Map.alter update (keykey top) db
886 where 894 where
895 -- NOTE:
896 -- if a keyring file has both a public key packet and a secret key packet
897 -- for the same key, then only one of them will survive, which ever is
898 -- later in the file.
899 --
900 -- This is due to the use of statements like
901 -- (Map.insert filename (origin p n) (locations key))
902 --
887 update v | isKey p && not (is_subkey p) 903 update v | isKey p && not (is_subkey p)
888 = case v of 904 = case v of
889 Nothing -> Just $ KeyData (asMapped p) [] emptyUids Map.empty 905 Nothing -> Just $ KeyData (asMapped n p) [] emptyUids Map.empty
890 Just (KeyData key sigs uids subkeys) | keykey (packet key) == keykey p 906 Just (KeyData key sigs uids subkeys) | keykey (packet key) == keykey p
891 -> Just $ KeyData ( MappedPacket (minimumBy keycomp [packet key,p]) 907 -> Just $ KeyData ( MappedPacket (minimumBy keycomp [packet key,p])
892 (Map.insert filename originNil (locations key)) ) 908 (Map.insert filename (origin p n) (locations key)) )
893 sigs 909 sigs
894 uids 910 uids
895 subkeys 911 subkeys
896 _ -> error . concat $ ["Unexpected master key merge error: " 912 _ -> error . concat $ ["Unexpected master key merge error: "
897 ,show (fingerprint top, fingerprint p)] 913 ,show (fingerprint top, fingerprint p)]
898 update (Just (KeyData key sigs uids subkeys)) | isKey p && is_subkey p 914 update (Just (KeyData key sigs uids subkeys)) | isKey p && is_subkey p
899 = Just $ KeyData key sigs uids (Map.alter (mergeSubkey p) (keykey p) subkeys) 915 = Just $ KeyData key sigs uids (Map.alter (mergeSubkey n p) (keykey p) subkeys)
900 update (Just (KeyData key sigs (uids,locs) subkeys)) | isUserID p 916 update (Just (KeyData key sigs (uids,locs) subkeys)) | isUserID p
901 = Just $ KeyData key sigs ( Map.alter (mergeUid ptt) (uidkey p) uids 917 = Just $ KeyData key sigs ( Map.alter (mergeUid ptt) (uidkey p) uids
902 , Map.insert filename originNil locs ) 918 , Map.insert filename (origin p n) locs )
903 subkeys 919 subkeys
904 update (Just (KeyData key sigs uids subkeys)) 920 update (Just (KeyData key sigs uids subkeys))
905 = case sub of 921 = case sub of
906 MarkerPacket -> Just $ KeyData key (mergeSig ptt sigs) uids subkeys 922 MarkerPacket -> Just $ KeyData key (mergeSig n ptt sigs) uids subkeys
907 UserIDPacket {} -> Just $ KeyData key 923 UserIDPacket {} -> Just $ KeyData key
908 sigs 924 sigs
909 (Map.alter (mergeUidSig ptt) (uidkey sub) (fst uids) 925 (Map.alter (mergeUidSig n ptt) (uidkey sub) (fst uids)
910 ,Map.insert filename originNil (snd uids)) 926 ,Map.insert filename (origin p n) (snd uids))
911 subkeys 927 subkeys
912 _ | isKey sub -> Just $ KeyData key 928 _ | isKey sub -> Just $ KeyData key
913 sigs 929 sigs
914 uids 930 uids
915 (Map.alter (mergeSubSig ptt) (keykey sub) subkeys) 931 (Map.alter (mergeSubSig n ptt) (keykey sub) subkeys)
916 _ -> error $ "Unexpected PGP packet 1: "++(words (show p) >>= take 1) 932 _ -> error $ "Unexpected PGP packet 1: "++(words (show p) >>= take 1)
917 update _ = error $ "Unexpected PGP packet 2: "++(words (show p) >>= take 1) 933 update _ = error $ "Unexpected PGP packet 2: "++(words (show p) >>= take 1)
918 934
919 mergeit _ (_,_,p) = error $ "Unexpected PGP packet 3: "++whatP p 935 mergeit _ (_,(_,_,p)) = error $ "Unexpected PGP packet 3: "++whatP p
920 936
921 mergeSubkey :: Packet -> Maybe SubKey -> Maybe SubKey 937 mergeSubkey :: Int -> Packet -> Maybe SubKey -> Maybe SubKey
922 mergeSubkey p Nothing = Just $ SubKey (asMapped p) [] 938 mergeSubkey n p Nothing = Just $ SubKey (asMapped n p) []
923 mergeSubkey p (Just (SubKey key sigs)) = Just $ 939 mergeSubkey n p (Just (SubKey key sigs)) = Just $
924 SubKey (MappedPacket (minimumBy subcomp [packet key,p]) 940 SubKey (MappedPacket (minimumBy subcomp [packet key,p])
925 (Map.insert filename originNil (locations key))) 941 (Map.insert filename (origin p n) (locations key)))
926 sigs 942 sigs
927 943
928 mergeUid (UserIDPacket s,_) Nothing = Just [] 944 mergeUid (UserIDPacket s,_) Nothing = Just []
@@ -932,37 +948,37 @@ merge db filename (Message ps) = foldl mergeit db qs
932 whatP (a,_) = concat . take 1 . words . show $ a 948 whatP (a,_) = concat . take 1 . words . show $ a
933 949
934 950
935 mergeSig :: (Packet,TrustMap) -> [SigAndTrust] -> [SigAndTrust] 951 mergeSig :: Int -> (Packet,TrustMap) -> [SigAndTrust] -> [SigAndTrust]
936 mergeSig sig sigs = 952 mergeSig n sig sigs =
937 let (xs,ys) = break (isSameSig sig) sigs 953 let (xs,ys) = break (isSameSig sig) sigs
938 first f (x,y) = (f x,y) 954 first f (x,y) = (f x,y)
939 in if null ys 955 in if null ys
940 then sigs++[first asMapped sig] 956 then sigs++[first (asMapped n) sig]
941 else let y:ys'=ys 957 else let y:ys'=ys
942 in xs ++ (mergeSameSig sig y : ys') 958 in xs ++ (mergeSameSig n sig y : ys')
943 959
944 960
945 isSameSig (a,_) (MappedPacket b _,_) | isSignaturePacket a && isSignaturePacket b = 961 isSameSig (a,_) (MappedPacket b _,_) | isSignaturePacket a && isSignaturePacket b =
946 a { unhashed_subpackets=[] } == b { unhashed_subpackets = [] } 962 a { unhashed_subpackets=[] } == b { unhashed_subpackets = [] }
947 isSameSig (a,_) (MappedPacket b _,_) = a==b 963 isSameSig (a,_) (MappedPacket b _,_) = a==b
948 964
949 mergeSameSig :: (Packet,TrustMap) -> (MappedPacket,TrustMap) -> (MappedPacket, TrustMap) 965 mergeSameSig :: Int -> (Packet,TrustMap) -> (MappedPacket,TrustMap) -> (MappedPacket, TrustMap)
950 mergeSameSig (a,ta) (MappedPacket b locs,tb) | isSignaturePacket a && isSignaturePacket b = 966 mergeSameSig n (a,ta) (MappedPacket b locs,tb) | isSignaturePacket a && isSignaturePacket b =
951 ( MappedPacket (b { unhashed_subpackets = 967 ( MappedPacket (b { unhashed_subpackets =
952 foldl mergeItem (unhashed_subpackets b) (unhashed_subpackets a) }) 968 foldl mergeItem (unhashed_subpackets b) (unhashed_subpackets a) })
953 (Map.insert filename originNil locs) 969 (Map.insert filename (origin a n) locs)
954 , tb `Map.union` ta ) 970 , tb `Map.union` ta )
955 971
956 where 972 where
957 mergeItem ys x = if x `elem` ys then ys else ys++[x] 973 mergeItem ys x = if x `elem` ys then ys else ys++[x]
958 974
959 mergeSameSig a b = trace ("discarding dup "++show a) b 975 mergeSameSig n a b = trace ("discarding dup "++show a) b
960 976
961 mergeUidSig sig (Just sigs) = Just $ mergeSig sig sigs 977 mergeUidSig n sig (Just sigs) = Just $ mergeSig n sig sigs
962 mergeUidSig sig Nothing = Just [asSigAndTrust sig] 978 mergeUidSig n sig Nothing = Just [asSigAndTrust n sig]
963 979
964 mergeSubSig sig (Just (SubKey key sigs)) = Just $ SubKey key (mergeSig sig sigs) 980 mergeSubSig n sig (Just (SubKey key sigs)) = Just $ SubKey key (mergeSig n sig sigs)
965 mergeSubSig sig Nothing = error $ 981 mergeSubSig n sig Nothing = error $
966 "Unable to merge subkey signature: "++(words (show sig) >>= take 1) 982 "Unable to merge subkey signature: "++(words (show sig) >>= take 1)
967 983
968flattenKeys :: Bool -> KeyDB -> Message 984flattenKeys :: Bool -> KeyDB -> Message