1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
{- 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 "rsync" $ requireCmd "rsync" "rsync --version >/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 "quvi" $ testCmd "quvi" "quvi --version >/dev/null"
, TestCase "newquvi" $ testCmd "newquvi" "quvi info >/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
|
