summaryrefslogtreecommitdiff
path: root/KeyRing.hs
diff options
context:
space:
mode:
Diffstat (limited to 'KeyRing.hs')
-rw-r--r--KeyRing.hs11
1 files changed, 7 insertions, 4 deletions
diff --git a/KeyRing.hs b/KeyRing.hs
index 0957143..c7ea5fb 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -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
210type Initializer = String 210type 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
1202isSecretKey :: Packet -> Bool
1203isSecretKey (SecretKeyPacket {}) = True
1204isSecretKey _ = False
1202 1205
1203buildKeyDB :: InputFileContext -> Maybe String -> KeyRingOperation 1206buildKeyDB :: 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) $