summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--kiki.cabal3
-rw-r--r--lib/ByteStringUtil.hs23
-rw-r--r--lib/KeyRing/BuildKeyDB.hs6
3 files changed, 29 insertions, 3 deletions
diff --git a/kiki.cabal b/kiki.cabal
index 293cc30..d790af7 100644
--- a/kiki.cabal
+++ b/kiki.cabal
@@ -94,7 +94,8 @@ library
94 Numeric.Interval.Bounded, 94 Numeric.Interval.Bounded,
95 SuperOrd, 95 SuperOrd,
96 FunctorToMaybe, 96 FunctorToMaybe,
97 GnuPGAgent 97 GnuPGAgent,
98 ByteStringUtil
98 other-modules: TimeUtil, 99 other-modules: TimeUtil,
99 ControlMaybe, 100 ControlMaybe,
100 Compat, 101 Compat,
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 @@
1module ByteStringUtil where
2
3import Data.ByteString.Lazy.Internal
4import Data.ByteString.Lazy
5import qualified Data.ByteString as S
6import System.IO
7import System.IO.Unsafe
8
9oneMeg :: Int
10oneMeg = 1048576
11
12hGetContentsN :: Int -> Handle -> IO ByteString
13hGetContentsN 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
91import Data.IORef 91import Data.IORef
92import Data.Traversable (sequenceA) 92import Data.Traversable (sequenceA)
93import qualified Data.Traversable as Traversable 93import qualified Data.Traversable as Traversable
94import System.IO (stderr) 94import System.IO (stderr,openFile,IOMode(ReadMode))
95 95
96import System.Posix.IO (fdToHandle) 96import 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
115import Transforms 115import Transforms
116import PacketTranscoder 116import PacketTranscoder
117import GnuPGAgent 117import GnuPGAgent
118import ByteStringUtil
118 119
119-- | buildKeyDB 120-- | buildKeyDB
120-- 121--
@@ -611,7 +612,8 @@ readInputFileL ctx (Pipe fd _) = fdToHandle fd >>= L.hGetContents
611readInputFileL ctx (FileDesc fd) = fdToHandle fd >>= L.hGetContents 612readInputFileL ctx (FileDesc fd) = fdToHandle fd >>= L.hGetContents
612readInputFileL ctx inp = do 613readInputFileL 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
616getInputFileTime :: InputFileContext -> InputFile -> IO CTime 618getInputFileTime :: InputFileContext -> InputFile -> IO CTime
617getInputFileTime ctx (Pipe fdr fdw) = do 619getInputFileTime ctx (Pipe fdr fdw) = do