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.
This commit is contained in:
Joey Hess 2012-12-14 15:52:44 -04:00
parent 1a10f109c1
commit 82617b92e9
7 changed files with 136 additions and 27 deletions

View file

@ -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")

78
Build/Standalone.hs Normal file
View file

@ -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

View file

@ -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"