diff options
Diffstat (limited to 'kiki.hs')
-rw-r--r-- | kiki.hs | 74 |
1 files changed, 52 insertions, 22 deletions
@@ -807,6 +807,7 @@ is40digitHex xs = ys == xs && length ys==40 | |||
807 | | 'a' <= c && c <= 'f' = True | 807 | | 'a' <= c && c <= 'f' = True |
808 | ishex c = False | 808 | ishex c = False |
809 | 809 | ||
810 | scanPackets :: FilePath -> [Packet] -> [(Packet,Packet,(Packet,Map.Map FilePath Packet))] | ||
810 | scanPackets filename [] = [] | 811 | scanPackets filename [] = [] |
811 | scanPackets filename (p:ps) = scanl doit (doit (MarkerPacket,MarkerPacket,ret MarkerPacket) p) ps | 812 | scanPackets filename (p:ps) = scanl doit (doit (MarkerPacket,MarkerPacket,ret MarkerPacket) p) ps |
812 | where | 813 | where |
@@ -824,12 +825,21 @@ scanPackets filename (p:ps) = scanl doit (doit (MarkerPacket,MarkerPacket,ret Ma | |||
824 | updateTrust _ _ (pre,t) p = (pre,Map.insert filename p t) -- secret | 825 | updateTrust _ _ (pre,t) p = (pre,Map.insert filename p t) -- secret |
825 | 826 | ||
826 | 827 | ||
827 | type SigAndTrust = ( Packet | 828 | type OriginFlags = () |
828 | , Map.Map FilePath Packet ) -- trust packets | 829 | originNil = () |
830 | |||
831 | data MappedPacket = MappedPacket | ||
832 | { packet :: Packet | ||
833 | , locations :: Map.Map FilePath OriginFlags | ||
834 | } | ||
835 | |||
836 | type TrustMap = Map.Map FilePath Packet | ||
837 | type SigAndTrust = ( MappedPacket | ||
838 | , TrustMap ) -- trust packets | ||
829 | 839 | ||
830 | type KeyKey = [Char8.ByteString] | 840 | type KeyKey = [Char8.ByteString] |
831 | data SubKey = SubKey Packet [SigAndTrust] | 841 | data SubKey = SubKey MappedPacket [SigAndTrust] |
832 | data KeyData = KeyData Packet -- main key | 842 | data KeyData = KeyData MappedPacket -- main key |
833 | [SigAndTrust] -- sigs on main key | 843 | [SigAndTrust] -- sigs on main key |
834 | (Map.Map String [SigAndTrust]) -- uids | 844 | (Map.Map String [SigAndTrust]) -- uids |
835 | (Map.Map KeyKey SubKey) -- subkeys | 845 | (Map.Map KeyKey SubKey) -- subkeys |
@@ -860,19 +870,27 @@ subcomp a b = error $ unlines ["Unable to merge subs:" | |||
860 | , fingerprint b | 870 | , fingerprint b |
861 | , PP.ppShow b | 871 | , PP.ppShow b |
862 | ] | 872 | ] |
873 | subcomp_m a b = subcomp (packet a) (packet b) | ||
863 | 874 | ||
864 | merge :: Map.Map KeyKey KeyData -> FilePath -> Message -> Map.Map KeyKey KeyData | 875 | merge :: KeyDB -> FilePath -> Message -> KeyDB |
865 | merge db filename (Message ps) = foldl mergeit db qs | 876 | merge db filename (Message ps) = foldl mergeit db qs |
866 | where | 877 | where |
867 | qs = scanPackets filename ps | 878 | qs = scanPackets filename ps |
879 | asMapped p = MappedPacket p (Map.singleton filename originNil) | ||
880 | asSigAndTrust (p,tm) = (asMapped p,tm) | ||
868 | -- mergeit db (_,_,TrustPacket {}) = db -- Filter TrustPackets | 881 | -- mergeit db (_,_,TrustPacket {}) = db -- Filter TrustPackets |
882 | mergeit :: KeyDB -> (Packet,Packet,(Packet,Map.Map FilePath Packet)) -> KeyDB | ||
869 | mergeit db (top,sub,ptt@(p,trustmap)) | isKey top = Map.alter update (keykey top) db | 883 | mergeit db (top,sub,ptt@(p,trustmap)) | isKey top = Map.alter update (keykey top) db |
870 | where | 884 | where |
871 | update v | isKey p && not (is_subkey p) | 885 | update v | isKey p && not (is_subkey p) |
872 | = case v of | 886 | = case v of |
873 | Nothing -> Just $ KeyData p [] Map.empty Map.empty | 887 | Nothing -> Just $ KeyData (asMapped p) [] Map.empty Map.empty |
874 | Just (KeyData key sigs uids subkeys) | keykey key == keykey p | 888 | Just (KeyData key sigs uids subkeys) | keykey (packet key) == keykey p |
875 | -> Just $ KeyData (minimumBy keycomp [key,p]) sigs uids subkeys | 889 | -> Just $ KeyData ( MappedPacket (minimumBy keycomp [packet key,p]) |
890 | (Map.insert filename originNil (locations key)) ) | ||
891 | sigs | ||
892 | uids | ||
893 | subkeys | ||
876 | _ -> error . concat $ ["Unexpected master key merge error: " | 894 | _ -> error . concat $ ["Unexpected master key merge error: " |
877 | ,show (fingerprint top, fingerprint p)] | 895 | ,show (fingerprint top, fingerprint p)] |
878 | update (Just (KeyData key sigs uids subkeys)) | isKey p && is_subkey p | 896 | update (Just (KeyData key sigs uids subkeys)) | isKey p && is_subkey p |
@@ -895,9 +913,12 @@ merge db filename (Message ps) = foldl mergeit db qs | |||
895 | 913 | ||
896 | mergeit _ (_,_,p) = error $ "Unexpected PGP packet 3: "++whatP p | 914 | mergeit _ (_,_,p) = error $ "Unexpected PGP packet 3: "++whatP p |
897 | 915 | ||
898 | mergeSubkey p Nothing = Just $ SubKey p [] | 916 | mergeSubkey :: Packet -> Maybe SubKey -> Maybe SubKey |
917 | mergeSubkey p Nothing = Just $ SubKey (asMapped p) [] | ||
899 | mergeSubkey p (Just (SubKey key sigs)) = Just $ | 918 | mergeSubkey p (Just (SubKey key sigs)) = Just $ |
900 | SubKey (minimumBy subcomp [key,p]) sigs | 919 | SubKey (MappedPacket (minimumBy subcomp [packet key,p]) |
920 | (Map.insert filename originNil (locations key))) | ||
921 | sigs | ||
901 | 922 | ||
902 | mergeUid (UserIDPacket s,_) Nothing = Just [] | 923 | mergeUid (UserIDPacket s,_) Nothing = Just [] |
903 | mergeUid (UserIDPacket s,_) (Just sigs) = Just sigs | 924 | mergeUid (UserIDPacket s,_) (Just sigs) = Just sigs |
@@ -906,21 +927,25 @@ merge db filename (Message ps) = foldl mergeit db qs | |||
906 | whatP (a,_) = concat . take 1 . words . show $ a | 927 | whatP (a,_) = concat . take 1 . words . show $ a |
907 | 928 | ||
908 | 929 | ||
930 | mergeSig :: (Packet,TrustMap) -> [SigAndTrust] -> [SigAndTrust] | ||
909 | mergeSig sig sigs = | 931 | mergeSig sig sigs = |
910 | let (xs,ys) = break (isSameSig sig) sigs | 932 | let (xs,ys) = break (isSameSig sig) sigs |
933 | first f (x,y) = (f x,y) | ||
911 | in if null ys | 934 | in if null ys |
912 | then sigs++[sig] | 935 | then sigs++[first asMapped sig] |
913 | else let y:ys'=ys | 936 | else let y:ys'=ys |
914 | in xs ++ (mergeSameSig sig y : ys') | 937 | in xs ++ (mergeSameSig sig y : ys') |
915 | 938 | ||
916 | 939 | ||
917 | isSameSig (a,_) (b,_) | isSignaturePacket a && isSignaturePacket b = | 940 | isSameSig (a,_) (MappedPacket b _,_) | isSignaturePacket a && isSignaturePacket b = |
918 | a { unhashed_subpackets=[] } == b { unhashed_subpackets = [] } | 941 | a { unhashed_subpackets=[] } == b { unhashed_subpackets = [] } |
919 | isSameSig (a,_) (b,_) = a==b | 942 | isSameSig (a,_) (MappedPacket b _,_) = a==b |
920 | 943 | ||
921 | mergeSameSig (a,ta) (b,tb) | isSignaturePacket a && isSignaturePacket b = | 944 | mergeSameSig :: (Packet,TrustMap) -> (MappedPacket,TrustMap) -> (MappedPacket, TrustMap) |
922 | ( b { unhashed_subpackets = | 945 | mergeSameSig (a,ta) (MappedPacket b locs,tb) | isSignaturePacket a && isSignaturePacket b = |
923 | foldl mergeItem (unhashed_subpackets b) (unhashed_subpackets a) } | 946 | ( MappedPacket (b { unhashed_subpackets = |
947 | foldl mergeItem (unhashed_subpackets b) (unhashed_subpackets a) }) | ||
948 | (Map.insert filename originNil locs) | ||
924 | , tb `Map.union` ta ) | 949 | , tb `Map.union` ta ) |
925 | 950 | ||
926 | where | 951 | where |
@@ -929,13 +954,13 @@ merge db filename (Message ps) = foldl mergeit db qs | |||
929 | mergeSameSig a b = trace ("discarding dup "++show a) b | 954 | mergeSameSig a b = trace ("discarding dup "++show a) b |
930 | 955 | ||
931 | mergeUidSig sig (Just sigs) = Just $ mergeSig sig sigs | 956 | mergeUidSig sig (Just sigs) = Just $ mergeSig sig sigs |
932 | mergeUidSig sig Nothing = Just [sig] | 957 | mergeUidSig sig Nothing = Just [asSigAndTrust sig] |
933 | 958 | ||
934 | mergeSubSig sig (Just (SubKey key sigs)) = Just $ SubKey key (mergeSig sig sigs) | 959 | mergeSubSig sig (Just (SubKey key sigs)) = Just $ SubKey key (mergeSig sig sigs) |
935 | mergeSubSig sig Nothing = error $ | 960 | mergeSubSig sig Nothing = error $ |
936 | "Unable to merge subkey signature: "++(words (show sig) >>= take 1) | 961 | "Unable to merge subkey signature: "++(words (show sig) >>= take 1) |
937 | 962 | ||
938 | flattenKeys :: Bool -> Map.Map KeyKey KeyData -> Message | 963 | flattenKeys :: Bool -> KeyDB -> Message |
939 | flattenKeys isPublic db = Message $ concatMap flattenTop (prefilter . Map.assocs $ db) | 964 | flattenKeys isPublic db = Message $ concatMap flattenTop (prefilter . Map.assocs $ db) |
940 | where | 965 | where |
941 | flattenTop (_,(KeyData key sigs uids subkeys)) = | 966 | flattenTop (_,(KeyData key sigs uids subkeys)) = |
@@ -946,15 +971,20 @@ flattenKeys isPublic db = Message $ concatMap flattenTop (prefilter . Map.assocs | |||
946 | 971 | ||
947 | flattenSub (_,SubKey key sigs) = unk key: concatMap unsig sigs | 972 | flattenSub (_,SubKey key sigs) = unk key: concatMap unsig sigs |
948 | 973 | ||
949 | unk k = if isPublic then secretToPublic k else k | 974 | unk = (if isPublic then secretToPublic else id) . packet |
950 | unsig (sig,trustmap) = [sig]++ take 1 (Map.elems $ Map.filterWithKey f trustmap) | 975 | unsig (sig,trustmap) = [packet sig]++ take 1 (Map.elems $ Map.filterWithKey f trustmap) |
951 | where | 976 | where |
952 | f "%secring" _ = not isPublic | 977 | f "%secring" _ = not isPublic |
953 | f _ _ = isPublic | 978 | f _ _ = isPublic |
954 | 979 | ||
955 | prefilter = if isPublic then id else filter isSecret | 980 | prefilter = if isPublic then id else filter isSecret |
956 | where isSecret (_,(KeyData (SecretKeyPacket {}) _ _ _)) = True | 981 | where |
957 | isSecret _ = False | 982 | isSecret (_,(KeyData |
983 | (MappedPacket { packet=(SecretKeyPacket {})}) | ||
984 | _ | ||
985 | _ | ||
986 | _)) = True | ||
987 | isSecret _ = False | ||
958 | 988 | ||
959 | writeOutKeyrings db = return () -- TODO | 989 | writeOutKeyrings db = return () -- TODO |
960 | 990 | ||