diff options
Diffstat (limited to 'KeyRing.hs')
-rw-r--r-- | KeyRing.hs | 19 |
1 files changed, 12 insertions, 7 deletions
@@ -132,7 +132,7 @@ import qualified Data.Map as Map | |||
132 | import qualified Data.ByteString.Lazy as L ( unpack, null, readFile, writeFile | 132 | import qualified Data.ByteString.Lazy as L ( unpack, null, readFile, writeFile |
133 | , ByteString, toChunks, hGetContents, hPut, concat, fromChunks, splitAt | 133 | , ByteString, toChunks, hGetContents, hPut, concat, fromChunks, splitAt |
134 | , index ) | 134 | , index ) |
135 | import qualified Data.ByteString as S ( ByteString, unpack, splitAt, concat, cons, spanEnd, hGetContents, readFile, breakSubstring, drop, length, null ) | 135 | import qualified Data.ByteString as S ( ByteString, unpack, splitAt, concat, cons, spanEnd, hGetContents, readFile, breakSubstring, drop, length, null, putStr ) |
136 | import qualified Crypto.Types.PubKey.ECC as ECC | 136 | import qualified Crypto.Types.PubKey.ECC as ECC |
137 | import qualified Codec.Binary.Base32 as Base32 | 137 | import qualified Codec.Binary.Base32 as Base32 |
138 | import qualified Codec.Binary.Base64 as Base64 | 138 | import qualified Codec.Binary.Base64 as Base64 |
@@ -1155,16 +1155,20 @@ doesInputFileExist ctx f = do | |||
1155 | -} | 1155 | -} |
1156 | 1156 | ||
1157 | 1157 | ||
1158 | cachedContents :: InputFileContext -> InputFile -> IO (IO S.ByteString) | 1158 | cachedContents :: Maybe S.ByteString -> InputFileContext -> InputFile -> IO (IO S.ByteString) |
1159 | cachedContents ctx fd = do | 1159 | cachedContents maybePrompt ctx fd = do |
1160 | ref <- newIORef Nothing | 1160 | ref <- newIORef Nothing |
1161 | return $ get ref fd | 1161 | return $ get maybePrompt ref fd |
1162 | where | 1162 | where |
1163 | trimCR bs = fst $ S.spanEnd (\x -> x==10 || x==13) bs | 1163 | trimCR bs = fst $ S.spanEnd (\x -> x==10 || x==13) bs |
1164 | 1164 | ||
1165 | get ref fd = do | 1165 | get maybePrompt ref fd = do |
1166 | pw <- readIORef ref | 1166 | pw <- readIORef ref |
1167 | flip (flip maybe return) pw $ do | 1167 | flip (flip maybe return) pw $ do |
1168 | if fd == FileDesc 0 then case maybePrompt of | ||
1169 | Just prompt -> S.putStr prompt | ||
1170 | Nothing -> return () | ||
1171 | else return () | ||
1168 | pw <- fmap trimCR $ readInputFileS ctx fd | 1172 | pw <- fmap trimCR $ readInputFileS ctx fd |
1169 | writeIORef ref (Just pw) | 1173 | writeIORef ref (Just pw) |
1170 | return pw | 1174 | return pw |
@@ -2015,15 +2019,16 @@ makeMemoizingDecrypter operation ctx keys = | |||
2015 | (Map.mapKeys (resolveForReport Nothing) -- see note (*) note above | 2019 | (Map.mapKeys (resolveForReport Nothing) -- see note (*) note above |
2016 | $ Map.filter (isJust . pwfile . typ) $ opFiles operation) | 2020 | $ Map.filter (isJust . pwfile . typ) $ opFiles operation) |
2017 | -} | 2021 | -} |
2022 | let prompt = Just "Enter possibly multi-line passphrase (Press CTRL-D when finished):\n" | ||
2018 | pws2 <- | 2023 | pws2 <- |
2019 | Traversable.mapM (cachedContents ctx) | 2024 | Traversable.mapM (cachedContents prompt ctx) |
2020 | $ Map.fromList $ mapMaybe | 2025 | $ Map.fromList $ mapMaybe |
2021 | (\spec -> (,passSpecPassFile spec) `fmap` do | 2026 | (\spec -> (,passSpecPassFile spec) `fmap` do |
2022 | guard $ isNothing $ passSpecKeySpec spec | 2027 | guard $ isNothing $ passSpecKeySpec spec |
2023 | passSpecRingFile spec) | 2028 | passSpecRingFile spec) |
2024 | passspecs | 2029 | passspecs |
2025 | defpw <- do | 2030 | defpw <- do |
2026 | Traversable.mapM (cachedContents ctx . passSpecPassFile) | 2031 | Traversable.mapM (cachedContents prompt ctx . passSpecPassFile) |
2027 | $ listToMaybe $ filter (\sp -> isNothing (passSpecRingFile sp) | 2032 | $ listToMaybe $ filter (\sp -> isNothing (passSpecRingFile sp) |
2028 | && isNothing (passSpecKeySpec sp)) | 2033 | && isNothing (passSpecKeySpec sp)) |
2029 | $ opPassphrases operation | 2034 | $ opPassphrases operation |