diff options
author | joe <joe@jerkface.net> | 2014-04-17 21:05:34 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2014-04-17 21:05:34 -0400 |
commit | 9becb1c1272797f75ec54f18de1ced12bcee8186 (patch) | |
tree | 96d4a74913589a6d5e3fe403283c389c2cf589a1 | |
parent | c9a04bbca5071cfb46d8abc277f63c7dddd17c9f (diff) |
cachedContents for caching passwords read from fd
-rw-r--r-- | KeyRing.hs | 26 |
1 files changed, 23 insertions, 3 deletions
@@ -36,7 +36,7 @@ import Data.Time.Clock.POSIX ( getPOSIXTime ) | |||
36 | import qualified Data.Map as Map | 36 | import qualified Data.Map as Map |
37 | import qualified Data.ByteString.Lazy as L ( unpack, pack, null, readFile, writeFile | 37 | import qualified Data.ByteString.Lazy as L ( unpack, pack, null, readFile, writeFile |
38 | , ByteString, toChunks ) | 38 | , ByteString, toChunks ) |
39 | import qualified Data.ByteString as S ( unpack, splitAt, concat, cons ) | 39 | import qualified Data.ByteString as S ( ByteString, unpack, splitAt, concat, cons, spanEnd, hGetContents ) |
40 | import qualified Data.ByteString.Lazy.Char8 as Char8 ( span, unpack, break, concat, lines ) | 40 | import qualified Data.ByteString.Lazy.Char8 as Char8 ( span, unpack, break, concat, lines ) |
41 | import qualified Crypto.Types.PubKey.ECC as ECC | 41 | import qualified Crypto.Types.PubKey.ECC as ECC |
42 | import qualified Codec.Binary.Base32 as Base32 | 42 | import qualified Codec.Binary.Base32 as Base32 |
@@ -44,12 +44,16 @@ import qualified Codec.Binary.Base64 as Base64 | |||
44 | import qualified Crypto.Hash.SHA1 as SHA1 | 44 | import qualified Crypto.Hash.SHA1 as SHA1 |
45 | import qualified Data.Text as T ( Text, unpack, pack, | 45 | import qualified Data.Text as T ( Text, unpack, pack, |
46 | strip, reverse, drop, break, dropAround ) | 46 | strip, reverse, drop, break, dropAround ) |
47 | import System.Posix.Types (EpochTime) | 47 | import qualified System.Posix.Types as Posix |
48 | import System.Posix.Files ( modificationTime, getFileStatus | 48 | import System.Posix.Files ( modificationTime, getFileStatus |
49 | , setFileCreationMask, setFileTimes ) | 49 | , setFileCreationMask, setFileTimes ) |
50 | import System.FilePath ( takeDirectory ) | 50 | import System.FilePath ( takeDirectory ) |
51 | import System.IO (hPutStrLn,withFile,IOMode(..)) | 51 | import System.IO (hPutStrLn,withFile,IOMode(..)) |
52 | import Data.Binary ( encode ) | 52 | import Data.Binary ( encode ) |
53 | import Data.IORef | ||
54 | import System.Posix.IO (fdToHandle,fdRead) | ||
55 | |||
56 | |||
53 | 57 | ||
54 | import qualified CryptoCoins as CryptoCoins | 58 | import qualified CryptoCoins as CryptoCoins |
55 | import Base58 | 59 | import Base58 |
@@ -610,6 +614,22 @@ seek_key (KeyUidMatch pat) ps = if null bs | |||
610 | uidStr _ = "" | 614 | uidStr _ = "" |
611 | 615 | ||
612 | 616 | ||
617 | cachedContents :: Posix.Fd -> IO (IO S.ByteString) | ||
618 | cachedContents fd = do | ||
619 | ref <- newIORef Nothing | ||
620 | return $ get ref fd | ||
621 | where | ||
622 | trimCR bs = fst $ S.spanEnd (\x -> x==10 || x==13) bs | ||
623 | |||
624 | get ref fd = do | ||
625 | pw <- readIORef ref | ||
626 | flip (flip maybe return) pw $ do | ||
627 | do pwh <- fdToHandle fd -- (read fd) | ||
628 | pw <- fmap trimCR $ S.hGetContents pwh | ||
629 | writeIORef ref (Just pw) | ||
630 | return pw | ||
631 | |||
632 | |||
613 | importPEMKey db' tup = do | 633 | importPEMKey db' tup = do |
614 | try db' $ \(db',report0) -> do | 634 | try db' $ \(db',report0) -> do |
615 | r <- doImport doDecrypt | 635 | r <- doImport doDecrypt |
@@ -1300,7 +1320,7 @@ secretToPublic pkt = pkt | |||
1300 | 1320 | ||
1301 | 1321 | ||
1302 | 1322 | ||
1303 | slurpWIPKeys :: System.Posix.Types.EpochTime -> L.ByteString -> ( [(Word8,Packet)], [L.ByteString]) | 1323 | slurpWIPKeys :: Posix.EpochTime -> L.ByteString -> ( [(Word8,Packet)], [L.ByteString]) |
1304 | slurpWIPKeys stamp "" = ([],[]) | 1324 | slurpWIPKeys stamp "" = ([],[]) |
1305 | slurpWIPKeys stamp cs = | 1325 | slurpWIPKeys stamp cs = |
1306 | let (b58,xs) = Char8.span (\x -> elem x base58chars) cs | 1326 | let (b58,xs) = Char8.span (\x -> elem x base58chars) cs |