From: Simon Marlow <simonmar@microsoft.com>
Date: Thu, 23 Aug 2007 11:16:05 +0000 (+0000)
Subject: FIX #1280: getPermissions wasn't working on Vista
X-Git-Tag: 2007-09-13~2
X-Git-Url: http://git.megacz.com/?p=haskell-directory.git;a=commitdiff_plain;h=b33cc8f0d60e7ab53a916bff339ff40a677e0a62

FIX #1280: getPermissions wasn't working on Vista
It turns out that _access() in the Windows C runtime used to ignore
the X_OK flag, in Vista it now returns an error.  After browsing the C
runtime sources, I discovered that _stat() has an almost but not quite
completely bogus implementation of the st_mode field, which lets us
implement a slightly less incorrect approximation to getPermissions than does
_access().
---

diff --git a/System/Directory.hs b/System/Directory.hs
index 1f624a1..e7affb6 100644
--- a/System/Directory.hs
+++ b/System/Directory.hs
@@ -155,6 +155,29 @@ The operation may fail with:
 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
@@ -168,6 +191,7 @@ getPermissions name = do
       searchable = is_dir && exec == 0
     }
    )
+#endif
 
 {- |The 'setPermissions' operation sets the
 permissions for the file or directory.
@@ -849,6 +873,7 @@ foreign import ccall unsafe "__hscore_X_OK" x_OK :: CInt
 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
diff --git a/include/HsDirectory.h b/include/HsDirectory.h
index 7185dc8..7f33f08 100644
--- a/include/HsDirectory.h
+++ b/include/HsDirectory.h
@@ -77,6 +77,7 @@ INLINE int __hscore_X_OK() { return X_OK; }
 INLINE mode_t __hscore_S_IRUSR() { return S_IRUSR; }
 INLINE mode_t __hscore_S_IWUSR() { return S_IWUSR; }
 INLINE mode_t __hscore_S_IXUSR() { return S_IXUSR; }
+INLINE mode_t __hscore_S_IFDIR() { return S_IFDIR; }
 #endif
 
 #if defined(__MINGW32__)