Make sure sdist is robust to accidentally-listed directories

The refactor of the globbing modules re-uncovered this issue, and required a prompt fix for the refactor not to break some things. Fixes haskell#5349
alt-romes · Jan 31, 2024 · fdd418b · fdd418b
1 parent 86691ea
commit fdd418b
Show file tree

Hide file tree

Showing 10 changed files with 48 additions and 24 deletions.
diff --git a/Cabal/src/Distribution/Simple/SrcDist.hs b/Cabal/src/Distribution/Simple/SrcDist.hs
@@ -245,20 +245,24 @@ listPackageSources' verbosity rip cwd pkg_descr pps =
     , -- Data files.
       fmap concat
         . for (dataFiles pkg_descr)
-        $ \filename -> do
-          let srcDataDirRaw = dataDir pkg_descr
-              srcDataDir
-                | null srcDataDirRaw = "."
-                | otherwise = srcDataDirRaw
-          matchDirFileGlobWithDie verbosity rip (specVersion pkg_descr) cwd (srcDataDir </> filename)
+        $ \filename ->
+          do
+            let srcDataDirRaw = dataDir pkg_descr
+                srcDataDir
+                  | null srcDataDirRaw = "."
+                  | otherwise = srcDataDirRaw
+            matchDirFileGlobWithDie verbosity rip (specVersion pkg_descr) cwd (srcDataDir </> filename)
+            >>= filterOutDirectories "data-files"
     , -- Extra source files.
       fmap concat . for (extraSrcFiles pkg_descr) $ \fpath ->
         matchDirFileGlobWithDie verbosity rip (specVersion pkg_descr) cwd fpath
+          >>= filterOutDirectories "extra-source-files"
     , -- Extra doc files.
       fmap concat
         . for (extraDocFiles pkg_descr)
         $ \filename ->
           matchDirFileGlobWithDie verbosity rip (specVersion pkg_descr) cwd filename
+            >>= filterOutDirectories "extra-doc-files"
     , -- License file(s).
       return (map getSymbolicPath $ licenseFiles pkg_descr)
     , -- Install-include files, without autogen-include files
@@ -283,6 +287,19 @@ listPackageSources' verbosity rip cwd pkg_descr pps =
     withAllTest action = traverse action (testSuites pkg_descr)
     withAllBenchmark action = traverse action (benchmarks pkg_descr)
 
+    -- For data-files, extra-source-files, and extra-doc-files, we filter out
+    -- directories since the function must only return paths to files. This
+    -- filtering is necessary because globs may match directories.
+    filterOutDirectories loc matches = flip filterM matches $ \path -> do
+      isFile <- doesFileExist path
+      -- Must be a directory, since it is a path that matched the glob and
+      -- isn't a file.
+      if isFile
+        then return True
+        else do
+          warn verbosity $ "Ignoring directory '" ++ path ++ "'" ++ " listed in field '" ++ loc ++ "' in the Cabal package. This field can only include files (not directories)."
+          return False
+
 -- | Prepare a directory tree of source files.
 prepareTree
   :: Verbosity

diff --git a/cabal-testsuite/PackageTests/SDist/T5195/cabal.out b/cabal-testsuite/PackageTests/SDist/T5195/cabal.out
diff --git a/cabal-testsuite/PackageTests/SDist/T5195/cabal.test.hs b/cabal-testsuite/PackageTests/SDist/T5195/cabal.test.hs
diff --git a/cabal-testsuite/PackageTests/SDist/T5195/t5195.cabal b/cabal-testsuite/PackageTests/SDist/T5195/t5195.cabal
diff --git a/...estsuite/PackageTests/SDist/T5195/Main.hs → ...e/PackageTests/SDist/T5195and5349/Main.hs b/...estsuite/PackageTests/SDist/T5195/Main.hs → ...e/PackageTests/SDist/T5195and5349/Main.hs
diff --git a/...Dist/T5195/actually-a-directory/some-file → ...195and5349/actually-a-directory/some-file b/...Dist/T5195/actually-a-directory/some-file → ...195and5349/actually-a-directory/some-file
diff --git a/cabal-testsuite/PackageTests/SDist/T5195and5349/actually-a-file b/cabal-testsuite/PackageTests/SDist/T5195and5349/actually-a-file
@@ -0,0 +1 @@
+Hi
diff --git a/...te/PackageTests/SDist/T5195/cabal.project → ...ageTests/SDist/T5195and5349/cabal.project b/...te/PackageTests/SDist/T5195/cabal.project → ...ageTests/SDist/T5195and5349/cabal.project
diff --git a/cabal-testsuite/PackageTests/SDist/T5195and5349/cabal.test.hs b/cabal-testsuite/PackageTests/SDist/T5195and5349/cabal.test.hs
@@ -0,0 +1,5 @@
+import Test.Cabal.Prelude
+main = cabalTest $ do
+  tmpdir <- fmap testTmpDir getTestEnv
+  cabal' "v2-sdist" ["--list-only", "--output-directory", tmpdir]
+  return ()
diff --git a/cabal-testsuite/PackageTests/SDist/T5195and5349/t5195and5349.cabal b/cabal-testsuite/PackageTests/SDist/T5195and5349/t5195and5349.cabal
@@ -0,0 +1,19 @@
+cabal-version: 2.2
+name: t5195and5349
+version: 0
+
+extra-source-files:
+  ./actually-a-directory
+  ./actually-a-file
+
+extra-doc-files:
+  ./actually-a-directory
+  ./actually-a-file
+
+data-files:
+  ./actually-a-directory
+  ./actually-a-file
+
+executable foo
+  default-language: Haskell2010
+  main-is: Main.hs