screened 2024-08-11 18:35:57+00:00

src/Darcs/Util/ByteString.hs

@@ -18,6 +18,7 @@ module Darcs.Util.ByteString
     (
     -- * IO with mmap or gzip
       gzReadFilePS
+    , gzReadMmapFilePS
     , mmapFilePS
     , gzWriteFilePS
     , gzWriteFilePSs
@@ -84,10 +85,7 @@ import qualified Codec.Compression.Zlib.Internal as ZI
 import Darcs.Util.Encoding ( decode, encode, decodeUtf8, encodeUtf8 )
 import Darcs.Util.Global ( addCRCWarning )
 
-#if mingw32_HOST_OS
-#else
 import System.IO.MMap( mmapFileByteString )
-#endif
 import System.Mem( performGC )
 
 ------------------------------------------------------------------------
@@ -226,6 +224,23 @@ isGZFile f = do
 -- into a 'B.ByteString'.
 gzReadFilePS :: FilePath -> IO B.ByteString
 gzReadFilePS f = do
+    mlen <- isGZFile f
+    case mlen of
+       Nothing -> B.readFile f
+       Just len ->
+            do -- Passing the length to gzDecompress means that it produces produces one chunk,
+               -- which in turn means that B.concat won't need to copy data.
+               -- If the length is wrong this will just affect efficiency, not correctness
+               let doDecompress buf = let (res, bad) = gzDecompress (Just len) buf
+                                      in do when bad $ addCRCWarning f
+                                            return res
+               compressed <- (BL.fromChunks . return) `fmap` B.readFile f
+               B.concat `fmap` doDecompress compressed
+
+-- | Read an entire file, which may or may not be gzip compressed, directly
+-- into a 'B.ByteString'.
+gzReadMmapFilePS :: FilePath -> IO B.ByteString
+gzReadMmapFilePS f = do
     mlen <- isGZFile f
     case mlen of
        Nothing -> mmapFilePS f
@@ -310,17 +325,13 @@ readSegment (f,range) = do
 -- is modified.
 
 mmapFilePS :: FilePath -> IO B.ByteString
-#if mingw32_HOST_OS
-mmapFilePS = B.readFile
-#else
 mmapFilePS f =
   mmapFileByteString f Nothing
    `catchIOError` (\_ -> do
                      size <- getFileSize f
                      if size == 0
                         then return B.empty
                         else performGC >> mmapFileByteString f Nothing)
-#endif
 
 -- -------------------------------------------------------------------------
 -- fromPS2Hex

src/Darcs/Util/Cache.hs

@@ -59,8 +59,8 @@ import Darcs.Util.Exception ( catchall, handleOnly )
 import Darcs.Util.File
     ( Cachable(Cachable)
     , copyFileOrUrl
-    , fetchFilePS
-    , gzFetchFilePS
+    , fetchMmapFilePS
+    , gzFetchMmapFilePS
     , speculateFileOrUrl
     , withTemp
     )
@@ -399,10 +399,10 @@ fetchFileUsingCachePrivate fromWhere (Ca cache) hash = do
             debugMessage $
               "In fetchFileUsingCachePrivate I'm directly grabbing file contents from "
               ++ cacheFile
-            x <- gzFetchFilePS cacheFile Cachable
+            x <- gzFetchMmapFilePS cacheFile Cachable
             if not $ checkHash hash x
                 then do
-                    x' <- fetchFilePS cacheFile Cachable
+                    x' <- fetchMmapFilePS cacheFile Cachable
                     unless (checkHash hash x') $ do
                         hPutStrLn stderr $ "Hash failure in " ++ cacheFile
                         fail $ "Hash failure in " ++ cacheFile
@@ -414,12 +414,12 @@ fetchFileUsingCachePrivate fromWhere (Ca cache) hash = do
                 checkCacheReachability c
                 filterBadSources cs >>= ffuc
         | writable c = do
-            debugMessage $ "About to gzFetchFilePS from " ++ show cacheFile
-            x1 <- gzFetchFilePS cacheFile Cachable
-            debugMessage "gzFetchFilePS done."
+            debugMessage $ "About to gzFetchMmapFilePS from " ++ show cacheFile
+            x1 <- gzFetchMmapFilePS cacheFile Cachable
+            debugMessage "gzFetchMmapFilePS done."
             x <- if not $ checkHash hash x1
                      then do
-                        x2 <- fetchFilePS cacheFile Cachable
+                        x2 <- fetchMmapFilePS cacheFile Cachable
                         unless (checkHash hash x2) $ do
                             hPutStrLn stderr $ "Hash failure in " ++ cacheFile
                             removeFile cacheFile

src/Darcs/Util/File.hs

@@ -8,8 +8,10 @@ module Darcs.Util.File
     , copyTree
       -- * Fetching files
     , fetchFilePS
+    , fetchMmapFilePS
     , fetchFileLazyPS
     , gzFetchFilePS
+    , gzFetchMmapFilePS
     , speculateFileOrUrl
     , copyFileOrUrl
     , Cachable(..)
@@ -22,7 +24,7 @@ module Darcs.Util.File
     ) where
 
 import Darcs.Prelude
-import Darcs.Util.ByteString ( gzReadFilePS )
+import Darcs.Util.ByteString ( gzReadFilePS, gzReadMmapFilePS, mmapFilePS )
 import Darcs.Util.Exception ( catchall, ifDoesNotExistError )
 import Darcs.Util.Global ( defaultRemoteDarcsCmd )
 import Darcs.Util.HTTP ( Cachable(..) )
@@ -190,6 +192,10 @@ copyAndReadFile readfn fou cache = withTemp $ \t -> do
 fetchFilePS :: String -> Cachable -> IO B.ByteString
 fetchFilePS = copyAndReadFile B.readFile
 
+-- | Like 'fetchFilePS' but uses mmap, so use this only for hashed files.
+fetchMmapFilePS :: String -> Cachable -> IO B.ByteString
+fetchMmapFilePS = copyAndReadFile mmapFilePS
+
 -- | @fetchFileLazyPS fileOrUrl cache@ lazily reads the content of its argument
 -- (either a file or an URL). Warning: this function may constitute a fd leak;
 -- make sure to force consumption of file contents to avoid that. See
@@ -206,6 +212,11 @@ fetchFileLazyPS x c =
 gzFetchFilePS :: String -> Cachable -> IO B.ByteString
 gzFetchFilePS = copyAndReadFile gzReadFilePS
 
+-- | Like 'fetchFilePS' but transparently handle gzip compressed files.
+-- Uses mmap, so use this only for hashed files.
+gzFetchMmapFilePS :: String -> Cachable -> IO B.ByteString
+gzFetchMmapFilePS = copyAndReadFile gzReadMmapFilePS
+
 -- | Initiate background file download for the given file path or URL
 -- to the given location.
 speculateFileOrUrl :: String -> FilePath -> IO ()

src/Darcs/Util/Index.hs

@@ -129,6 +129,7 @@ import Darcs.Util.Progress ( beginTedious, endTedious, finishedOneIO )
 import Control.Monad( when )
 import Control.Exception( catch, SomeException )
 
+import qualified Data.ByteString as B
 import qualified Data.ByteString.Char8 as BC
 import Data.ByteString.Internal
     ( c2w, w2c
@@ -242,7 +243,7 @@ peekHash i = do
   return $ if h == nullHash then Nothing else Just (SHA256 h)
 
 nullHash :: BS.ShortByteString
-nullHash = BS.replicate size_hash 0
+nullHash = BS.toShort (B.replicate size_hash 0)
 
 type FileStatus = Maybe F.FileStatus