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:
parent
597d16ed9c
commit
1da79ea61f
3 changed files with 42 additions and 35 deletions
|
@ -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)
|
||||
|
|
|
@ -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
3
debian/changelog
vendored
|
@ -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
|
||||
|
||||
|
|
Loading…
Reference in a new issue