SHA: Add a runtime sanity check that sha commands output something that appears to be a real sha.

This after fielding a bug where git-annex was built with a sha256 program
whose output checked out, but was then run with one that output lines
like:

SHA256 (file) = <sha here>

Which it then parsed as having a SHA256 of "SHA256"!

Now the output of the command is required to be of the right length,
and contain only the right characters.

2 files changed, 24 insertions, 2 deletions

diff --git a/Backend/SHA.hs b/Backend/SHA.hs
index 77bd2c124..258caafd1 100644
--- a/Backend/SHA.hs
+++ b/Backend/SHA.hs
@@ -57,8 +57,9 @@ shaN shasize file filesize = do
 	showAction "checksum"
 	case shaCommand shasize filesize of
 		Left sha -> liftIO $ sha <$> L.readFile file
-		Right command -> liftIO $ parse command . lines <$>
-			readsha command (toCommand [File file])
+		Right command -> liftIO $ 
+			sanitycheck command . parse command . lines <$>
+				readsha command (toCommand [File file])
   where
 	parse command [] = bad command
 	parse command (l:_)
@@ -69,6 +70,7 @@ shaN shasize file filesize = do
 	  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
@@ -79,6 +81,24 @@ shaN shasize file filesize = do
 	  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
+
 shaCommand :: SHASize -> Integer -> Either (L.ByteString -> String) String
 shaCommand shasize filesize
 	| shasize == 1 = use SysConfig.sha1 sha1
diff --git a/debian/changelog b/debian/changelog
index 3c268866d..38e276b1d 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -15,6 +15,8 @@ git-annex (4.20130502) UNRELEASED; urgency=low
   * git-annex-shell: Ensure that received files can be read. Files
     transferred from some Android devices may have very broken permissions
     as received.
+  * SHA: Add a runtime sanity check that sha commands output something
+    that appears to be a real sha.
 
  -- Joey Hess <joeyh@debian.org>  Thu, 02 May 2013 20:39:19 -0400