refactor away whichCmd and some other cleanup

3 files changed, 21 insertions, 24 deletions

diff --git a/TestConfig.hs b/TestConfig.hs
index f6ca2afcd..9b2759e19 100644
--- a/TestConfig.hs
+++ b/TestConfig.hs
@@ -72,30 +72,26 @@ testCmd k cmdline = do
 
 {- Ensures that one of a set of commands is available by running each in
  - turn. The Config is set to the first one found. -}
-selectCmd :: ConfigKey -> [String] -> Test
-selectCmd k cmds = search cmds
+selectCmd :: Bool -> ConfigKey -> [String] -> String -> Test
+selectCmd required k cmds param = search cmds
 	where
-		search [] = do
-			testEnd $ Config k (BoolConfig False)
-			error $ "* need one of these commands, but none are available: " ++ show (map (head . words) cmds)
+		search [] = failure
 		search (c:cs) = do
-			ret <- system $ quiet c
+			ret <- system $ quiet c ++ " " ++ param
 			if (ret == ExitSuccess)
-				then return $ Config k (StringConfig c)
-				else search cs
-
-whichCmd :: ConfigKey -> [String] -> Test
-whichCmd k cmds = search cmds
-	where
-		search [] = do
-			let r = Config k (MaybeStringConfig Nothing)
-			testEnd r
-			return r
-		search (c:cs) = do
-			ret <- system $ quiet c
-			if (ret == ExitSuccess)
-				then return $ Config k (MaybeStringConfig $ Just $ head $ words c)
+				then success c
 				else search cs
+		success c
+			| required == True = return $ Config k (StringConfig c)
+			| otherwise = return $ Config k (MaybeStringConfig $ Just c)
+		failure
+			| required == True = do
+				testEnd $ Config k (BoolConfig False)
+				error $ "* need one of these commands, but none are available: " ++ show cmds
+			| otherwise = do
+				let r = Config k (MaybeStringConfig Nothing)
+				testEnd r
+				return r			
 
 quiet :: String -> String
 quiet s = s ++ " >/dev/null 2>&1"
diff --git a/configure.hs b/configure.hs
index c0e3d8106..0661813ae 100644
--- a/configure.hs
+++ b/configure.hs
@@ -11,7 +11,7 @@ tests = [
 	, testCp "cp_a" "-a"
 	, testCp "cp_p" "-p"
 	, testCp "cp_reflink_auto" "--reflink=auto"
-	, TestCase "uuid generator" $ selectCmd "uuid" ["uuid", "uuidgen"]
+	, TestCase "uuid generator" $ selectCmd True "uuid" ["uuid", "uuidgen"] ""
 	, 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"
@@ -22,9 +22,9 @@ shaTestCases :: [Int] -> [TestCase]
 shaTestCases l = map make l
 	where make n =
 		let
-			cmds = map (\x -> "sha" ++ show n ++ x ++ " </dev/null") ["", "sum"]
+			cmds = map (\x -> "sha" ++ show n ++ x) ["", "sum"]
 			key = "sha" ++ show n
-		in TestCase key $ whichCmd key cmds
+		in TestCase key $ selectCmd False key cmds "</dev/null"
 
 tmpDir :: String
 tmpDir = "tmp"
diff --git a/debian/changelog b/debian/changelog
index 3072ac476..7f104be10 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -14,7 +14,8 @@ git-annex (0.20110402) UNRELEASED; urgency=low
   * Add doc-base file. Closes: #621408
   * Periodically flush git command queue, to avoid boating memory usage
     too much.
-  * Support "sha1" and "sha512" commands on FreeBSD. Thanks, Fraser Tweedale
+  * Support "sha1" and "sha512" commands on FreeBSD, and allow building
+    if any/all SHA commands are not available. Thanks, Fraser Tweedale
 
  -- Joey Hess <joeyh@debian.org>  Sat, 02 Apr 2011 13:45:54 -0400