Make findExecutable return Nothing on absolute paths that aren't executable

Fixes #187.

Author: Rufflewind

System/Directory/Internal/Windows.hsc

@@ -24,6 +24,8 @@ import GHC.IO.SubSystem (IoSubSystem(IoPOSIX, IoNative), ioSubSystem)
 #endif
 import System.OsPath
   ( (</>)
+  , hasExtension
+  , isExtensionOf
   , isPathSeparator
   , isRelative
   , pack
@@ -428,12 +430,18 @@ canonicalizePathSimplify path =
       pure path
 
 searchPathEnvForExes :: OsString -> IO (Maybe OsPath)
-searchPathEnvForExes (OsString binary) = search `catch` \e ->
-  if ioeGetErrorType e == InvalidArgument
-  then pure Nothing
-  else throwIO e
+searchPathEnvForExes binaryPath@(OsString binary) = do
+  maybePath <- search
+    `catch` \e ->
+      if ioeGetErrorType e == InvalidArgument
+      then pure Nothing
+      else throwIO e
+  pure (OsString <$> maybePath >>= verify)
  where
-  search = (OsString <$>) <$> Win32.searchPath Nothing binary (Just (getOsString exeExtension))
+  search = Win32.searchPath Nothing binary (Just (getOsString exeExtension))
+  verify p
+    | hasExtension binaryPath || exeExtension `isExtensionOf` p = Just p
+    | otherwise = Nothing
 
 findExecutablesLazyInternal :: ([OsPath] -> OsString -> ListT IO OsPath)
                             -> OsString

directory.cabal

@@ -102,6 +102,7 @@ test-suite test
         DoesDirectoryExist001
         DoesPathExist
         FileTime
+        FindExecutable
         FindFile001
         GetDirContents001
         GetDirContents002

tests/FindExecutable.hs

@@ -0,0 +1,21 @@
+{-# LANGUAGE CPP #-}
+module FindExecutable where
+#include "util.inl"
+
+main :: TestEnv -> IO ()
+main _t = do
+
+  -- 'find' expected to exist on both Windows and POSIX,
+  -- though we have no idea if it's writable
+  Just _ <- findExecutable "find"
+
+  T(expectEq) () Nothing =<< findExecutable "__nonexistent_binary_gbowyxcejjawf7r6__"
+
+  -- https://github.com/haskell/directory/issues/187
+  T(expectEq) () Nothing =<< findExecutable "/"
+  T(expectEq) () Nothing =<< findExecutable "//"
+#if !defined(mingw32_HOST_OS)
+  T(expectEq) () Nothing =<< findExecutable "\\"
+  T(expectEq) () Nothing =<< findExecutable "\\\\"
+  T(expectEq) () Nothing =<< findExecutable "\\\\localhost\\c$"
+#endif

tests/Main.hs

@@ -11,6 +11,7 @@ import qualified Directory001
 import qualified DoesDirectoryExist001
 import qualified DoesPathExist
 import qualified FileTime
+import qualified FindExecutable
 import qualified FindFile001
 import qualified GetDirContents001
 import qualified GetDirContents002
@@ -45,6 +46,7 @@ main = T.testMain $ \ _t -> do
   T.isolatedRun _t "DoesDirectoryExist001" DoesDirectoryExist001.main
   T.isolatedRun _t "DoesPathExist" DoesPathExist.main
   T.isolatedRun _t "FileTime" FileTime.main
+  T.isolatedRun _t "FindExecutable" FindExecutable.main
   T.isolatedRun _t "FindFile001" FindFile001.main
   T.isolatedRun _t "GetDirContents001" GetDirContents001.main
   T.isolatedRun _t "GetDirContents002" GetDirContents002.main