diff options
| -rw-r--r-- | Assistant/Threads/Watcher.hs | 4 | ||||
| -rw-r--r-- | Build/Configure.hs | 2 | ||||
| -rw-r--r-- | Build/Standalone.hs | 78 | ||||
| -rw-r--r-- | Build/TestConfig.hs | 22 | ||||
| -rw-r--r-- | Makefile | 24 | ||||
| -rw-r--r-- | Utility/Lsof.hs | 13 | ||||
| -rw-r--r-- | Utility/Path.hs | 20 |
7 files changed, 136 insertions, 27 deletions
diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index f7e4e2df2..08689cca4 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -24,6 +24,7 @@ import Assistant.Drop import Logs.Transfer import Utility.DirWatcher import Utility.Types.DirWatcher +import Utility.Lsof import qualified Annex import qualified Annex.Queue import qualified Git.Command @@ -39,7 +40,8 @@ import qualified Data.ByteString.Lazy as L checkCanWatch :: Annex () checkCanWatch - | canWatch = + | canWatch = do + liftIO setupLsof unlessM (liftIO (inPath "lsof") <||> Annex.getState Annex.force) needLsof | otherwise = error "watch mode is not available on this system" diff --git a/Build/Configure.hs b/Build/Configure.hs index 4ac85811b..491a74461 100644 --- a/Build/Configure.hs +++ b/Build/Configure.hs @@ -26,7 +26,7 @@ tests = , TestCase "wget" $ testCmd "wget" "wget --version >/dev/null" , TestCase "bup" $ testCmd "bup" "bup --version >/dev/null" , TestCase "gpg" $ testCmd "gpg" "gpg --version >/dev/null" - , TestCase "lsof" $ testCmd "lsof" "lsof -v >/dev/null 2>&1" + , TestCase "lsof" $ findCmdPath "lsof" "lsof" , TestCase "ssh connection caching" getSshConnectionCaching ] ++ shaTestCases [ (1, "da39a3ee5e6b4b0d3255bfef95601890afd80709") diff --git a/Build/Standalone.hs b/Build/Standalone.hs new file mode 100644 index 000000000..cf0abbc13 --- /dev/null +++ b/Build/Standalone.hs @@ -0,0 +1,78 @@ +{- Makes standalone bundle. + - + - Copyright 2012 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} + +module Build.Standalone where + +import Control.Applicative +import Control.Monad.IfElse +import System.Environment +import Data.Maybe +import System.FilePath +import System.Directory +import System.IO +import Control.Monad +import Data.List +import Build.SysConfig as SysConfig + +import Utility.PartialPrelude +import Utility.Directory +import Utility.Process +import Utility.Monad +import Utility.SafeCommand +import Utility.Path + +{- Programs that git-annex uses, to include in the bundle. + - + - These may be just the command name, or the full path to it. -} +thirdpartyProgs :: [FilePath] +thirdpartyProgs = catMaybes + [ Just "git" + , Just "cp" + , Just "xargs" + , Just "gpg" + , Just "rsync" + , Just "ssh" + , Just "sh" + , headMaybe $ words SysConfig.uuid -- may include parameters + , ifset SysConfig.curl "curl" + , ifset SysConfig.wget "wget" + , ifset SysConfig.bup "bup" + , SysConfig.lsof + , SysConfig.sha1 + , SysConfig.sha256 + , SysConfig.sha512 + , SysConfig.sha224 + , SysConfig.sha384 + ] + where + ifset True s = Just s + ifset False _ = Nothing + +progDir :: FilePath -> FilePath +#ifdef darwin_HOST_OS +progDir topdir = topdir +#else +progDir topdir = topdir </> "bin" +#endif + +installProg :: FilePath -> FilePath -> IO () +installProg dir prog = searchPath prog >>= go + where + go Nothing = error $ "cannot find " ++ prog ++ " in PATH" + go (Just f) = unlessM (boolSystem "install" [File f, File dir]) $ + error $ "install failed for " ++ prog + +main = getArgs >>= go + where + go [] = error "specify topdir" + go (topdir:_) = do + let dir = progDir topdir + createDirectoryIfMissing True dir + forM_ thirdpartyProgs $ installProg dir + diff --git a/Build/TestConfig.hs b/Build/TestConfig.hs index 92f6f6843..9937f799f 100644 --- a/Build/TestConfig.hs +++ b/Build/TestConfig.hs @@ -2,9 +2,14 @@ module Build.TestConfig where +import Utility.Path +import Utility.Monad + import System.IO import System.Cmd import System.Exit +import System.FilePath +import System.Directory type ConfigKey = String data ConfigValue = @@ -98,6 +103,23 @@ searchCmd success failure cmdsparams = search cmdsparams then success c else search cs +{- Finds a command, either in PATH or perhaps in a sbin directory not in + - PATH. If it's in PATH the config is set to just the command name, + - but if it's found outside PATH, the config is set to the full path to + - the command. -} +findCmdPath :: ConfigKey -> String -> Test +findCmdPath k command = do + ifM (inPath command) + ( return $ Config k $ MaybeStringConfig $ Just command + , do + r <- getM find ["/usr/sbin", "/sbin", "/usr/local/sbin"] + return $ Config k $ MaybeStringConfig r + ) + where + find d = + let f = d </> command + in ifM (doesFileExist f) ( return (Just f), return Nothing ) + quiet :: String -> String quiet s = s ++ " >/dev/null 2>&1" @@ -143,9 +143,6 @@ sdist: clean $(mans) hackage: sdist @cabal upload dist/*.tar.gz -THIRDPARTY_BINS=git curl lsof xargs rsync uuid wget gpg \ - sha1sum sha224sum sha256sum sha384sum sha512sum cp ssh sh - LINUXSTANDALONE_DEST=$(GIT_ANNEX_TMP_BUILD_DIR)/git-annex.linux linuxstandalone: $(MAKE) git-annex @@ -160,16 +157,7 @@ linuxstandalone: ln -sf git-annex "$(LINUXSTANDALONE_DEST)/bin/git-annex-shell" zcat standalone/licences.gz > $(LINUXSTANDALONE_DEST)/LICENSE - set -e; \ - for bin in $(THIRDPARTY_BINS); do \ - p="$$(PATH=$$PATH:/usr/sbin:/sbin:/usr/local/sbin which "$$bin")"; \ - if [ -z "$$p" ]; then \ - echo "** missing $$bin" >&2; \ - exit 1; \ - else \ - cp "$$p" "$(LINUXSTANDALONE_DEST)/bin/"; \ - fi; \ - done + runghc Build/Standalone.hs "$(LINUXSTANDALONE_DEST)" install -d "$(LINUXSTANDALONE_DEST)/git-core" (cd "$(shell git --exec-path)" && tar c .) | (cd "$(LINUXSTANDALONE_DEST)"/git-core && tar x) @@ -207,15 +195,7 @@ osxapp: gzcat standalone/licences.gz > $(OSXAPP_BASE)/LICENSE cp $(OSXAPP_BASE)/LICENSE $(GIT_ANNEX_TMP_BUILD_DIR)/build-dmg/LICENSE.txt - for bin in $(THIRDPARTY_BINS); do \ - p="$$(PATH=$$PATH:/usr/sbin:/sbin:/usr/local/sbin which "$$bin")"; \ - if [ -z "$$p" ]; then \ - echo "** missing $$bin" >&2; \ - exit 1; \ - else \ - cp "$$p" "$(OSXAPP_BASE)"; \ - fi; \ - done + runghc Build/Standalone.hs $(OSXAPP_BASE) (cd "$(shell git --exec-path)" && tar c .) | (cd "$(OSXAPP_BASE)" && tar x) install -d "$(OSXAPP_BASE)/templates" diff --git a/Utility/Lsof.hs b/Utility/Lsof.hs index 72f3e5815..9a877a3c9 100644 --- a/Utility/Lsof.hs +++ b/Utility/Lsof.hs @@ -10,8 +10,10 @@ module Utility.Lsof where import Common +import Build.SysConfig as SysConfig import System.Posix.Types +import System.Posix.Env data LsofOpenMode = OpenReadWrite | OpenReadOnly | OpenWriteOnly | OpenUnknown deriving (Show, Eq) @@ -21,6 +23,17 @@ type CmdLine = String data ProcessInfo = ProcessInfo ProcessID CmdLine deriving (Show) +{- lsof is not in PATH on all systems, so SysConfig may have the absolute + - path where the program was found. Make sure at runtime that lsof is + - available, and if it's not in PATH, adjust PATH to contain it. -} +setupLsof :: IO () +setupLsof = do + let cmd = fromMaybe "lsof" SysConfig.lsof + when (isAbsolute cmd) $ do + path <- getSearchPath + let path' = takeDirectory cmd : path + setEnv "PATH" (join [searchPathSeparator] path') True + {- Checks each of the files in a directory to find open files. - Note that this will find hard links to files elsewhere that are open. -} queryDir :: FilePath -> IO [(FilePath, LsofOpenMode, ProcessInfo)] diff --git a/Utility/Path.hs b/Utility/Path.hs index 4bab297da..ba836d9b6 100644 --- a/Utility/Path.hs +++ b/Utility/Path.hs @@ -132,11 +132,25 @@ relHome path = do then "~/" ++ relPathDirToFile home path else path -{- Checks if a command is available in PATH. -} +{- 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 = getSearchPath >>= anyM indir +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. + -} +searchPath :: String -> IO (Maybe FilePath) +searchPath command + | isAbsolute command = check command + | otherwise = getSearchPath >>= getM indir where - indir d = doesFileExist $ d </> command + indir d = check $ d </> command + check f = ifM (doesFileExist f) ( return (Just f), return Nothing ) {- Checks if a filename is a unix dotfile. All files inside dotdirs - count as dotfiles. -} |