From 82617b92e96a4b0aefbacdc467c7fc36d241812d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 14 Dec 2012 15:52:44 -0400 Subject: [PATCH] move thirdparty program installation for standalone bundle into haskell program This allows it to use Build.SysConfig to always install the programs configure detected. Amoung other fixes, this ensures the right uuid generator and checksum programs are installed. I also cleaned up the handling of lsof's path; configure now checks for it in PATH, but falls back to looking for it in sbin directories. --- Assistant/Threads/Watcher.hs | 4 +- Build/Configure.hs | 2 +- Build/Standalone.hs | 78 ++++++++++++++++++++++++++++++++++++ Build/TestConfig.hs | 22 ++++++++++ Makefile | 24 +---------- Utility/Lsof.hs | 13 ++++++ Utility/Path.hs | 20 +++++++-- 7 files changed, 136 insertions(+), 27 deletions(-) create mode 100644 Build/Standalone.hs diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index f7e4e2df2c..08689cca48 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 4ac85811b6..491a744615 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 0000000000..cf0abbc137 --- /dev/null +++ b/Build/Standalone.hs @@ -0,0 +1,78 @@ +{- Makes standalone bundle. + - + - Copyright 2012 Joey Hess + - + - 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 92f6f68430..9937f799f1 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" diff --git a/Makefile b/Makefile index 90d44af544..31f32b8711 100644 --- a/Makefile +++ b/Makefile @@ -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 72f3e5815a..9a877a3c94 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 4bab297dad..ba836d9b66 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. -}