From: simonmar <unknown>
Date: Thu, 21 Jul 2005 09:26:30 +0000 (+0000)
Subject: [project @ 2005-07-21 09:26:30 by simonmar]
X-Git-Tag: cmm-merge2~52
X-Git-Url: http://git.megacz.com/?p=haskell-directory.git;a=commitdiff_plain;h=d4aaa2cbdb06a88d99545da53d3da69b48702b1e

[project @ 2005-07-21 09:26:30 by simonmar]
copyFile: copy the permissions properly (don't use getPermissions >>=
setPermissions, which only copies the owner's permissions on Unix).
---

diff --git a/System/Directory.hs b/System/Directory.hs
index 8db9686..d5bbd84 100644
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -194,6 +194,16 @@ setPermissions name (Permissions r w e s) = do
    modifyBit False m b = m .&. (complement b)
    modifyBit True  m b = m .|. b
 
+
+copyPermissions :: FilePath -> FilePath -> IO ()
+copyPermissions source dest = do
+  allocaBytes sizeof_stat $ \ p_stat -> do
+  withCString source $ \p_source -> do
+  withCString dest $ \p_dest -> do
+    throwErrnoIfMinus1_ "copyPermissions" $ c_stat p_source p_stat
+    mode <- st_mode p_stat
+    throwErrnoIfMinus1_ "copyPermissions" $ c_chmod p_dest mode
+
 -----------------------------------------------------------------------------
 -- Implementation
 
@@ -493,14 +503,14 @@ copyFile :: FilePath -> FilePath -> IO ()
 copyFile fromFPath toFPath =
 #if (!(defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 600))
 	do readFile fromFPath >>= writeFile toFPath
-	   try (getPermissions fromFPath >>= setPermissions toFPath)
+	   try (copyPermissions fromFPath toFPath)
 	   return ()
 #else
 	(bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
 	 bracket (openBinaryFile toFPath WriteMode) hClose $ \hTo ->
 	 allocaBytes bufferSize $ \buffer -> do
 		copyContents hFrom hTo buffer
-		try (getPermissions fromFPath >>= setPermissions toFPath)
+		try (copyPermissions fromFPath toFPath)
 		return ()) `catch` (ioError . changeFunName)
 	where
 		bufferSize = 1024