add searchPathContents

And rename related functions for consistency.

Annex/YoutubeDl.hs

@@ -68,7 +68,7 @@ youtubeDl url workdir p = ifM ipAddressesUnlimited
 
 youtubeDl' :: URLString -> FilePath -> MeterUpdate -> UrlOptions -> Annex (Either String (Maybe FilePath))
 youtubeDl' url workdir p uo
-	| supportedScheme uo url = ifM (liftIO $ inPath "youtube-dl")
+	| supportedScheme uo url = ifM (liftIO $ inSearchPath "youtube-dl")
 		( runcmd >>= \case
 			Right True -> workdirfiles >>= \case
 				(f:[]) -> return (Right (Just f))

Assistant/Threads/Committer.hs

@@ -49,7 +49,7 @@ import Control.Concurrent
 {- This thread makes git commits at appropriate times. -}
 commitThread :: NamedThread
 commitThread = namedThread "Committer" $ do
-	havelsof <- liftIO $ inPath "lsof"
+	havelsof <- liftIO $ inSearchPath "lsof"
 	delayadd <- liftAnnex $
 		fmap Seconds . annexDelayAdd <$> Annex.getGitConfig
 	msg <- liftAnnex Command.Sync.commitMsg

Assistant/Threads/Watcher.hs

@@ -58,7 +58,7 @@ checkCanWatch
 	| canWatch = do
 #ifndef mingw32_HOST_OS
 		liftIO Lsof.setup
-		unlessM (liftIO (inPath "lsof") <||> Annex.getState Annex.force)
+		unlessM (liftIO (inSearchPath "lsof") <||> Annex.getState Annex.force)
 			needLsof
 #else
 		noop

Assistant/WebApp/Configurators/AWS.hs

@@ -34,7 +34,7 @@ awsConfigurator = page "Add an Amazon repository" (Just Configuration)
 
 glacierConfigurator :: Widget -> Handler Html
 glacierConfigurator a = do
-	ifM (liftIO $ inPath "glacier")
+	ifM (liftIO $ inSearchPath "glacier")
 		( awsConfigurator a
 		, awsConfigurator needglaciercli
 		)

Assistant/WebApp/Configurators/Local.hs

@@ -164,7 +164,7 @@ getFirstRepositoryR :: Handler Html
 getFirstRepositoryR = postFirstRepositoryR
 postFirstRepositoryR :: Handler Html
 postFirstRepositoryR = page "Getting started" (Just Configuration) $ do
-	unlessM (liftIO $ inPath "git") $
+	unlessM (liftIO $ inSearchPath "git") $
 		giveup "You need to install git in order to use git-annex!"
 	androidspecial <- liftIO osAndroid
 	path <- liftIO . defaultRepositoryPath =<< liftH inFirstRun

Assistant/WebApp/DashBoard.hs

@@ -134,7 +134,7 @@ openFileBrowser = do
 	let p = proc cmd [path]
 #endif
 #endif
-	ifM (liftIO $ inPath cmd)
+	ifM (liftIO $ inSearchPath cmd)
 		( do
 			let run = void $ liftIO $ forkIO $ do
 				withCreateProcess p $ \_ _ _ pid -> void $

Assistant/WebApp/Gpg.hs

@@ -41,7 +41,7 @@ genKeyModal :: Widget
 genKeyModal = $(widgetFile "configurators/genkeymodal")
 
 isGcryptInstalled :: IO Bool
-isGcryptInstalled = inPath "git-remote-gcrypt"
+isGcryptInstalled = inSearchPath "git-remote-gcrypt"
 
 whenGcryptInstalled :: Handler Html -> Handler Html
 whenGcryptInstalled a = ifM (liftIO isGcryptInstalled)

Build/TestConfig.hs

@@ -97,7 +97,7 @@ searchCmd success failure cmdsparams = search cmdsparams
  - the command. -}
 findCmdPath :: ConfigKey -> String -> Test
 findCmdPath k command = do
-	ifM (inPath command)
+	ifM (inSearchPath command)
 		( return $ Config k $ MaybeStringConfig $ Just command
 		, do
 			r <- getM find ["/usr/sbin", "/sbin", "/usr/local/sbin"]

Command/Assistant.hs

@@ -79,7 +79,7 @@ autoStart o = do
 		f <- autoStartFile
 		giveup $ "Nothing listed in " ++ f
 	program <- programPath
-	haveionice <- pure BuildInfo.ionice <&&> inPath "ionice"
+	haveionice <- pure BuildInfo.ionice <&&> inSearchPath "ionice"
 	pids <- forM dirs $ \d -> do
 		putStrLn $ "git-annex autostart in " ++ d
 		mpid <- catchMaybeIO $ go haveionice program d

Command/Map.hs

@@ -64,7 +64,7 @@ runViewer :: FilePath -> [(String, [CommandParam])] -> Annex Bool
 runViewer file [] = do
 	showLongNote $ "left map in " ++ file
 	return True
-runViewer file ((c, ps):rest) = ifM (liftIO $ inPath c)
+runViewer file ((c, ps):rest) = ifM (liftIO $ inSearchPath c)
 	( do
 		showLongNote $ "running: " ++ c ++ unwords (toCommand ps)
 		showOutput

Remote/BitTorrent.hs

@@ -291,7 +291,7 @@ downloadTorrentContent k u dest filenum p = do
 
 checkDependencies :: Annex ()
 checkDependencies = do
-	missing <- liftIO $ filterM (not <$$> inPath) deps
+	missing <- liftIO $ filterM (not <$$> inSearchPath) deps
 	unless (null missing) $
 		giveup $ "need to install additional software in order to download from bittorrent: " ++ unwords missing
   where

Utility/Batch.hs

@@ -57,7 +57,7 @@ nonBatchCommandMaker = id
 getBatchCommandMaker :: IO BatchCommandMaker
 getBatchCommandMaker = do
 #ifndef mingw32_HOST_OS
-	nicers <- filterM (inPath . fst)
+	nicers <- filterM (inSearchPath . fst)
 		[ ("nice", [])
 		, ("ionice", ["-c3"])
 		, ("nocache", [])

Utility/Gpg.hs

@@ -411,7 +411,7 @@ keyBlock public ls = unlines
  - is returned.
  -}
 testHarness :: FilePath -> GpgCmd -> IO a -> IO (Maybe a)
-testHarness tmpdir cmd a = ifM (inPath (unGpgCmd cmd))
+testHarness tmpdir cmd a = ifM (inSearchPath (unGpgCmd cmd))
 	( bracket (eitherToMaybe <$> tryNonAsync setup) cleanup go
 	, return Nothing
 	)
@@ -439,7 +439,7 @@ testHarness tmpdir cmd a = ifM (inPath (unGpgCmd cmd))
 	-- other daemons. Stop them when done. This only affects
 	-- daemons started for the GNUPGHOME that was used.
 	-- Older gpg may not support this, so ignore failure.
-	stopgpgagent = whenM (inPath "gpgconf") $
+	stopgpgagent = whenM (inSearchPath "gpgconf") $
 		void $ boolSystem "gpgconf" [Param "--kill", Param "all"]
 
 	go (Just _) = Just <$> a

Utility/MagicWormhole.hs

@@ -169,4 +169,4 @@ runWormHoleProcess p consumer =
 			ExitFailure _ -> False
 
 isInstalled :: IO Bool
-isInstalled = inPath "wormhole"
+isInstalled = inSearchPath "wormhole"

Utility/Path.hs

@@ -18,11 +18,12 @@ module Utility.Path (
 	segmentPaths',
 	runSegmentPaths,
 	runSegmentPaths',
-	inPath,
-	searchPath,
 	dotfile,
 	splitShortExtensions,
 	relPathDirToFileAbs,
+	inSearchPath,
+	searchPath,
+	searchPathContents,
 ) where
 
 import System.FilePath.ByteString
@@ -35,6 +36,7 @@ import Prelude
 
 import Utility.Monad
 import Utility.SystemDirectory
+import Utility.Exception
 
 #ifdef mingw32_HOST_OS
 import Data.Char
@@ -136,33 +138,6 @@ runSegmentPaths c a paths = segmentPaths c paths <$> a paths
 runSegmentPaths' :: (Maybe RawFilePath -> a -> r) -> (a -> RawFilePath) -> ([RawFilePath] -> IO [a]) -> [RawFilePath] -> IO [[r]]
 runSegmentPaths' si c a paths = segmentPaths' si c paths <$> a paths
 
-{- Checks if a command is available in PATH.
- -
- - The command may be fully-qualified, in which case, this succeeds as
- - long as it exists. -}
-inPath :: String -> IO Bool
-inPath command = isJust <$> searchPath command
-
-{- Finds a command in PATH and returns the full path to it.
- -
- - The command may be fully qualified already, in which case it will
- - be returned if it exists.
- -
- - Note that this will find commands in PATH that are not executable.
- -}
-searchPath :: String -> IO (Maybe FilePath)
-searchPath command
-	| P.isAbsolute command = check command
-	| otherwise = P.getSearchPath >>= getM indir
-  where
-	indir d = check $ d P.</> command
-	check f = firstM doesFileExist
-#ifdef mingw32_HOST_OS
-		[f, f ++ ".exe"]
-#else
-		[f]
-#endif
-
 {- Checks if a filename is a unix dotfile. All files inside dotdirs
  - count as dotfiles. -}
 dotfile :: RawFilePath -> Bool
@@ -213,3 +188,39 @@ relPathDirToFileAbs from to
 #ifdef mingw32_HOST_OS
 	normdrive = map toLower . takeWhile (/= ':') . fromRawFilePath . takeDrive
 #endif
+
+{- Checks if a command is available in PATH.
+ -
+ - The command may be fully-qualified, in which case, this succeeds as
+ - long as it exists. -}
+inSearchPath :: String -> IO Bool
+inSearchPath command = isJust <$> searchPath command
+
+{- Finds a command in PATH and returns the full path to it.
+ -
+ - The command may be fully qualified already, in which case it will
+ - be returned if it exists.
+ -
+ - Note that this will find commands in PATH that are not executable.
+ -}
+searchPath :: String -> IO (Maybe FilePath)
+searchPath command
+	| P.isAbsolute command = check command
+	| otherwise = P.getSearchPath >>= getM indir
+  where
+	indir d = check $ d P.</> command
+	check f = firstM doesFileExist
+#ifdef mingw32_HOST_OS
+		[f, f ++ ".exe"]
+#else
+		[f]
+#endif
+
+{- Finds commands in PATH that match a predicate. Note that the predicate
+ - matches on the basename of the command, but the full path to it is
+ - returned. -}
+searchPathContents :: (FilePath -> Bool) -> IO [FilePath]
+searchPathContents p = concat <$> (P.getSearchPath >>= mapM go)
+  where
+	go d = map (d P.</>) . filter p
+		<$> catchDefaultIO [] (getDirectoryContents d)

Utility/Shell.hs

@@ -46,11 +46,11 @@ findShellCommand f = do
 			[] -> defcmd
 			(c:ps) -> do
 				let ps' = map Param ps ++ [File f]
-				-- If the command is not inPath,
+				-- If the command is not inSearchPath,
 				-- take the base of it, and run eg "sh"
 				-- which in some cases on windows will work
-				-- despite it not being inPath.
+				-- despite it not being inSearchPath.
-				ok <- inPath c
+				ok <- inSearchPath c
 				return (if ok then c else takeFileName c, ps')
 		_ -> defcmd
 #endif

Utility/Su.hs

@@ -71,7 +71,7 @@ mkSuCommand :: String -> [CommandParam] -> IO (Maybe SuCommand)
 #ifndef mingw32_HOST_OS
 mkSuCommand cmd ps = do
 	pwd <- getCurrentDirectory
-	firstM (\(SuCommand _ p _) -> inPath p) =<< selectcmds pwd
+	firstM (\(SuCommand _ p _) -> inSearchPath p) =<< selectcmds pwd
   where
 	selectcmds pwd = ifM (inx <||> (not <$> atconsole))
 		( return (graphicalcmds pwd ++ consolecmds pwd)

Utility/Tor.hs

@@ -191,4 +191,4 @@ varLibDir :: FilePath
 varLibDir = "/var/lib"
 
 torIsInstalled :: IO Bool
-torIsInstalled = inPath "tor"
+torIsInstalled = inSearchPath "tor"