diff options
-rw-r--r-- | KeyRing.hs | 36 |
1 files changed, 24 insertions, 12 deletions
@@ -187,6 +187,10 @@ data StreamInfo = StreamInfo | |||
187 | , initializer :: Maybe String } | 187 | , initializer :: Maybe String } |
188 | 188 | ||
189 | 189 | ||
190 | spillable :: StreamInfo -> Bool | ||
191 | spillable (spill -> KF_None) = False | ||
192 | spillable _ = True | ||
193 | |||
190 | isMutable :: StreamInfo -> Bool | 194 | isMutable :: StreamInfo -> Bool |
191 | isMutable (fill -> KF_None) = False | 195 | isMutable (fill -> KF_None) = False |
192 | isMutable _ = True | 196 | isMutable _ = True |
@@ -195,6 +199,10 @@ isring :: FileType -> Bool | |||
195 | isring (KeyRingFile {}) = True | 199 | isring (KeyRingFile {}) = True |
196 | isring _ = False | 200 | isring _ = False |
197 | 201 | ||
202 | ispem :: FileType -> Bool | ||
203 | ispem (PEMFile {}) = True | ||
204 | ispem _ = False | ||
205 | |||
198 | pwfile :: FileType -> Maybe PassWordFile | 206 | pwfile :: FileType -> Maybe PassWordFile |
199 | pwfile (KeyRingFile f) = f | 207 | pwfile (KeyRingFile f) = f |
200 | pwfile _ = Nothing | 208 | pwfile _ = Nothing |
@@ -203,11 +211,9 @@ iswallet :: FileType -> Bool | |||
203 | iswallet (WalletFile {}) = True | 211 | iswallet (WalletFile {}) = True |
204 | iswallet _ = False | 212 | iswallet _ = False |
205 | 213 | ||
206 | getUsage :: | 214 | usageFromFilter :: MonadPlus m => KeyFilter -> m String |
207 | MonadPlus m => FileType -> m UsageTag | 215 | usageFromFilter (KF_Match usage) = return usage |
208 | getUsage (PEMFile usage) = return usage | 216 | usageFromFilter _ = mzero |
209 | getUsage _ = mzero | ||
210 | |||
211 | 217 | ||
212 | data KeyRingRuntime = KeyRingRuntime | 218 | data KeyRingRuntime = KeyRingRuntime |
213 | { rtPubring :: FilePath | 219 | { rtPubring :: FilePath |
@@ -1023,9 +1029,14 @@ buildKeyDB doDecrypt secring pubring grip0 keyring = do | |||
1023 | let pems = do | 1029 | let pems = do |
1024 | (n,stream) <- Map.toList $ kFiles keyring | 1030 | (n,stream) <- Map.toList $ kFiles keyring |
1025 | grip <- maybeToList grip | 1031 | grip <- maybeToList grip |
1026 | (topspec,subspec) <- fmap (parseSpec grip) $ getUsage (typ stream) | ||
1027 | n <- resolveInputFile secring pubring n | 1032 | n <- resolveInputFile secring pubring n |
1028 | let ms = map fst $ filterMatches topspec (Map.toList db) | 1033 | guard $ spillable stream && ispem (typ stream) |
1034 | let us = mapMaybe usageFromFilter [fill stream,spill stream] | ||
1035 | usage <- take 1 us | ||
1036 | guard $ all (==usage) $ drop 1 us | ||
1037 | -- TODO: KikiCondition for spill/fill usage mismatch? | ||
1038 | let (topspec,subspec) = parseSpec grip usage | ||
1039 | ms = map fst $ filterMatches topspec (Map.toList db) | ||
1029 | cmd = initializer stream | 1040 | cmd = initializer stream |
1030 | return (n,subspec,ms,cmd) | 1041 | return (n,subspec,ms,cmd) |
1031 | imports <- filterM (\(n,_,_,_) -> doesFileExist n) pems | 1042 | imports <- filterM (\(n,_,_,_) -> doesFileExist n) pems |
@@ -1609,11 +1620,12 @@ initializeMissingPEMFiles operation secring pubring grip decrypt db = do | |||
1609 | let (missing,notmissing) = partition (\(_,_,ns,_)->null (ns >>= snd)) $ do | 1620 | let (missing,notmissing) = partition (\(_,_,ns,_)->null (ns >>= snd)) $ do |
1610 | (fname,stream) <- nonexistents | 1621 | (fname,stream) <- nonexistents |
1611 | guard $ isMutable stream | 1622 | guard $ isMutable stream |
1612 | (topspec,subspec) <- fmap (parseSpec $ fromMaybe "" grip) | 1623 | guard $ ispem (typ stream) |
1613 | $ getUsage $ typ stream | 1624 | usage <- usageFromFilter (fill stream) -- TODO: Error if no result? |
1614 | -- ms will contain duplicates if a top key has multiple matching | 1625 | let (topspec,subspec) = parseSpec (fromMaybe "" grip) usage |
1615 | -- subkeys. This is intentional. | 1626 | -- ms will contain duplicates if a top key has multiple matching |
1616 | let -- ms = map (keykey . fst) $ selectAll True (topspec,subspec) db | 1627 | -- subkeys. This is intentional. |
1628 | -- ms = map (keykey . fst) $ selectAll True (topspec,subspec) db | ||
1617 | -- ms = filterMatches topspec $ Map.toList db | 1629 | -- ms = filterMatches topspec $ Map.toList db |
1618 | ns = do | 1630 | ns = do |
1619 | (kk,kd) <- filterMatches topspec $ Map.toList db | 1631 | (kk,kd) <- filterMatches topspec $ Map.toList db |