diff --git a/Backend/GitRemoteAnnex.hs b/Backend/GitRemoteAnnex.hs index bb825a917e..84da8aee44 100644 --- a/Backend/GitRemoteAnnex.hs +++ b/Backend/GitRemoteAnnex.hs @@ -14,6 +14,7 @@ module Backend.GitRemoteAnnex ( backends, genGitBundleKey, genManifestKey, + isGitRemoteAnnexKey, ) where import Annex.Common @@ -24,9 +25,10 @@ import Utility.Metered import qualified Backend.Hash as Hash import qualified Data.ByteString.Short as S +import qualified Data.ByteString.Char8 as B8 backends :: [Backend] -backends = [gitbundle] +backends = [gitbundle, gitmanifest] gitbundle :: Backend gitbundle = Backend @@ -44,6 +46,19 @@ gitbundle = Backend Hash.cryptographicallySecure hash } +gitmanifest :: Backend +gitmanifest = Backend + { backendVariety = GitManifestKey + , genKey = Nothing + , verifyKeyContent = Nothing + , verifyKeyContentIncrementally = Nothing + , canUpgradeKey = Nothing + , fastMigrate = Nothing + , isStableKey = const True + , isCryptographicallySecure = False + , isCryptographicallySecureKey = const $ pure False + } + -- git bundle keys use the sha256 hash. hash :: Hash.Hash hash = Hash.SHA2Hash (HashSize 256) @@ -72,5 +87,18 @@ genGitBundleKey remoteuuid file meterupdate = do genManifestKey :: UUID -> Key genManifestKey u = mkKey $ \kd -> kd { keyName = S.toShort (fromUUID u) - , keyVariety = OtherKey "GITMANIFEST" + , keyVariety = GitManifestKey } + +{- Is the key a manifest or bundle key that belongs to the special remote + - with this uuid? -} +isGitRemoteAnnexKey :: UUID -> Key -> Bool +isGitRemoteAnnexKey u k = + case fromKey keyVariety k of + GitBundleKey -> sameuuid $ + -- Remove the checksum that comes after the UUID. + B8.dropEnd 1 . B8.dropWhileEnd (/= '-') + GitManifestKey -> sameuuid id + _ -> False + where + sameuuid f = fromUUID u == f (S.fromShort (fromKey keyName k)) diff --git a/Command/Unused.hs b/Command/Unused.hs index eebe24ca36..75cf94a3e2 100644 --- a/Command/Unused.hs +++ b/Command/Unused.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010-2016 Joey Hess + - Copyright 2010-2024 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -34,6 +34,7 @@ import Logs.View (is_branchView) import Annex.BloomFilter import qualified Database.Keys import Annex.InodeSentinal +import Backend.GitRemoteAnnex (isGitRemoteAnnexKey) import qualified Data.Map as M import qualified Data.ByteString as S @@ -104,7 +105,8 @@ checkRemoteUnused remotename refspec = go =<< Remote.nameToUUID remotename _ <- check "" (remoteUnusedMsg r remotename) (remoteunused u) 0 next $ return True remoteunused u = loggedKeysFor u >>= \case - Just ks -> excludeReferenced refspec ks + Just ks -> filter (not . isGitRemoteAnnexKey u) + <$> excludeReferenced refspec ks Nothing -> giveup "This repository is read-only." check :: String -> ([(Int, Key)] -> String) -> Annex [Key] -> Int -> Annex Int diff --git a/Types/Key.hs b/Types/Key.hs index b883ac0d9b..2d901c0af7 100644 --- a/Types/Key.hs +++ b/Types/Key.hs @@ -220,6 +220,7 @@ data KeyVariety | URLKey | VURLKey | GitBundleKey + | GitManifestKey -- A key that is handled by some external backend. | ExternalKey S.ByteString HasExt -- Some repositories may contain keys of other varieties, @@ -255,6 +256,7 @@ hasExt WORMKey = False hasExt URLKey = False hasExt VURLKey = False hasExt GitBundleKey = False +hasExt GitManifestKey = False hasExt (ExternalKey _ (HasExt b)) = b hasExt (OtherKey s) = (snd <$> S8.unsnoc s) == Just 'E' @@ -285,6 +287,7 @@ formatKeyVariety v = case v of URLKey -> "URL" VURLKey -> "VURL" GitBundleKey -> "GITBUNDLE" + GitManifestKey -> "GITMANIFEST" ExternalKey s e -> adde e ("X" <> s) OtherKey s -> s where diff --git a/doc/todo/git-remote-annex.mdwn b/doc/todo/git-remote-annex.mdwn index 514e2f2a38..bbb779a7b8 100644 --- a/doc/todo/git-remote-annex.mdwn +++ b/doc/todo/git-remote-annex.mdwn @@ -10,11 +10,6 @@ will be available to users who don't use datalad. This is implememented and working. Remaining todo list for it: -* git-annex unused --from remote should not treat git manifest and bundle - keys as unused, since that could lead to data loss. It's fine for - git-annex unused on the local repo to treat those as unused since they're - only a local cache. - * Test pushes that delete branches. * Test incremental pushes that don't fast-forward.