d010ab04be
This assumes that no location log files will have a newline or carriage
return in their name. catObjectStream skips any such files due to
cat-file not supporting them.
Keys have been prevented from containing newlines since 2011,
commit 480495beb4. If some old repo
had a key with a newline in it, --all will just skip processing that key.
Other things, like .git/annex/unused files certianly assume no newlines in
keys too, and AFAICR, such keys never actually worked.
Carriage return is escaped by preSanitizeKeyName since 2013. WORM keys
generated before that point could perhaps contain a CR. (URL probably not,
http probably doesn't support an URL with a raw CR in it.) So, added
a warning in fsck about such keys. Although, fsck --all will naturally
skip them, so won't be able to warn about them. Not entirely
satisfactory, but I'll bet there are not really any such keys in
existence.
Thanks to Lukey for finding this optimisation.
64 lines
1.8 KiB
Haskell
64 lines
1.8 KiB
Haskell
{- git-annex "WORM" backend -- Write Once, Read Many
|
|
-
|
|
- Copyright 2010 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Backend.WORM (backends) where
|
|
|
|
import Annex.Common
|
|
import Types.Key
|
|
import Types.Backend
|
|
import Types.KeySource
|
|
import Backend.Utilities
|
|
import Git.FilePath
|
|
import Utility.Metered
|
|
|
|
import qualified Data.ByteString.Char8 as S8
|
|
import qualified Utility.RawFilePath as R
|
|
|
|
backends :: [Backend]
|
|
backends = [backend]
|
|
|
|
backend :: Backend
|
|
backend = Backend
|
|
{ backendVariety = WORMKey
|
|
, getKey = Just keyValue
|
|
, verifyKeyContent = Nothing
|
|
, canUpgradeKey = Just needsUpgrade
|
|
, fastMigrate = Just removeProblemChars
|
|
, isStableKey = const True
|
|
}
|
|
|
|
{- The key includes the file size, modification time, and the
|
|
- original filename relative to the top of the git repository.
|
|
-}
|
|
keyValue :: KeySource -> MeterUpdate -> Annex Key
|
|
keyValue source _ = do
|
|
let f = contentLocation source
|
|
stat <- liftIO $ R.getFileStatus f
|
|
sz <- liftIO $ getFileSize' (fromRawFilePath f) stat
|
|
relf <- fromRawFilePath . getTopFilePath
|
|
<$> inRepo (toTopFilePath $ keyFilename source)
|
|
return $ mkKey $ \k -> k
|
|
{ keyName = genKeyName relf
|
|
, keyVariety = WORMKey
|
|
, keySize = Just sz
|
|
, keyMtime = Just $ modificationTime stat
|
|
}
|
|
|
|
{- Old WORM keys could contain spaces and carriage returns,
|
|
- and can be upgraded to remove them. -}
|
|
needsUpgrade :: Key -> Bool
|
|
needsUpgrade key = any (`S8.elem` fromKey keyName key) [' ', '\r']
|
|
|
|
removeProblemChars :: Key -> Backend -> AssociatedFile -> Annex (Maybe Key)
|
|
removeProblemChars oldkey newbackend _
|
|
| migratable = return $ Just $ alterKey oldkey $ \d -> d
|
|
{ keyName = encodeBS $ reSanitizeKeyName $ decodeBS $ keyName d }
|
|
| otherwise = return Nothing
|
|
where
|
|
migratable = oldvariety == newvariety
|
|
oldvariety = fromKey keyVariety oldkey
|
|
newvariety = backendVariety newbackend
|