Merge pull request haskell#5558 from typedrat/fix-sdist-fd-leak

Fix haskell#5541.

cabal-install/Distribution/Client/CmdSdist.hs

@@ -72,6 +72,7 @@ import Control.Monad.Writer.Lazy
     ( WriterT, tell, execWriterT )
 import Data.Bits
     ( shiftL )
+import qualified Data.ByteString.Char8      as BS
 import qualified Data.ByteString.Lazy.Char8 as BSL
 import Data.Either
     ( partitionEithers )
@@ -259,7 +260,7 @@ packageToSdist verbosity projectRootDir format outputFile pkg = do
                                 Left err -> liftIO $ die' verbosity ("Error packing sdist: " ++ err)
                                 Right path -> tell [Tar.directoryEntry path]
 
-                        contents <- liftIO $ BSL.readFile file
+                        contents <- liftIO . fmap BSL.fromStrict . BS.readFile $ file
                         case Tar.toTarPath False (prefix </> file) of
                             Left err -> liftIO $ die' verbosity ("Error packing sdist: " ++ err)
                             Right path -> tell [(Tar.fileEntry path contents) { Tar.entryPermissions = perm' }]

cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/Main.hs

@@ -0,0 +1,4 @@
+module Main (main) where
+
+main :: IO ()
+main = putStrLn "Hello, World!"

cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/cabal.project

@@ -0,0 +1 @@
+packages: .

cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/many-data-files.cabal

@@ -0,0 +1,9 @@
+cabal-version: 2.2
+name: many-data-files
+version: 0
+
+data-files: data/*.txt
+
+executable dummy
+    default-language: Haskell2010
+    main-is: Main.hs

cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/many-data-files.out

@@ -0,0 +1,2 @@
+# cabal new-sdist
+Wrote tarball sdist to <ROOT>/many-data-files.dist/source/dist-newstyle/sdist/many-data-files-0.tar.gz

cabal-testsuite/PackageTests/NewSdist/ManyDataFiles/many-data-files.test.hs

@@ -0,0 +1,17 @@
+import Test.Cabal.Prelude
+
+import Control.Applicative ((<$>))
+import System.Directory ( createDirectoryIfMissing )
+import qualified Data.ByteString.Char8 as BS
+
+main = cabalTest . withSourceCopy $ do
+    limit <- getOpenFilesLimit
+    cwd <- testCurrentDir <$> getTestEnv
+
+    case limit of
+        Just n -> do
+            liftIO $ createDirectoryIfMissing False (cwd </> "data")
+            forM_ [1 .. n + 100] $ \i -> 
+                liftIO $ BS.writeFile (cwd </> "data" </> ("data-file-" ++ show i) <.> "txt") (BS.pack "a data file\n")
+            cabal "new-sdist" ["many-data-files"]
+        Nothing -> skip

cabal-testsuite/Test/Cabal/Prelude.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NondecreasingIndentation #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE CPP #-}
@@ -61,6 +62,7 @@ import System.Directory
 #ifndef mingw32_HOST_OS
 import Control.Monad.Catch ( bracket_ )
 import System.Posix.Files  ( createSymbolicLink )
+import System.Posix.Resource
 #endif
 
 ------------------------------------------------------------------------
@@ -804,6 +806,19 @@ isOSX = return (buildOS == OSX)
 isLinux :: TestM Bool
 isLinux = return (buildOS == Linux)
 
+getOpenFilesLimit :: TestM (Maybe Integer)
+#ifdef mingw32_HOST_OS
+-- No MS-specified limit, was determined experimentally on Windows 10 Pro x64,
+-- matches other online reports from other versions of Windows.
+getOpenFilesLimit = return (Just 2048)
+#else
+getOpenFilesLimit = liftIO $ do
+    ResourceLimits { softLimit } <- getResourceLimit ResourceOpenFiles
+    case softLimit of
+        ResourceLimit n -> return (Just n)
+        _ -> return Nothing
+#endif
+
 hasCabalForGhc :: TestM Bool
 hasCabalForGhc = do
     env <- getTestEnv