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 + - Copyright 2011,2012 Joey Hess - - 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) " [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 Sun, 01 Jul 2012 15:04:37 -0400