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.
This commit is contained in:
Joey Hess 2012-07-04 09:08:20 -04:00
parent 597d16ed9c
commit 1da79ea61f
3 changed files with 42 additions and 35 deletions

View file

@ -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)

View file

@ -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

3
debian/changelog vendored
View file

@ -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