{- Checks system configuration and generates SysConfig.hs. -} module Build.Configure where import System.Directory import Data.List import System.Process import Control.Applicative import System.FilePath import System.Environment (getArgs) import Data.Maybe import Control.Monad.IfElse import Control.Monad import Data.Char import Build.TestConfig import Build.Version import Utility.SafeCommand import Utility.Monad import Utility.ExternalSHA import Utility.Env import qualified Git.Version tests :: [TestCase] tests = [ TestCase "version" getVersion , TestCase "UPGRADE_LOCATION" getUpgradeLocation , TestCase "git" $ requireCmd "git" "git --version >/dev/null" , TestCase "git version" getGitVersion , testCp "cp_a" "-a" , testCp "cp_p" "-p" , testCp "cp_reflink_auto" "--reflink=auto" , TestCase "xargs -0" $ requireCmd "xargs_0" "xargs -0 /dev/null" , TestCase "curl" $ testCmd "curl" "curl --version >/dev/null" , TestCase "wget" $ testCmd "wget" "wget --version >/dev/null" , TestCase "bup" $ testCmd "bup" "bup --version >/dev/null" , TestCase "nice" $ testCmd "nice" "nice true >/dev/null" , TestCase "ionice" $ testCmd "ionice" "ionice -c3 true >/dev/null" , TestCase "nocache" $ testCmd "nocache" "nocache true >/dev/null" , TestCase "gpg" $ maybeSelectCmd "gpg" [ ("gpg", "--version >/dev/null") , ("gpg2", "--version >/dev/null") ] , TestCase "lsof" $ findCmdPath "lsof" "lsof" , TestCase "git-remote-gcrypt" $ findCmdPath "gcrypt" "git-remote-gcrypt" , TestCase "ssh connection caching" getSshConnectionCaching ] ++ shaTestCases [ (1, "da39a3ee5e6b4b0d3255bfef95601890afd80709") , (256, "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855") , (512, "cf83e1357eefb8bdf1542850d66d8007d620e4050b5715dc83f4a921d36ce9ce47d0d13c5d85f2b0ff8318d2877eec2f63b931bd47417a81a538327af927da3e") , (224, "d14a028c2a3a2bc9476102bb288234c415a2b01f828ea62ac5b3e42f") , (384, "38b060a751ac96384cd9327eb1b1e36a21fdb71114be07434c0cc7bf63f6e1da274edebfe76f65fbd51ad2f14898b95b") ] {- shaNsum are the program names used by coreutils. Some systems - install these with 'g' prefixes. - - On some systems, shaN is used instead, but on other - systems, it might be "hashalot", which does not produce - usable checksums. Only accept programs that produce - known-good hashes when run on files. -} shaTestCases :: [(Int, String)] -> [TestCase] shaTestCases l = map make l where make (n, knowngood) = TestCase key $ Config key . MaybeStringConfig <$> search (shacmds n) where key = "sha" ++ show n search [] = return Nothing search (c:cmds) = do sha <- externalSHA c n "/dev/null" if sha == Right knowngood then return $ Just c else search cmds shacmds n = concatMap (\x -> [x, 'g':x]) $ map (\x -> "sha" ++ show n ++ x) ["sum", ""] tmpDir :: String tmpDir = "tmp" testFile :: String testFile = tmpDir ++ "/testfile" testCp :: ConfigKey -> String -> TestCase testCp k option = TestCase cmd $ testCmd k cmdline where cmd = "cp " ++ option cmdline = cmd ++ " " ++ testFile ++ " " ++ testFile ++ ".new" getUpgradeLocation :: Test getUpgradeLocation = do e <- getEnv "UPGRADE_LOCATION" return $ Config "upgradelocation" $ MaybeStringConfig e getGitVersion :: Test getGitVersion = do v <- Git.Version.installed let oldestallowed = Git.Version.normalize "1.7.1.0" when (v < oldestallowed) $ error $ "installed git version " ++ show v ++ " is too old! (Need " ++ show oldestallowed ++ " or newer)" return $ Config "gitversion" $ StringConfig $ show v getSshConnectionCaching :: Test getSshConnectionCaching = Config "sshconnectioncaching" . BoolConfig <$> boolSystem "sh" [Param "-c", Param "ssh -o ControlPersist=yes -V >/dev/null 2>/dev/null"] setup :: IO () setup = do createDirectoryIfMissing True tmpDir writeFile testFile "test file contents" cleanup :: IO () cleanup = removeDirectoryRecursive tmpDir run :: [TestCase] -> IO () run ts = do args <- getArgs setup config <- runTests ts if args == ["Android"] then writeSysConfig $ androidConfig config else writeSysConfig config cleanup whenM isReleaseBuild $ cabalSetup "git-annex.cabal" {- Hard codes some settings to cross-compile for Android. -} androidConfig :: [Config] -> [Config] androidConfig c = overrides ++ filter (not . overridden) c where overrides = [ Config "cp_reflink_auto" $ BoolConfig False , Config "curl" $ BoolConfig False , Config "sha224" $ MaybeStringConfig Nothing , Config "sha384" $ MaybeStringConfig Nothing ] overridden (Config k _) = k `elem` overridekeys overridekeys = map (\(Config k _) -> k) overrides