summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--KeyRing.hs61
1 files changed, 31 insertions, 30 deletions
diff --git a/KeyRing.hs b/KeyRing.hs
index c99a2f5..3eba3de 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -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
1760initializeMissingPEMFiles :: 1759initializeMissingPEMFiles ::
1761 KeyRingOperation 1760 KeyRingOperation
@@ -2297,14 +2296,14 @@ type SigAndTrust = ( MappedPacket
2297type KeyKey = [ByteString] 2296type KeyKey = [ByteString]
2298data SubKey = SubKey MappedPacket [SigAndTrust] 2297data 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.
2304data KeyData = KeyData { keyMappedPacket :: MappedPacket -- main key 2303data 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
2310type KeyDB = Map.Map KeyKey KeyData 2309type KeyDB = Map.Map KeyKey KeyData
@@ -2324,9 +2323,11 @@ mappedPacket filename p = MappedPacket
2324 2323
2325keykey :: Packet -> KeyKey 2324keykey :: Packet -> KeyKey
2326keykey key = 2325keykey 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
2332uidkey :: Packet -> String 2333uidkey :: Packet -> String