From 4e87e15398728286efeacdb54d3feba6070ed1b1 Mon Sep 17 00:00:00 2001
From: Joe Crayne <joe@jerkface.net>
Date: Tue, 2 Jul 2019 05:30:36 -0400
Subject: Read packet file with larger chunk size.

---
 lib/ByteStringUtil.hs     | 23 +++++++++++++++++++++++
 lib/KeyRing/BuildKeyDB.hs |  6 ++++--
 2 files changed, 27 insertions(+), 2 deletions(-)
 create mode 100644 lib/ByteStringUtil.hs

(limited to 'lib')

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 @@
+module ByteStringUtil where
+
+import Data.ByteString.Lazy.Internal
+import Data.ByteString.Lazy
+import qualified Data.ByteString as S
+import System.IO
+import System.IO.Unsafe
+
+oneMeg :: Int
+oneMeg = 1048576
+
+hGetContentsN :: Int -> Handle -> IO ByteString
+hGetContentsN kk h = lazyRead
+  where
+    k = kk - chunkOverhead
+    lazyRead = unsafeInterleaveIO loop
+
+    loop = do
+        c <- S.hGetSome h k -- only blocks if there is no data available
+        if S.null c
+          then hClose h >> return Empty
+          else do cs <- lazyRead
+                  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
 import           Data.IORef
 import           Data.Traversable           (sequenceA)
 import qualified Data.Traversable           as Traversable
-import           System.IO                  (stderr)
+import           System.IO                  (stderr,openFile,IOMode(ReadMode))
 
 import           System.Posix.IO            (fdToHandle)
 #if ! MIN_VERSION_base(4,6,0)
@@ -115,6 +115,7 @@ import           KeyRing.Types
 import           Transforms
 import           PacketTranscoder
 import           GnuPGAgent
+import           ByteStringUtil
 
 -- | buildKeyDB
 --
@@ -611,7 +612,8 @@ readInputFileL ctx (Pipe fd _)   = fdToHandle fd >>= L.hGetContents
 readInputFileL ctx (FileDesc fd) = fdToHandle fd >>= L.hGetContents
 readInputFileL ctx inp = do
     let fname = resolveInputFile ctx inp
-    fmap L.concat $ mapM L.readFile fname
+    hs <- mapM (`openFile` ReadMode) fname
+    fmap L.concat $ mapM (hGetContentsN oneMeg) hs
 
 getInputFileTime :: InputFileContext -> InputFile -> IO CTime
 getInputFileTime ctx (Pipe fdr fdw) = do
-- 
cgit v1.2.3