diff options
Diffstat (limited to 'KeyRing.hs')
-rw-r--r-- | KeyRing.hs | 11 |
1 files changed, 7 insertions, 4 deletions
@@ -204,7 +204,7 @@ data InputFile = HomeSec | |||
204 | -- ^ Contents will be read from the first descriptor and updated | 204 | -- ^ Contents will be read from the first descriptor and updated |
205 | -- content will be writen to the second. Note: Don't use Pipe | 205 | -- content will be writen to the second. Note: Don't use Pipe |
206 | -- for 'Wallet' files. (TODO: Wallet support) | 206 | -- for 'Wallet' files. (TODO: Wallet support) |
207 | deriving (Eq,Ord) | 207 | deriving (Eq,Ord,Show) |
208 | 208 | ||
209 | -- type UsageTag = String | 209 | -- type UsageTag = String |
210 | type Initializer = String | 210 | type Initializer = String |
@@ -1199,6 +1199,9 @@ writeHostsFiles krd ctx (hostdbs0,hostdbs,u1,gpgnames,outgoing_names) = do | |||
1199 | return $ map (first $ resolveForReport $ Just ctx) rs | 1199 | return $ map (first $ resolveForReport $ Just ctx) rs |
1200 | return $ concat rss | 1200 | return $ concat rss |
1201 | 1201 | ||
1202 | isSecretKey :: Packet -> Bool | ||
1203 | isSecretKey (SecretKeyPacket {}) = True | ||
1204 | isSecretKey _ = False | ||
1202 | 1205 | ||
1203 | buildKeyDB :: InputFileContext -> Maybe String -> KeyRingOperation | 1206 | buildKeyDB :: InputFileContext -> Maybe String -> KeyRingOperation |
1204 | -> IO (KikiCondition ((KeyDB | 1207 | -> IO (KikiCondition ((KeyDB |
@@ -1254,8 +1257,7 @@ buildKeyDB ctx grip0 keyring = do | |||
1254 | keys :: Map.Map KeyKey MappedPacket | 1257 | keys :: Map.Map KeyKey MappedPacket |
1255 | keys = Map.foldl slurpkeys Map.empty | 1258 | keys = Map.foldl slurpkeys Map.empty |
1256 | $ Map.mapWithKey filterSecrets ringPackets | 1259 | $ Map.mapWithKey filterSecrets ringPackets |
1257 | where isSecretKey (SecretKeyPacket {}) = True | 1260 | where |
1258 | isSecretKey _ = False | ||
1259 | filterSecrets f (_,Message ps) = | 1261 | filterSecrets f (_,Message ps) = |
1260 | filter (isSecretKey . packet) | 1262 | filter (isSecretKey . packet) |
1261 | $ zipWith (mappedPacketWithHint fname) ps [1..] | 1263 | $ zipWith (mappedPacketWithHint fname) ps [1..] |
@@ -1678,13 +1680,14 @@ writeRingKeys krd rt {- db wk secring pubring -} unspilled = do | |||
1678 | d <- sortByHint f keyMappedPacket (Map.elems db') | 1680 | d <- sortByHint f keyMappedPacket (Map.elems db') |
1679 | acc <- maybeToList $ Map.lookup f0 (rtRingAccess rt) | 1681 | acc <- maybeToList $ Map.lookup f0 (rtRingAccess rt) |
1680 | only_public <- maybeToList $ wantedForFill acc (fill stream) d | 1682 | only_public <- maybeToList $ wantedForFill acc (fill stream) d |
1683 | guard $ only_public || isSecretKey (keyPacket d) | ||
1681 | case fill stream of | 1684 | case fill stream of |
1682 | KF_Match usage -> do grip <- maybeToList $ rtGrip rt | 1685 | KF_Match usage -> do grip <- maybeToList $ rtGrip rt |
1683 | flattenTop f only_public | 1686 | flattenTop f only_public |
1684 | $ filterNewSubs f (parseSpec grip usage) d | 1687 | $ filterNewSubs f (parseSpec grip usage) d |
1685 | _ -> flattenTop f only_public d | 1688 | _ -> flattenTop f only_public d |
1686 | new_packets = filter isnew x | 1689 | new_packets = filter isnew x |
1687 | where isnew p = isNothing (Map.lookup f $ locations p) | 1690 | where isnew p = isNothing (Map.lookup (resolveForReport Nothing f0) $ locations p) |
1688 | guard (not $ null new_packets) | 1691 | guard (not $ null new_packets) |
1689 | return ((f0,isMutable stream),(new_packets,x)) | 1692 | return ((f0,isMutable stream),(new_packets,x)) |
1690 | let (towrites,report) = (\f -> foldl f ([],[]) s) $ | 1693 | let (towrites,report) = (\f -> foldl f ([],[]) s) $ |