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.

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"
 
diff --git a/Makefile b/Makefile
index 90d44af54..31f32b871 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 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. -}