diff --git a/Annex/YoutubeDl.hs b/Annex/YoutubeDl.hs index f025adfa94..6c1d69ceb7 100644 --- a/Annex/YoutubeDl.hs +++ b/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)) diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs index 5ca9b429a1..e10d3fd1a6 100644 --- a/Assistant/Threads/Committer.hs +++ b/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 diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index 99770d9fee..c617fb6c6b 100644 --- a/Assistant/Threads/Watcher.hs +++ b/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 diff --git a/Assistant/WebApp/Configurators/AWS.hs b/Assistant/WebApp/Configurators/AWS.hs index 31fd0db84c..fb9f92b0dd 100644 --- a/Assistant/WebApp/Configurators/AWS.hs +++ b/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 ) diff --git a/Assistant/WebApp/Configurators/Local.hs b/Assistant/WebApp/Configurators/Local.hs index 68904098cc..166706b130 100644 --- a/Assistant/WebApp/Configurators/Local.hs +++ b/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 diff --git a/Assistant/WebApp/DashBoard.hs b/Assistant/WebApp/DashBoard.hs index aaa80184ce..1bc7c316df 100644 --- a/Assistant/WebApp/DashBoard.hs +++ b/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 $ diff --git a/Assistant/WebApp/Gpg.hs b/Assistant/WebApp/Gpg.hs index 9fe0006f9f..20cd1504da 100644 --- a/Assistant/WebApp/Gpg.hs +++ b/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) diff --git a/Build/TestConfig.hs b/Build/TestConfig.hs index 2f7213f460..988db58a9a 100644 --- a/Build/TestConfig.hs +++ b/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"] diff --git a/Command/Assistant.hs b/Command/Assistant.hs index 6a0494dd08..f4dd9083cd 100644 --- a/Command/Assistant.hs +++ b/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 diff --git a/Command/Map.hs b/Command/Map.hs index cafec0aab6..4f34190011 100644 --- a/Command/Map.hs +++ b/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 diff --git a/Remote/BitTorrent.hs b/Remote/BitTorrent.hs index 5f4b1a3474..b0ae33fbed 100644 --- a/Remote/BitTorrent.hs +++ b/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 diff --git a/Utility/Batch.hs b/Utility/Batch.hs index 58e326efae..6ed7881a17 100644 --- a/Utility/Batch.hs +++ b/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", []) diff --git a/Utility/Gpg.hs b/Utility/Gpg.hs index b8432b7b92..4128f387ce 100644 --- a/Utility/Gpg.hs +++ b/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 diff --git a/Utility/MagicWormhole.hs b/Utility/MagicWormhole.hs index b76bb3a568..cc189b6252 100644 --- a/Utility/MagicWormhole.hs +++ b/Utility/MagicWormhole.hs @@ -169,4 +169,4 @@ runWormHoleProcess p consumer = ExitFailure _ -> False isInstalled :: IO Bool -isInstalled = inPath "wormhole" +isInstalled = inSearchPath "wormhole" diff --git a/Utility/Path.hs b/Utility/Path.hs index b1f7a5f4db..4889ff9c81 100644 --- a/Utility/Path.hs +++ b/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) diff --git a/Utility/Shell.hs b/Utility/Shell.hs index 5053cdcba6..ac2231450d 100644 --- a/Utility/Shell.hs +++ b/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. - ok <- inPath c + -- despite it not being inSearchPath. + ok <- inSearchPath c return (if ok then c else takeFileName c, ps') _ -> defcmd #endif diff --git a/Utility/Su.hs b/Utility/Su.hs index cba88199e5..52f3f7f687 100644 --- a/Utility/Su.hs +++ b/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) diff --git a/Utility/Tor.hs b/Utility/Tor.hs index 13a019e2b6..a9d1037a13 100644 --- a/Utility/Tor.hs +++ b/Utility/Tor.hs @@ -191,4 +191,4 @@ varLibDir :: FilePath varLibDir = "/var/lib" torIsInstalled :: IO Bool -torIsInstalled = inPath "tor" +torIsInstalled = inSearchPath "tor"