import System.Environment ( getEnv )
import System.FilePath
+import System.IO
import System.IO.Error hiding ( catch, try )
import Control.Monad ( when, unless )
import Control.Exception
#ifdef __NHC__
import Directory
+import System (system)
#endif /* __NHC__ */
#ifdef __HUGS__
import System.Posix.Types
import System.Posix.Internals
import System.Time ( ClockTime(..) )
-import System.IO
import GHC.IOBase ( IOException(..), IOErrorType(..), ioException )
reference to a file system object (file, directory etc.). Some
entries may be hidden, inaccessible, or have some administrative
function (e.g. `.' or `..' under POSIX
-<http://www.opengroup.org/onlinepubs/007904975/toc.htm>), but in
+<http://www.opengroup.org/onlinepubs/009695399/>), but in
this standard all such entries are considered to form part of the
directory contents. Entries in sub-directories are not, however,
considered to form part of the directory contents.
getPermissions :: FilePath -> IO Permissions
getPermissions name = do
withCString name $ \s -> do
+#ifdef mingw32_HOST_OS
+ -- stat() does a better job of guessing the permissions on Windows
+ -- than access() does. e.g. for execute permission, it looks at the
+ -- filename extension :-)
+ --
+ -- I tried for a while to do this properly, using the Windows security API,
+ -- and eventually gave up. getPermissions is a flawed API anyway. -- SimonM
+ allocaBytes sizeof_stat $ \ p_stat -> do
+ throwErrnoIfMinus1_ "getPermissions" $ c_stat s p_stat
+ mode <- st_mode p_stat
+ let read = mode .&. s_IRUSR
+ let write = mode .&. s_IWUSR
+ let exec = mode .&. s_IXUSR
+ let is_dir = mode .&. s_IFDIR
+ return (
+ Permissions {
+ readable = read /= 0,
+ writable = write /= 0,
+ executable = is_dir == 0 && exec /= 0,
+ searchable = is_dir /= 0 && exec /= 0
+ }
+ )
+#else
read <- c_access s r_OK
write <- c_access s w_OK
exec <- c_access s x_OK
searchable = is_dir && exec == 0
}
)
+#endif
{- |The 'setPermissions' operation sets the
permissions for the file or directory.
-}
copyFile :: FilePath -> FilePath -> IO ()
+#ifdef __NHC__
+copyFile fromFPath toFPath =
+ do readFile fromFPath >>= writeFile toFPath
+ try (copyPermissions fromFPath toFPath)
+ return ()
+#else
copyFile fromFPath toFPath =
copy `catch` (\e -> case e of
IOException e ->
bracketOnError openTmp cleanTmp $ \(tmpFPath, hTmp) ->
do allocaBytes bufferSize $ copyContents hFrom hTmp
hClose hTmp
- try (copyPermissions fromFPath toFPath)
+ try (copyPermissions fromFPath tmpFPath)
renameFile tmpFPath toFPath
openTmp = openBinaryTempFile (takeDirectory toFPath) ".copyFile.tmp"
cleanTmp (tmpFPath, hTmp) = do try $ hClose hTmp
when (count > 0) $ do
hPutBuf hTo buffer count
copyContents hFrom hTo buffer
+#endif
-- | Given path referring to a file or directory, returns a
-- canonicalized path, with the intent that two paths referring
#else
do c_realpath pInPath pOutPath
#endif
- peekCString pOutPath
+ path <- peekCString pOutPath
+ return (normalise path)
+ -- normalise does more stuff, like upper-casing the drive letter
#if defined(mingw32_HOST_OS)
foreign import stdcall unsafe "GetFullPathNameA"
foreign import ccall unsafe "__hscore_S_IRUSR" s_IRUSR :: CMode
foreign import ccall unsafe "__hscore_S_IWUSR" s_IWUSR :: CMode
foreign import ccall unsafe "__hscore_S_IXUSR" s_IXUSR :: CMode
+foreign import ccall unsafe "__hscore_S_IFDIR" s_IFDIR :: CMode
foreign import ccall unsafe "__hscore_long_path_size"
long_path_size :: Int
r <- c_GetTempPath (fromIntegral long_path_size) pPath
peekCString pPath
#else
- catch (getEnv "TMPDIR") (\ex -> return "/tmp")
+ getEnv "TMPDIR"
+#if !__NHC__
+ `catch` \ex -> case ex of
+ IOException e | isDoesNotExistError e -> return "/tmp"
+ _ -> throw ex
+#else
+ `catch` (\ex -> return "/tmp")
+#endif
#endif
#if defined(mingw32_HOST_OS)