diff options
Diffstat (limited to 'lib')
-rw-r--r-- | lib/ByteStringUtil.hs | 23 | ||||
-rw-r--r-- | lib/KeyRing/BuildKeyDB.hs | 6 |
2 files changed, 27 insertions, 2 deletions
diff --git a/lib/ByteStringUtil.hs b/lib/ByteStringUtil.hs new file mode 100644 index 0000000..c6b509d --- /dev/null +++ b/lib/ByteStringUtil.hs | |||
@@ -0,0 +1,23 @@ | |||
1 | module ByteStringUtil where | ||
2 | |||
3 | import Data.ByteString.Lazy.Internal | ||
4 | import Data.ByteString.Lazy | ||
5 | import qualified Data.ByteString as S | ||
6 | import System.IO | ||
7 | import System.IO.Unsafe | ||
8 | |||
9 | oneMeg :: Int | ||
10 | oneMeg = 1048576 | ||
11 | |||
12 | hGetContentsN :: Int -> Handle -> IO ByteString | ||
13 | hGetContentsN kk h = lazyRead | ||
14 | where | ||
15 | k = kk - chunkOverhead | ||
16 | lazyRead = unsafeInterleaveIO loop | ||
17 | |||
18 | loop = do | ||
19 | c <- S.hGetSome h k -- only blocks if there is no data available | ||
20 | if S.null c | ||
21 | then hClose h >> return Empty | ||
22 | else do cs <- lazyRead | ||
23 | return (Chunk c cs) | ||
diff --git a/lib/KeyRing/BuildKeyDB.hs b/lib/KeyRing/BuildKeyDB.hs index ad47ed0..ba5bafe 100644 --- a/lib/KeyRing/BuildKeyDB.hs +++ b/lib/KeyRing/BuildKeyDB.hs | |||
@@ -91,7 +91,7 @@ import Foreign.Storable | |||
91 | import Data.IORef | 91 | import Data.IORef |
92 | import Data.Traversable (sequenceA) | 92 | import Data.Traversable (sequenceA) |
93 | import qualified Data.Traversable as Traversable | 93 | import qualified Data.Traversable as Traversable |
94 | import System.IO (stderr) | 94 | import System.IO (stderr,openFile,IOMode(ReadMode)) |
95 | 95 | ||
96 | import System.Posix.IO (fdToHandle) | 96 | import System.Posix.IO (fdToHandle) |
97 | #if ! MIN_VERSION_base(4,6,0) | 97 | #if ! MIN_VERSION_base(4,6,0) |
@@ -115,6 +115,7 @@ import KeyRing.Types | |||
115 | import Transforms | 115 | import Transforms |
116 | import PacketTranscoder | 116 | import PacketTranscoder |
117 | import GnuPGAgent | 117 | import GnuPGAgent |
118 | import ByteStringUtil | ||
118 | 119 | ||
119 | -- | buildKeyDB | 120 | -- | buildKeyDB |
120 | -- | 121 | -- |
@@ -611,7 +612,8 @@ readInputFileL ctx (Pipe fd _) = fdToHandle fd >>= L.hGetContents | |||
611 | readInputFileL ctx (FileDesc fd) = fdToHandle fd >>= L.hGetContents | 612 | readInputFileL ctx (FileDesc fd) = fdToHandle fd >>= L.hGetContents |
612 | readInputFileL ctx inp = do | 613 | readInputFileL ctx inp = do |
613 | let fname = resolveInputFile ctx inp | 614 | let fname = resolveInputFile ctx inp |
614 | fmap L.concat $ mapM L.readFile fname | 615 | hs <- mapM (`openFile` ReadMode) fname |
616 | fmap L.concat $ mapM (hGetContentsN oneMeg) hs | ||
615 | 617 | ||
616 | getInputFileTime :: InputFileContext -> InputFile -> IO CTime | 618 | getInputFileTime :: InputFileContext -> InputFile -> IO CTime |
617 | getInputFileTime ctx (Pipe fdr fdw) = do | 619 | getInputFileTime ctx (Pipe fdr fdw) = do |