From 1da79ea61faaddd71bdb84ee2c5a89bbe04a69ed Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 4 Jul 2012 09:08:20 -0400
Subject: [PATCH] When shaNsum commands cannot be found, use the Haskell SHA
 library (already a dependency) to do the checksumming. This may be slower,
 but avoids portability problems.

Using Crypto's version of the hashes would be another option.
I need to benchmark it. The SHA2 library (which provides SHA1 also,
confusing name) may be the fastest option, but is not currently in Debian.
---
 Backend/SHA.hs     | 65 +++++++++++++++++++++++++---------------------
 Build/Configure.hs |  9 +++----
 debian/changelog   |  3 +++
 3 files changed, 42 insertions(+), 35 deletions(-)

diff --git a/Backend/SHA.hs b/Backend/SHA.hs
index 838a97ab8b..6ecc78ff29 100644
--- a/Backend/SHA.hs
+++ b/Backend/SHA.hs
@@ -1,6 +1,6 @@
 {- git-annex SHA backend
  -
- - Copyright 2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2011,2012 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -12,7 +12,10 @@ import qualified Annex
 import Types.Backend
 import Types.Key
 import Types.KeySource
+
 import qualified Build.SysConfig as SysConfig
+import Data.Digest.Pure.SHA
+import qualified Data.ByteString.Lazy as L
 
 type SHASize = Int
 
@@ -25,32 +28,31 @@ backends :: [Backend]
 backends = catMaybes $ map genBackend sizes ++ map genBackendE sizes
 
 genBackend :: SHASize -> Maybe Backend
-genBackend size
-	| isNothing (shaCommand size) = Nothing
-	| otherwise = Just b
-	where
-		b = Backend
-			{ name = shaName size
-			, getKey = keyValue size
-			, fsckKey = Just $ checkKeyChecksum size
-			}
+genBackend size = Just $ Backend
+	{ name = shaName size
+	, getKey = keyValue size
+	, fsckKey = Just $ checkKeyChecksum size
+	}
 
 genBackendE :: SHASize -> Maybe Backend
-genBackendE size =
-	case genBackend size of
-		Nothing -> Nothing
-		Just b -> Just $ b
-			{ name = shaNameE size
-			, getKey = keyValueE size
-			}
+genBackendE size = do
+	b <- genBackend size
+	return $ b 
+		{ name = shaNameE size
+		, getKey = keyValueE size
+		}
 
-shaCommand :: SHASize -> Maybe String
-shaCommand 1 = SysConfig.sha1
-shaCommand 256 = Just SysConfig.sha256
-shaCommand 224 = SysConfig.sha224
-shaCommand 384 = SysConfig.sha384
-shaCommand 512 = SysConfig.sha512
-shaCommand _ = Nothing
+shaCommand :: SHASize -> Either (L.ByteString -> String) String
+shaCommand sz
+	| sz == 1 = use SysConfig.sha1 sha1
+	| sz == 256 = use SysConfig.sha256 sha256
+	| sz == 224 = use SysConfig.sha224 sha224
+	| sz == 384 = use SysConfig.sha384 sha384
+	| sz == 512 = use SysConfig.sha512 sha512
+	| otherwise = error $ "bad sha size " ++ show sz
+	where
+		use Nothing sha = Left $ showDigest . sha
+		use (Just c) _ = Right c
 
 shaName :: SHASize -> String
 shaName size = "SHA" ++ show size
@@ -61,13 +63,16 @@ shaNameE size = shaName size ++ "E"
 shaN :: SHASize -> FilePath -> Annex String
 shaN size file = do
 	showAction "checksum"
-	liftIO $ pOpen ReadFromPipe command (toCommand [File file]) $ \h -> do
-		sha <- fst . separate (== ' ') <$> hGetLine h
-		if null sha
-			then error $ command ++ " parse error"
-			else return sha
+	case shaCommand size of
+		Left sha -> liftIO $ sha <$> L.readFile file
+		Right command -> liftIO $ runcommand command
 	where
-		command = fromJust $ shaCommand size
+		runcommand command =
+			pOpen ReadFromPipe command (toCommand [File file]) $ \h -> do
+				sha <- fst . separate (== ' ') <$> hGetLine h
+				if null sha
+					then error $ command ++ " parse error"
+					else return sha
 
 {- A key is a checksum of its contents. -}
 keyValue :: SHASize -> KeySource -> Annex (Maybe Key)
diff --git a/Build/Configure.hs b/Build/Configure.hs
index 7af53cf10f..24743bf618 100644
--- a/Build/Configure.hs
+++ b/Build/Configure.hs
@@ -28,15 +28,14 @@ tests =
 	, TestCase "gpg" $ testCmd "gpg" "gpg --version >/dev/null"
 	, TestCase "lsof" $ testCmd "lsof" "lsof -v >/dev/null 2>&1"
 	, TestCase "ssh connection caching" getSshConnectionCaching
-	] ++ shaTestCases False [1, 512, 224, 384] ++ shaTestCases True [256]
+	] ++ shaTestCases [1, 256, 512, 224, 384]
 
-shaTestCases :: Bool -> [Int] -> [TestCase]
-shaTestCases required l = map make l
+shaTestCases :: [Int] -> [TestCase]
+shaTestCases l = map make l
 	where
-		make n = TestCase key $ selector key (shacmds n) "</dev/null"
+		make n = TestCase key $ maybeSelectCmd key (shacmds n) "</dev/null"
 			where
 				key = "sha" ++ show n
-		selector = if required then selectCmd else maybeSelectCmd
 		shacmds n = concatMap (\x -> [x, osxpath </> x]) $
 			map (\x -> "sha" ++ show n ++ x) ["", "sum"]
 		-- Max OSX puts GNU tools outside PATH, so look in
diff --git a/debian/changelog b/debian/changelog
index 33c850861b..ebd34c9440 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -4,6 +4,9 @@ git-annex (3.20120630) UNRELEASED; urgency=low
     transfer is already in progress by another process.
   * status: Lists transfers that are currently in progress.
   * Fix passing --uuid to git-annex-shell.
+  * When shaNsum commands cannot be found, use the Haskell SHA library
+    (already a dependency) to do the checksumming. This may be slower,
+    but avoids portability problems.
 
  -- Joey Hess <joeyh@debian.org>  Sun, 01 Jul 2012 15:04:37 -0400