From a170937c783df07ad4da653566a2cf6eafbe3566 Mon Sep 17 00:00:00 2001
From: Cheng Shao <terrorjack@type.dance>
Date: Tue, 13 Dec 2022 11:03:11 +0000
Subject: [PATCH] Add missing autoconf checks for chown/fchdir/fchmod

These are not present in wasm32-wasi, and is needed for fixing GHC #22589.
---
 System/Posix/Directory/Common.hsc  | 15 +++++++++++++++
 System/Posix/Files.hsc             | 12 +++++++++++-
 System/Posix/Files/ByteString.hsc  | 12 +++++++++++-
 System/Posix/Files/Common.hsc      | 25 +++++++++++++++++++++++++
 System/Posix/Files/PosixString.hsc | 12 +++++++++++-
 configure.ac                       |  1 +
 6 files changed, 74 insertions(+), 3 deletions(-)

diff --git a/System/Posix/Directory/Common.hsc b/System/Posix/Directory/Common.hsc
index 897b94e..e4aa765 100644
--- a/System/Posix/Directory/Common.hsc
+++ b/System/Posix/Directory/Common.hsc
@@ -36,6 +36,11 @@ import System.Posix.Types
 import Foreign hiding (void)
 import Foreign.C
 
+#if !defined(HAVE_FCHDIR)
+import System.IO.Error ( ioeSetLocation )
+import GHC.IO.Exception ( unsupportedOperation )
+#endif
+
 newtype DirStream = DirStream (Ptr CDir)
 
 data {-# CTYPE "DIR" #-} CDir
@@ -111,9 +116,19 @@ foreign import ccall unsafe "telldir"
   c_telldir :: Ptr CDir -> IO CLong
 #endif
 
+#if defined(HAVE_FCHDIR)
+
 changeWorkingDirectoryFd :: Fd -> IO ()
 changeWorkingDirectoryFd (Fd fd) =
   throwErrnoIfMinus1Retry_ "changeWorkingDirectoryFd" (c_fchdir fd)
 
 foreign import ccall unsafe "fchdir"
   c_fchdir :: CInt -> IO CInt
+
+#else
+
+{-# WARNING changeWorkingDirectoryFd "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_FCHDIR@)" #-}
+changeWorkingDirectoryFd :: Fd -> IO ()
+changeWorkingDirectoryFd _ = ioError (ioeSetLocation unsupportedOperation "changeWorkingDirectoryFd")
+
+#endif // HAVE_FCHDIR
diff --git a/System/Posix/Files.hsc b/System/Posix/Files.hsc
index 85605ee..3e982f7 100644
--- a/System/Posix/Files.hsc
+++ b/System/Posix/Files.hsc
@@ -108,7 +108,7 @@ import Data.Monoid ((<>))
 
 import Data.Time.Clock.POSIX (POSIXTime)
 
-#if !defined(HAVE_MKNOD)
+#if !defined(HAVE_MKNOD) || !defined(HAVE_CHOWN)
 import System.IO.Error ( ioeSetLocation )
 import GHC.IO.Exception ( unsupportedOperation )
 #endif
@@ -323,6 +323,8 @@ foreign import ccall unsafe "rename"
 -- -----------------------------------------------------------------------------
 -- chown()
 
+#if defined(HAVE_CHOWN)
+
 -- | @setOwnerAndGroup path uid gid@ changes the owner and group of @path@ to
 -- @uid@ and @gid@, respectively.
 --
@@ -337,6 +339,14 @@ setOwnerAndGroup name uid gid = do
 foreign import ccall unsafe "chown"
   c_chown :: CString -> CUid -> CGid -> IO CInt
 
+#else
+
+{-# WARNING setOwnerAndGroup "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_CHOWN@)" #-}
+setOwnerAndGroup :: FilePath -> UserID -> GroupID -> IO ()
+setOwnerAndGroup _ _ _ = ioError (ioeSetLocation unsupportedOperation "setOwnerAndGroup")
+
+#endif // HAVE_CHOWN
+
 #if HAVE_LCHOWN
 -- | Acts as 'setOwnerAndGroup' but does not follow symlinks (and thus
 -- changes permissions on the link itself).
diff --git a/System/Posix/Files/ByteString.hsc b/System/Posix/Files/ByteString.hsc
index 347ebfd..5430f83 100644
--- a/System/Posix/Files/ByteString.hsc
+++ b/System/Posix/Files/ByteString.hsc
@@ -109,7 +109,7 @@ import System.Posix.ByteString.FilePath
 
 import Data.Time.Clock.POSIX (POSIXTime)
 
-#if !defined(HAVE_MKNOD)
+#if !defined(HAVE_MKNOD) || !defined(HAVE_CHOWN)
 import System.IO.Error ( ioeSetLocation )
 import GHC.IO.Exception ( unsupportedOperation )
 #endif
@@ -319,6 +319,8 @@ foreign import ccall unsafe "rename"
 -- -----------------------------------------------------------------------------
 -- chown()
 
+#if defined(HAVE_CHOWN)
+
 -- | @setOwnerAndGroup path uid gid@ changes the owner and group of @path@ to
 -- @uid@ and @gid@, respectively.
 --
@@ -333,6 +335,14 @@ setOwnerAndGroup name uid gid = do
 foreign import ccall unsafe "chown"
   c_chown :: CString -> CUid -> CGid -> IO CInt
 
+#else
+
+{-# WARNING setOwnerAndGroup "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_CHOWN@)" #-}
+setOwnerAndGroup :: RawFilePath -> UserID -> GroupID -> IO ()
+setOwnerAndGroup _ _ _ = ioError (ioeSetLocation unsupportedOperation "setOwnerAndGroup")
+
+#endif // HAVE_CHOWN
+
 #if HAVE_LCHOWN
 -- | Acts as 'setOwnerAndGroup' but does not follow symlinks (and thus
 -- changes permissions on the link itself).
diff --git a/System/Posix/Files/Common.hsc b/System/Posix/Files/Common.hsc
index 7aef5ce..61f19da 100644
--- a/System/Posix/Files/Common.hsc
+++ b/System/Posix/Files/Common.hsc
@@ -98,6 +98,11 @@ import Foreign.Marshal (withArray)
 import Foreign.Ptr
 import Foreign.Storable
 
+#if !defined(HAVE_FCHMOD) || !defined(HAVE_CHOWN)
+import System.IO.Error ( ioeSetLocation )
+import GHC.IO.Exception ( unsupportedOperation )
+#endif
+
 -- -----------------------------------------------------------------------------
 -- POSIX file modes
 
@@ -208,6 +213,8 @@ symbolicLinkMode = (#const S_IFLNK)
 socketMode :: FileMode
 socketMode = (#const S_IFSOCK)
 
+#if defined(HAVE_FCHMOD)
+
 -- | @setFdMode fd mode@ acts like 'setFileMode' but uses a file descriptor
 -- @fd@ instead of a 'FilePath'.
 --
@@ -219,6 +226,14 @@ setFdMode (Fd fd) m =
 foreign import ccall unsafe "fchmod"
   c_fchmod :: CInt -> CMode -> IO CInt
 
+#else
+
+{-# WARNING setFdMode "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_FCHMOD@)" #-}
+setFdMode :: Fd -> FileMode -> IO ()
+setFdMode _ _ = ioError (ioeSetLocation unsupportedOperation "setFdMode")
+
+#endif // HAVE_FCHMOD
+
 -- | @setFileCreationMask mode@ sets the file mode creation mask to @mode@.
 -- Modes set by this operation are subtracted from files and directories upon
 -- creation. The previous file creation mask is returned.
@@ -540,6 +555,8 @@ touchFd =
 -- -----------------------------------------------------------------------------
 -- fchown()
 
+#if defined(HAVE_CHOWN)
+
 -- | Acts as 'setOwnerAndGroup' but uses a file descriptor instead of a
 -- 'FilePath'.
 --
@@ -551,6 +568,14 @@ setFdOwnerAndGroup (Fd fd) uid gid =
 foreign import ccall unsafe "fchown"
   c_fchown :: CInt -> CUid -> CGid -> IO CInt
 
+#else
+
+{-# WARNING setFdOwnerAndGroup "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_CHOWN@)" #-}
+setFdOwnerAndGroup :: Fd -> UserID -> GroupID -> IO ()
+setFdOwnerAndGroup _ _ _ = ioError (ioeSetLocation unsupportedOperation "setFdOwnerAndGroup")
+
+#endif // HAVE_CHOWN
+
 -- -----------------------------------------------------------------------------
 -- ftruncate()
 
diff --git a/System/Posix/Files/PosixString.hsc b/System/Posix/Files/PosixString.hsc
index 95149b0..2d72ce9 100644
--- a/System/Posix/Files/PosixString.hsc
+++ b/System/Posix/Files/PosixString.hsc
@@ -107,7 +107,7 @@ import System.Posix.PosixPath.FilePath
 
 import Data.Time.Clock.POSIX (POSIXTime)
 
-#if !defined(HAVE_MKNOD)
+#if !defined(HAVE_MKNOD) || !defined(HAVE_CHOWN)
 import System.IO.Error ( ioeSetLocation )
 import GHC.IO.Exception ( unsupportedOperation )
 #endif
@@ -316,6 +316,8 @@ foreign import ccall unsafe "rename"
 -- -----------------------------------------------------------------------------
 -- chown()
 
+#if defined(HAVE_CHOWN)
+
 -- | @setOwnerAndGroup path uid gid@ changes the owner and group of @path@ to
 -- @uid@ and @gid@, respectively.
 --
@@ -330,6 +332,14 @@ setOwnerAndGroup name uid gid = do
 foreign import ccall unsafe "chown"
   c_chown :: CString -> CUid -> CGid -> IO CInt
 
+#else
+
+{-# WARNING setOwnerAndGroup "operation will throw 'IOError' \"unsupported operation\" (CPP guard: @#if HAVE_CHOWN@)" #-}
+setOwnerAndGroup :: PosixPath -> UserID -> GroupID -> IO ()
+setOwnerAndGroup _ _ _ = ioError (ioeSetLocation unsupportedOperation "setOwnerAndGroup")
+
+#endif // HAVE_CHOWN
+
 #if HAVE_LCHOWN
 -- | Acts as 'setOwnerAndGroup' but does not follow symlinks (and thus
 -- changes permissions on the link itself).
diff --git a/configure.ac b/configure.ac
index e548f10..d7d09a5 100644
--- a/configure.ac
+++ b/configure.ac
@@ -42,6 +42,7 @@ AC_CHECK_FUNCS([mknod])
 AC_CHECK_FUNCS([mkstemp])
 AC_CHECK_FUNCS([pipe])
 AC_CHECK_FUNCS([times])
+AC_CHECK_FUNCS([chown fchdir fchmod])
 
 AC_CHECK_TYPE([struct rlimit],[AC_DEFINE([HAVE_STRUCT_RLIMIT],[1],[HAVE_STRUCT_RLIMIT])],[],[#include <sys/resource.h>])
 
-- 
GitLab