add Backend.GitRemoteAnnex
Making GITBUNDLE be in the backend list allows those keys to be hashed to verify, both when git-remote-annex downloads them, and by other transfers and by git fsck. GITMANIFEST is not in the backend list, because those keys will never be stored in .git/annex/objects and can't be verified in any case. This does mean that git-annex version will include GITBUNDLE in the list of backends. Also documented these in backends.mdwn Sponsored-by: Kevin Mueller on Patreon
This commit is contained in:
parent
483887591d
commit
c7731cdbd9
7 changed files with 110 additions and 14 deletions
76
Backend/GitRemoteAnnex.hs
Normal file
76
Backend/GitRemoteAnnex.hs
Normal file
|
@ -0,0 +1,76 @@
|
|||
{- Backends for git-remote-annex.
|
||||
-
|
||||
- GITBUNDLE keys store git bundles
|
||||
- GITMANIFEST keys store ordered lists of GITBUNDLE keys
|
||||
-
|
||||
- Copyright 2024 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Backend.GitRemoteAnnex (
|
||||
backends,
|
||||
genGitBundleKey,
|
||||
genManifestKey,
|
||||
) where
|
||||
|
||||
import Annex.Common
|
||||
import Types.Key
|
||||
import Types.Backend
|
||||
import Utility.Hash
|
||||
import Utility.Metered
|
||||
import qualified Backend.Hash as Hash
|
||||
|
||||
import qualified Data.ByteString.Short as S
|
||||
|
||||
backends :: [Backend]
|
||||
backends = [gitbundle]
|
||||
|
||||
gitbundle :: Backend
|
||||
gitbundle = Backend
|
||||
{ backendVariety = GitBundleKey
|
||||
, genKey = Nothing
|
||||
-- ^ Not provided because these keys can only be generated by
|
||||
-- git-remote-annex.
|
||||
, verifyKeyContent = Just $ Hash.checkKeyChecksum sameCheckSum hash
|
||||
, verifyKeyContentIncrementally = Just (liftIO . incrementalVerifier)
|
||||
, canUpgradeKey = Nothing
|
||||
, fastMigrate = Nothing
|
||||
, isStableKey = const True
|
||||
, isCryptographicallySecure = Hash.cryptographicallySecure hash
|
||||
, isCryptographicallySecureKey = const $ pure $
|
||||
Hash.cryptographicallySecure hash
|
||||
}
|
||||
|
||||
-- git bundle keys use the sha256 hash.
|
||||
hash :: Hash.Hash
|
||||
hash = Hash.SHA2Hash (HashSize 256)
|
||||
|
||||
incrementalVerifier :: Key -> IO IncrementalVerifier
|
||||
incrementalVerifier =
|
||||
mkIncrementalVerifier sha2_256_context "checksum" . sameCheckSum
|
||||
|
||||
sameCheckSum :: Key -> String -> Bool
|
||||
sameCheckSum key s = s == expected
|
||||
where
|
||||
-- The checksum comes after a UUID.
|
||||
expected = reverse $ takeWhile (/= '-') $ reverse $
|
||||
decodeBS $ S.fromShort $ fromKey keyName key
|
||||
|
||||
genGitBundleKey :: UUID -> RawFilePath -> MeterUpdate -> Annex Key
|
||||
genGitBundleKey remoteuuid file meterupdate = do
|
||||
filesize <- liftIO $ getFileSize file
|
||||
s <- Hash.hashFile hash file meterupdate
|
||||
return $ mkKey $ \k -> k
|
||||
{ keyName = S.toShort $ fromUUID remoteuuid <> "-" <> encodeBS s
|
||||
, keyVariety = GitBundleKey
|
||||
, keySize = Just filesize
|
||||
}
|
||||
|
||||
genManifestKey :: UUID -> Key
|
||||
genManifestKey u = mkKey $ \kd -> kd
|
||||
{ keyName = S.toShort (fromUUID u)
|
||||
, keyVariety = OtherKey "GITMANIFEST"
|
||||
}
|
|
@ -1,6 +1,6 @@
|
|||
{- git-annex hashing backends
|
||||
-
|
||||
- Copyright 2011-2021 Joey Hess <id@joeyh.name>
|
||||
- Copyright 2011-2024 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
@ -12,6 +12,10 @@ module Backend.Hash (
|
|||
testKeyBackend,
|
||||
keyHash,
|
||||
descChecksum,
|
||||
Hash(..),
|
||||
cryptographicallySecure,
|
||||
hashFile,
|
||||
checkKeyChecksum
|
||||
) where
|
||||
|
||||
import Annex.Common
|
||||
|
@ -78,7 +82,7 @@ genBackend :: Hash -> Backend
|
|||
genBackend hash = Backend
|
||||
{ backendVariety = hashKeyVariety hash (HasExt False)
|
||||
, genKey = Just (keyValue hash)
|
||||
, verifyKeyContent = Just $ checkKeyChecksum hash
|
||||
, verifyKeyContent = Just $ checkKeyChecksum sameCheckSum hash
|
||||
, verifyKeyContentIncrementally = Just $ checkKeyChecksumIncremental hash
|
||||
, canUpgradeKey = Just needsUpgrade
|
||||
, fastMigrate = Just trivialMigrate
|
||||
|
@ -123,14 +127,14 @@ keyValueE hash source meterupdate =
|
|||
keyValue hash source meterupdate
|
||||
>>= addE source (const $ hashKeyVariety hash (HasExt True))
|
||||
|
||||
checkKeyChecksum :: Hash -> Key -> RawFilePath -> Annex Bool
|
||||
checkKeyChecksum hash key file = catchIOErrorType HardwareFault hwfault $ do
|
||||
checkKeyChecksum :: (Key -> String -> Bool) -> Hash -> Key -> RawFilePath -> Annex Bool
|
||||
checkKeyChecksum issame hash key file = catchIOErrorType HardwareFault hwfault $ do
|
||||
fast <- Annex.getRead Annex.fast
|
||||
exists <- liftIO $ R.doesPathExist file
|
||||
case (exists, fast) of
|
||||
(True, False) -> do
|
||||
showAction (UnquotedString descChecksum)
|
||||
sameCheckSum key
|
||||
issame key
|
||||
<$> hashFile hash file nullMeterUpdate
|
||||
_ -> return True
|
||||
where
|
||||
|
|
|
@ -18,12 +18,14 @@ import qualified Backend.External
|
|||
import qualified Backend.Hash
|
||||
import qualified Backend.WORM
|
||||
import qualified Backend.URL
|
||||
import qualified Backend.GitRemoteAnnex
|
||||
|
||||
{- Regular backends. Does not include externals or VURL. -}
|
||||
regularBackendList :: [Backend]
|
||||
regularBackendList = Backend.Hash.backends
|
||||
++ Backend.WORM.backends
|
||||
++ Backend.URL.backends
|
||||
++ Backend.GitRemoteAnnex.backends
|
||||
|
||||
{- The default hashing backend. -}
|
||||
defaultHashBackend :: Backend
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue