diff options
| -rw-r--r-- | Backend/SHA.hs | 16 | ||||
| -rw-r--r-- | Backend/URL.hs | 1 | ||||
| -rw-r--r-- | Backend/WORM.hs | 1 | ||||
| -rw-r--r-- | Command/Migrate.hs | 18 | ||||
| -rw-r--r-- | Types/Backend.hs | 1 | ||||
| -rw-r--r-- | debian/changelog | 5 |
6 files changed, 36 insertions, 6 deletions
diff --git a/Backend/SHA.hs b/Backend/SHA.hs index ef0e92d20..1a278068e 100644 --- a/Backend/SHA.hs +++ b/Backend/SHA.hs @@ -34,6 +34,7 @@ genBackend size = Just $ Backend { name = shaName size , getKey = keyValue size , fsckKey = Just $ checkKeyChecksum size + , canUpgradeKey = Just $ needsUpgrade } genBackendE :: SHASize -> Maybe Backend @@ -61,6 +62,8 @@ shaN shasize file filesize = do parse command [] = bad command parse command (l:_) | null sha = bad command + -- sha is prefixed with \ when filename contains certian chars + | "\\" `isPrefixOf` sha = drop 1 sha | otherwise = sha where sha = fst $ separate (== ' ') l @@ -137,6 +140,17 @@ checkKeyChecksum size key file = do check <$> shaN size file filesize _ -> return True where + sha = keySha key check s - | s == dropExtensions (keyName key) = True + | s == sha = True + {- A bug caused checksums to be prefixed with \ in some + - cases; still accept these as legal now that the bug has been + - fixed. -} + | '\\' : s == sha = True | otherwise = False + +keySha :: Key -> String +keySha key = dropExtensions (keyName key) + +needsUpgrade :: Key -> Bool +needsUpgrade key = "\\" `isPrefixOf` keySha key diff --git a/Backend/URL.hs b/Backend/URL.hs index 81c287cfd..9e1652970 100644 --- a/Backend/URL.hs +++ b/Backend/URL.hs @@ -24,6 +24,7 @@ backend = Backend { name = "URL" , getKey = const $ return Nothing , fsckKey = Nothing + , canUpgradeKey = Nothing } fromUrl :: String -> Maybe Integer -> Key diff --git a/Backend/WORM.hs b/Backend/WORM.hs index 523203713..3471eedc1 100644 --- a/Backend/WORM.hs +++ b/Backend/WORM.hs @@ -20,6 +20,7 @@ backend = Backend { name = "WORM" , getKey = keyValue , fsckKey = Nothing + , canUpgradeKey = Nothing } {- The key includes the file size, modification time, and the diff --git a/Command/Migrate.hs b/Command/Migrate.hs index 0b23c2a40..d486eeb09 100644 --- a/Command/Migrate.hs +++ b/Command/Migrate.hs @@ -11,6 +11,7 @@ import Common.Annex import Command import Backend import qualified Types.Key +import qualified Types.Backend import Types.KeySource import Annex.Content import qualified Command.ReKey @@ -26,7 +27,7 @@ start :: FilePath -> (Key, Backend) -> CommandStart start file (key, oldbackend) = do exists <- inAnnex key newbackend <- choosebackend =<< chooseBackend file - if (newbackend /= oldbackend || upgradableKey key) && exists + if (newbackend /= oldbackend || upgradableKey oldbackend key) && exists then do showStart "migrate" file next $ perform file key oldbackend newbackend @@ -35,10 +36,17 @@ start file (key, oldbackend) = do choosebackend Nothing = Prelude.head <$> orderedList choosebackend (Just backend) = return backend -{- Checks if a key is upgradable to a newer representation. -} -{- Ideally, all keys have file size metadata. Old keys may not. -} -upgradableKey :: Key -> Bool -upgradableKey key = isNothing $ Types.Key.keySize key +{- Checks if a key is upgradable to a newer representation. + - + - Reasons for migration: + - - Ideally, all keys have file size metadata. Old keys may not. + - - Something has changed in the backend, such as a bug fix. + -} +upgradableKey :: Backend -> Key -> Bool +upgradableKey backend key = isNothing (Types.Key.keySize key) || backendupgradable + where + backendupgradable = maybe False (\a -> a key) + (Types.Backend.canUpgradeKey backend) {- Store the old backend's key in the new backend - The old backend's key is not dropped from it, because there may diff --git a/Types/Backend.hs b/Types/Backend.hs index d79787c27..c7d962db0 100644 --- a/Types/Backend.hs +++ b/Types/Backend.hs @@ -16,6 +16,7 @@ data BackendA a = Backend { name :: String , getKey :: KeySource -> a (Maybe Key) , fsckKey :: Maybe (Key -> FilePath -> a Bool) + , canUpgradeKey :: Maybe (Key -> Bool) } instance Show (BackendA a) where diff --git a/debian/changelog b/debian/changelog index ab3f6f14b..e390adf27 100644 --- a/debian/changelog +++ b/debian/changelog @@ -10,6 +10,11 @@ git-annex (3.20121212) UNRELEASED; urgency=low * Bugfix: Fixed bug parsing transfer info files, where the newline after the filename was included in it. This was generally benign, but in the assistant, it caused unexpected dropping of preferred content. + * Bugfix: Remove leading \ from checksums output by sha*sum commands, + when the filename contains \ or a newline. Closes: #696384 + * fsck: Still accept checksums with a leading \ as valid, now that + above bug is fixed. + * migrate: Remove leading \ in checksums. -- Joey Hess <joeyh@debian.org> Thu, 13 Dec 2012 14:06:43 -0400 |