summaryrefslogtreecommitdiff
path: root/KeyRing.hs
diff options
context:
space:
mode:
Diffstat (limited to 'KeyRing.hs')
-rw-r--r--KeyRing.hs19
1 files changed, 12 insertions, 7 deletions
diff --git a/KeyRing.hs b/KeyRing.hs
index 2571c55..75e19b3 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -132,7 +132,7 @@ import qualified Data.Map as Map
132import qualified Data.ByteString.Lazy as L ( unpack, null, readFile, writeFile 132import 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 )
135import qualified Data.ByteString as S ( ByteString, unpack, splitAt, concat, cons, spanEnd, hGetContents, readFile, breakSubstring, drop, length, null ) 135import qualified Data.ByteString as S ( ByteString, unpack, splitAt, concat, cons, spanEnd, hGetContents, readFile, breakSubstring, drop, length, null, putStr )
136import qualified Crypto.Types.PubKey.ECC as ECC 136import qualified Crypto.Types.PubKey.ECC as ECC
137import qualified Codec.Binary.Base32 as Base32 137import qualified Codec.Binary.Base32 as Base32
138import qualified Codec.Binary.Base64 as Base64 138import qualified Codec.Binary.Base64 as Base64
@@ -1155,16 +1155,20 @@ doesInputFileExist ctx f = do
1155-} 1155-}
1156 1156
1157 1157
1158cachedContents :: InputFileContext -> InputFile -> IO (IO S.ByteString) 1158cachedContents :: Maybe S.ByteString -> InputFileContext -> InputFile -> IO (IO S.ByteString)
1159cachedContents ctx fd = do 1159cachedContents 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