implement URL to VURL migration
This needs the content to be present in order to hash it. But it's not possible for a module used by Backend.URL to call inAnnex because that would entail a dependency loop. So instead, rely on the fact that Command.Migrate calls inAnnex before performing a migration. But, Command.ExamineKey calls fastMigrate and the key may or may not exist, and it's not wanting to actually perform a migration in any case. To handle that, had to add an additional value to fastMigrate to indicate whether the content is inAnnex. Factored generateEquivilantKey out of Remote.Web. Note that migrateFromURLToVURL hardcodes use of the SHA256E backend. It would have been difficult not to, given all the dependency loop issues. But --backend and annex.backend are used to tell git-annex migrate to use VURL in any case, so there's no config knob that the user could expect to configure that. Sponsored-by: Brock Spratlen on Patreon
This commit is contained in:
parent
2b5ba03c01
commit
e7652b0997
14 changed files with 82 additions and 34 deletions
|
@ -53,8 +53,10 @@ cryptographicallySecure (Blake2spHash _) = True
|
|||
cryptographicallySecure SHA1Hash = False
|
||||
cryptographicallySecure MD5Hash = False
|
||||
|
||||
{- Order is slightly significant; want SHA256 first, and more general
|
||||
- sizes earlier. -}
|
||||
{- Order is significant. The first hash is the default one that git-annex
|
||||
- uses, and must be cryptographically secure.
|
||||
-
|
||||
- Also, want more common sizes earlier than uncommon sizes. -}
|
||||
hashes :: [Hash]
|
||||
hashes = concat
|
||||
[ map (SHA2Hash . HashSize) [256, 512, 224, 384]
|
||||
|
@ -167,8 +169,8 @@ needsUpgrade key = or
|
|||
, not (hasExt (fromKey keyVariety key)) && keyHash key /= S.fromShort (fromKey keyName key)
|
||||
]
|
||||
|
||||
trivialMigrate :: Key -> Backend -> AssociatedFile -> Annex (Maybe Key)
|
||||
trivialMigrate oldkey newbackend afile = trivialMigrate' oldkey newbackend afile
|
||||
trivialMigrate :: Key -> Backend -> AssociatedFile -> Bool -> Annex (Maybe Key)
|
||||
trivialMigrate oldkey newbackend afile _inannex = trivialMigrate' oldkey newbackend afile
|
||||
<$> (annexMaxExtensionLength <$> Annex.getGitConfig)
|
||||
|
||||
trivialMigrate' :: Key -> Backend -> AssociatedFile -> Maybe Int -> Maybe Key
|
||||
|
|
|
@ -14,6 +14,7 @@ import Annex.Common
|
|||
import Types.Key
|
||||
import Types.Backend
|
||||
import Backend.Utilities
|
||||
import Backend.VURL.Utilities (migrateFromURLToVURL)
|
||||
|
||||
backends :: [Backend]
|
||||
backends = [backendURL]
|
||||
|
@ -25,7 +26,7 @@ backendURL = Backend
|
|||
, verifyKeyContent = Nothing
|
||||
, verifyKeyContentIncrementally = Nothing
|
||||
, canUpgradeKey = Nothing
|
||||
, fastMigrate = Nothing
|
||||
, fastMigrate = Just migrateFromURLToVURL
|
||||
-- The content of an url can change at any time, so URL keys are
|
||||
-- not stable.
|
||||
, isStableKey = const False
|
||||
|
|
|
@ -99,4 +99,3 @@ backendVURL = Backend
|
|||
allowedequiv ek = fromKey keyVariety ek /= VURLKey
|
||||
varietymap = makeVarietyMap regularBackendList
|
||||
getbackend ek = maybeLookupBackendVarietyMap (fromKey keyVariety ek) varietymap
|
||||
|
||||
|
|
51
Backend/VURL/Utilities.hs
Normal file
51
Backend/VURL/Utilities.hs
Normal file
|
@ -0,0 +1,51 @@
|
|||
{- git-annex VURL backend utilities
|
||||
-
|
||||
- Copyright 2024 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Backend.VURL.Utilities where
|
||||
|
||||
import Annex.Common
|
||||
import Types.Key
|
||||
import Types.Backend
|
||||
import Types.KeySource
|
||||
import Logs.EquivilantKeys
|
||||
import qualified Backend.Hash
|
||||
import Utility.Metered
|
||||
|
||||
migrateFromURLToVURL :: Key -> Backend -> AssociatedFile -> Bool -> Annex (Maybe Key)
|
||||
migrateFromURLToVURL oldkey newbackend _af inannex
|
||||
| inannex && fromKey keyVariety oldkey == URLKey && backendVariety newbackend == VURLKey = do
|
||||
let newkey = mkKey $ const $
|
||||
(keyData oldkey)
|
||||
{ keyVariety = VURLKey }
|
||||
contentfile <- calcRepo (gitAnnexLocation oldkey)
|
||||
generateEquivilantKey hashbackend contentfile >>= \case
|
||||
Nothing -> return Nothing
|
||||
Just ek -> do
|
||||
setEquivilantKey newkey ek
|
||||
return (Just newkey)
|
||||
| otherwise = do
|
||||
liftIO $ print ("migrateFromURL", inannex, fromKey keyVariety oldkey)
|
||||
return Nothing
|
||||
where
|
||||
-- Relies on the first hash being cryptographically secure, and the
|
||||
-- default hash used by git-annex.
|
||||
hashbackend = Prelude.head Backend.Hash.backends
|
||||
|
||||
-- The Backend must use a cryptographically secure hash.
|
||||
generateEquivilantKey :: Backend -> RawFilePath -> Annex (Maybe Key)
|
||||
generateEquivilantKey b f =
|
||||
case genKey b of
|
||||
Just genkey -> do
|
||||
showSideAction (UnquotedString Backend.Hash.descChecksum)
|
||||
Just <$> genkey source nullMeterUpdate
|
||||
Nothing -> return Nothing
|
||||
where
|
||||
source = KeySource
|
||||
{ keyFilename = mempty -- avoid adding any extension
|
||||
, contentLocation = f
|
||||
, inodeCache = Nothing
|
||||
}
|
|
@ -25,6 +25,10 @@ regularBackendList = Backend.Hash.backends
|
|||
++ Backend.WORM.backends
|
||||
++ Backend.URL.backends
|
||||
|
||||
{- The default hashing backend. -}
|
||||
defaultHashBackend :: Backend
|
||||
defaultHashBackend = Prelude.head regularBackendList
|
||||
|
||||
makeVarietyMap :: [Backend] -> M.Map KeyVariety Backend
|
||||
makeVarietyMap l = M.fromList $ zip (map backendVariety l) l
|
||||
|
||||
|
|
|
@ -59,8 +59,8 @@ needsUpgrade :: Key -> Bool
|
|||
needsUpgrade key =
|
||||
any (`S8.elem` S.fromShort (fromKey keyName key)) [' ', '\r']
|
||||
|
||||
removeProblemChars :: Key -> Backend -> AssociatedFile -> Annex (Maybe Key)
|
||||
removeProblemChars oldkey newbackend _
|
||||
removeProblemChars :: Key -> Backend -> AssociatedFile -> Bool -> Annex (Maybe Key)
|
||||
removeProblemChars oldkey newbackend _ _
|
||||
| migratable = return $ Just $ alterKey oldkey $ \d -> d
|
||||
{ keyName = S.toShort $ encodeBS $ reSanitizeKeyName $ decodeBS $ S.fromShort $ keyName d }
|
||||
| otherwise = return Nothing
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue