configure: Better checking that sha commands output in the desired format.

Run the same code git-annex used to get the sha, including its sanity
checking. Much better than old grep. Should detect FreeBSD systems with
sha commands that output in stange format.

4 files changed, 86 insertions, 48 deletions

diff --git a/Backend/SHA.hs b/Backend/SHA.hs
index 258caafd1..a735ce1e5 100644
--- a/Backend/SHA.hs
+++ b/Backend/SHA.hs
@@ -12,11 +12,11 @@ import qualified Annex
 import Types.Backend
 import Types.Key
 import Types.KeySource
+import Utility.ExternalSHA
 
 import qualified Build.SysConfig as SysConfig
 import Data.Digest.Pure.SHA
 import qualified Data.ByteString.Lazy as L
-import System.Process
 import Data.Char
 
 type SHASize = Int
@@ -55,49 +55,11 @@ shaNameE size = shaName size ++ "E"
 shaN :: SHASize -> FilePath -> Integer -> Annex String
 shaN shasize file filesize = do
 	showAction "checksum"
-	case shaCommand shasize filesize of
-		Left sha -> liftIO $ sha <$> L.readFile file
-		Right command -> liftIO $ 
-			sanitycheck command . parse command . lines <$>
-				readsha command (toCommand [File file])
-  where
-	parse command [] = bad command
-	parse command (l:_)
-		| null sha = bad command
-		-- sha is prefixed with \ when filename contains certian chars
-		| "\\" `isPrefixOf` sha = drop 1 sha
-		| otherwise = sha
-	  where
-		sha = fst $ separate (== ' ') l
-	bad command = error $ command ++ " parse error"
-
-	{- sha commands output the filename, so need to set fileEncoding -}
-	readsha command args =
-		withHandle StdoutHandle createProcessSuccess p $ \h -> do
-			fileEncoding h
-			output  <- hGetContentsStrict h
-			hClose h
-			return output
-	  where
-		p = (proc command args) { std_out = CreatePipe }
-
-	{- Check that we've correctly parsing the output of the command,
-	 - by making sure the sha we read is of the expected length. -}
-	sanitycheck command sha
-		| length sha /= expectedlen =
-			error $ "Failed to parse the output of " ++ command
-		| any (`notElem` "0123456789abcdef") sha' =
-			error $ "Unexpected character in output of " ++ command ++ "\"" ++ sha ++ "\""
-		| otherwise = sha'
-	  where
-	  	sha' = map toLower sha
-		expectedlen = case shasize of
-			1 -> 40
-			256 -> 64
-			512 -> 128
-			224 -> 56
-			384 -> 96
-			_ -> 0
+	liftIO $ case shaCommand shasize filesize of
+		Left sha -> sha <$> L.readFile file
+		Right command ->
+			either error return 
+				=<< externalSHA command shasize file
 
 shaCommand :: SHASize -> Integer -> Either (L.ByteString -> String) String
 shaCommand shasize filesize
diff --git a/Build/Configure.hs b/Build/Configure.hs
index d89c206d5..46a3a2452 100644
--- a/Build/Configure.hs
+++ b/Build/Configure.hs
@@ -14,6 +14,7 @@ import Build.TestConfig
 import Utility.SafeCommand
 import Utility.Monad
 import Utility.Exception
+import Utility.ExternalSHA
 
 tests :: [TestCase]
 tests =
@@ -45,17 +46,24 @@ tests =
  - 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. -}
+ - known-good hashes when run on files. -}
 shaTestCases :: [(Int, String)] -> [TestCase]
 shaTestCases l = map make l
   where
-	make (n, knowngood) = TestCase key $ maybeSelectCmd key $ 
-		zip (shacmds n) (repeat check)
+	make (n, knowngood) = TestCase key $ 
+		Config key . MaybeStringConfig <$> search (shacmds n)
 	  where
 		key = "sha" ++ show n
-		check = "</dev/null 2>/dev/null | grep -q '" ++ knowngood ++ "'"
+	  	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, osxpath </> x]) $
 		map (\x -> "sha" ++ show n ++ x) ["sum", ""]
+
 	{- Max OSX sometimes puts GNU tools outside PATH, so look in
 	 - the location it uses, and remember where to run them
 	 - from. -}
diff --git a/Utility/ExternalSHA.hs b/Utility/ExternalSHA.hs
new file mode 100644
index 000000000..21241d302
--- /dev/null
+++ b/Utility/ExternalSHA.hs
@@ -0,0 +1,67 @@
+{- Calculating a SHA checksum with an external command.
+ -
+ - This is often faster than using Haskell libraries.
+ -
+ - Copyright 2011-2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Utility.ExternalSHA (externalSHA) where
+
+import Utility.SafeCommand
+import Utility.Process
+import Utility.FileSystemEncoding
+import Utility.Misc
+
+import System.Process
+import Data.List
+import Data.Char
+import Control.Applicative
+import System.IO
+
+externalSHA :: String -> Int -> FilePath -> IO (Either String String)
+externalSHA command shasize file = do
+	ls <- lines <$> readsha (toCommand [File file])
+	return $ sanitycheck =<< parse ls
+  where
+	{- sha commands output the filename, so need to set fileEncoding -}
+	readsha args =
+		withHandle StdoutHandle (createProcessChecked checkSuccessProcess) p $ \h -> do
+			fileEncoding h
+			output  <- hGetContentsStrict h
+			hClose h
+			return output
+	  where
+		p = (proc command args) { std_out = CreatePipe }
+
+	{- The first word of the output is taken to be the sha. -}
+	parse [] = bad
+	parse (l:_)
+		| null sha = bad
+		-- sha is prefixed with \ when filename contains certian chars
+		| "\\" `isPrefixOf` sha = Right $ drop 1 sha
+		| otherwise = Right sha
+	  where
+		sha = fst $ separate (== ' ') l
+	bad = Left $ command ++ " parse error"
+
+	{- Check that we've correctly parsing the output of the command,
+	 - by making sure the sha we read is of the expected length
+	 - and contains only the right characters. -}
+	sanitycheck sha
+		| length sha /= expectedSHALength shasize =
+			Left $ "Failed to parse the output of " ++ command
+		| any (`notElem` "0123456789abcdef") sha' =
+			Left $ "Unexpected character in output of " ++ command ++ "\"" ++ sha ++ "\""
+		| otherwise = Right sha'
+	  where
+	  	sha' = map toLower sha
+
+expectedSHALength :: Int -> Int
+expectedSHALength 1 = 40
+expectedSHALength 256 = 64
+expectedSHALength 512 = 128
+expectedSHALength 224 = 56
+expectedSHALength 384 = 96
+expectedSHALength _ = 0
diff --git a/debian/changelog b/debian/changelog
index 38e276b1d..758d01504 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -17,6 +17,7 @@ git-annex (4.20130502) UNRELEASED; urgency=low
     as received.
   * SHA: Add a runtime sanity check that sha commands output something
     that appears to be a real sha.
+  * configure: Better checking that sha commands output in the desired format.
 
  -- Joey Hess <joeyh@debian.org>  Thu, 02 May 2013 20:39:19 -0400