diff options
-rw-r--r-- | KeyRing.hs | 61 |
1 files changed, 31 insertions, 30 deletions
@@ -1089,16 +1089,12 @@ buildKeyDB doDecrypt ctx grip0 keyring = do | |||
1089 | guard (isring $ typ stream) | 1089 | guard (isring $ typ stream) |
1090 | resolveInputFile ctx f | 1090 | resolveInputFile ctx f |
1091 | 1091 | ||
1092 | filesAccs isring = do | 1092 | (ringMap,nonRingMap) = Map.partition (isring . typ) $ kFiles keyring |
1093 | (f,stream) <- Map.toList (kFiles keyring) | ||
1094 | guard (isring $ typ stream) | ||
1095 | -- n <- resolveInputFile ctx f | ||
1096 | return (f, access stream) | ||
1097 | 1093 | ||
1098 | readp (f,acc) = fmap readp0 $ readPacketsFromFile ctx f | 1094 | readp f stream = fmap readp0 $ readPacketsFromFile ctx f |
1099 | where | 1095 | where |
1100 | readp0 ps = ((f,acc'),ps) | 1096 | readp0 ps = (stream { access = acc' }, ps) |
1101 | where acc' = case acc of | 1097 | where acc' = case access stream of |
1102 | AutoAccess -> | 1098 | AutoAccess -> |
1103 | case ps of | 1099 | case ps of |
1104 | Message ((PublicKeyPacket {}):_) -> Pub | 1100 | Message ((PublicKeyPacket {}):_) -> Pub |
@@ -1121,22 +1117,25 @@ buildKeyDB doDecrypt ctx grip0 keyring = do | |||
1121 | 1117 | ||
1122 | -- KeyRings (todo: KikiCondition reporting?) | 1118 | -- KeyRings (todo: KikiCondition reporting?) |
1123 | (db_rings,mwk,grip,accs) <- do | 1119 | (db_rings,mwk,grip,accs) <- do |
1124 | ms <- mapM readp (filesAccs isring) | 1120 | ringPackets <- Map.traverseWithKey readp ringMap |
1121 | let _ = ringPackets :: Map.Map InputFile (StreamInfo, Message) | ||
1122 | |||
1125 | let grip = grip0 `mplus` (fingerprint <$> fstkey) | 1123 | let grip = grip0 `mplus` (fingerprint <$> fstkey) |
1126 | where | 1124 | where |
1127 | fstkey = listToMaybe $ mapMaybe isSecringKey ms | 1125 | fstkey = do |
1128 | where isSecringKey ((HomeSec,_),Message ps) | 1126 | (_,Message ps) <- Map.lookup HomeSec ringPackets |
1129 | = listToMaybe ps | 1127 | listToMaybe ps |
1130 | isSecringKey _ = Nothing | 1128 | (spilled,unspilled) = Map.partition (spillable . fst) ringPackets |
1131 | db_rings = foldl' mergeIt Map.empty ms | 1129 | db_rings = Map.foldlWithKey mergeIt Map.empty ringPackets |
1132 | where mergeIt db ((f,_),ps) = merge db f ps | 1130 | where mergeIt db f (_,ps) = merge db f ps |
1133 | wk = listToMaybe $ do | 1131 | wk = listToMaybe $ do |
1134 | fp <- maybeToList grip | 1132 | fp <- maybeToList grip |
1135 | elm <- Map.toList db_rings | 1133 | (kk,kd) <- Map.toList db_rings |
1136 | guard $ matchSpec (KeyGrip fp) elm | 1134 | guard $ matchSpec (KeyGrip fp) (kk,kd) |
1137 | return $ keyMappedPacket (snd elm) | 1135 | return $ keyMappedPacket kd |
1138 | accs = map (first (concat . resolveInputFile ctx) . fst) ms | 1136 | accs = Map.mapKeys (concat . resolveInputFile ctx) |
1139 | return (db_rings,wk,grip,Map.fromList accs) | 1137 | $ fmap (access . fst) ringPackets |
1138 | return (db_rings,wk,grip,accs) | ||
1140 | 1139 | ||
1141 | let wk = fmap packet mwk | 1140 | let wk = fmap packet mwk |
1142 | 1141 | ||
@@ -1740,7 +1739,7 @@ performManipulations doDecrypt operation rt wk = do | |||
1740 | , Packet ) -- key who signed | 1739 | , Packet ) -- key who signed |
1741 | ] | 1740 | ] |
1742 | vs = do | 1741 | vs = do |
1743 | x <- maybeToList $ Map.lookup uid (rentryUids kd) | 1742 | x <- maybeToList $ Map.lookup uid (keyUids kd) |
1744 | sig <- map (packet . fst) (fst x) | 1743 | sig <- map (packet . fst) (fst x) |
1745 | o <- overs sig | 1744 | o <- overs sig |
1746 | k <- keys | 1745 | k <- keys |
@@ -1755,7 +1754,7 @@ performManipulations doDecrypt operation rt wk = do | |||
1755 | let f ::([SigAndTrust],OriginMap) -> ([SigAndTrust],OriginMap) | 1754 | let f ::([SigAndTrust],OriginMap) -> ([SigAndTrust],OriginMap) |
1756 | f x = ( map ( (,Map.empty) . toMappedPacket om) (additional sigr) ++ fst x | 1755 | f x = ( map ( (,Map.empty) . toMappedPacket om) (additional sigr) ++ fst x |
1757 | , om `Map.union` snd x ) | 1756 | , om `Map.union` snd x ) |
1758 | return $ KikiSuccess $ kd { rentryUids = Map.adjust f uid (rentryUids kd) } | 1757 | return $ KikiSuccess $ kd { keyUids = Map.adjust f uid (keyUids kd) } |
1759 | 1758 | ||
1760 | initializeMissingPEMFiles :: | 1759 | initializeMissingPEMFiles :: |
1761 | KeyRingOperation | 1760 | KeyRingOperation |
@@ -2297,14 +2296,14 @@ type SigAndTrust = ( MappedPacket | |||
2297 | type KeyKey = [ByteString] | 2296 | type KeyKey = [ByteString] |
2298 | data SubKey = SubKey MappedPacket [SigAndTrust] | 2297 | data SubKey = SubKey MappedPacket [SigAndTrust] |
2299 | 2298 | ||
2300 | -- | This is a roster entry, it's poorly named | 2299 | -- | This is a GPG Identity. It's poorly named |
2301 | -- but we are keeping the name around until | 2300 | -- but we are keeping the name around until |
2302 | -- we're sure we wont be cutting and pasting | 2301 | -- we're sure we wont be cutting and pasting |
2303 | -- code with master any more | 2302 | -- code with master any more. |
2304 | data KeyData = KeyData { keyMappedPacket :: MappedPacket -- main key | 2303 | data KeyData = KeyData { keyMappedPacket :: MappedPacket -- main key |
2305 | , rentrySigAndTrusts :: [SigAndTrust] -- sigs on main key | 2304 | , keySigAndTrusts :: [SigAndTrust] -- sigs on main key |
2306 | , rentryUids :: (Map.Map String ([SigAndTrust],OriginMap)) -- uids | 2305 | , keyUids :: (Map.Map String ([SigAndTrust],OriginMap)) -- uids |
2307 | , rentrySubKeys :: (Map.Map KeyKey SubKey) -- subkeys | 2306 | , keySubKeys :: (Map.Map KeyKey SubKey) -- subkeys |
2308 | } | 2307 | } |
2309 | 2308 | ||
2310 | type KeyDB = Map.Map KeyKey KeyData | 2309 | type KeyDB = Map.Map KeyKey KeyData |
@@ -2324,9 +2323,11 @@ mappedPacket filename p = MappedPacket | |||
2324 | 2323 | ||
2325 | keykey :: Packet -> KeyKey | 2324 | keykey :: Packet -> KeyKey |
2326 | keykey key = | 2325 | keykey key = |
2327 | -- Note: The key's timestamp is included in it's fingerprint. | 2326 | -- Note: The key's timestamp is normally included in it's fingerprint. |
2328 | -- Therefore, the same key with a different timestamp is | 2327 | -- This is undesirable for kiki because it causes the same |
2329 | -- considered distinct using this keykey implementation. | 2328 | -- key to be imported multiple times and show as apparently |
2329 | -- distinct keys with different fingerprints. | ||
2330 | -- Thus, we will remove the timestamp. | ||
2330 | fingerprint_material (key {timestamp=0}) -- TODO: smaller key? | 2331 | fingerprint_material (key {timestamp=0}) -- TODO: smaller key? |
2331 | 2332 | ||
2332 | uidkey :: Packet -> String | 2333 | uidkey :: Packet -> String |