make everything build again after ByteString Key changes

This commit is contained in:
Joey Hess 2019-01-11 16:34:04 -04:00
parent 151562b537
commit 727767e1e2
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
23 changed files with 79 additions and 72 deletions

View file

@ -405,7 +405,7 @@ warnUnverifiableInsecure k = warning $ unwords
, "this safety check.)" , "this safety check.)"
] ]
where where
kv = formatKeyVariety (keyVariety k) kv = decodeBS (formatKeyVariety (keyVariety k))
data VerifyConfig = AlwaysVerify | NoVerify | RemoteVerify Remote | DefaultVerify data VerifyConfig = AlwaysVerify | NoVerify | RemoteVerify Remote | DefaultVerify
@ -544,7 +544,7 @@ checkSecureHashes key
| cryptographicallySecure (keyVariety key) = return True | cryptographicallySecure (keyVariety key) = return True
| otherwise = ifM (annexSecureHashesOnly <$> Annex.getGitConfig) | otherwise = ifM (annexSecureHashesOnly <$> Annex.getGitConfig)
( do ( do
warning $ "annex.securehashesonly blocked adding " ++ formatKeyVariety (keyVariety key) ++ " key to annex objects" warning $ "annex.securehashesonly blocked adding " ++ decodeBS (formatKeyVariety (keyVariety key)) ++ " key to annex objects"
return False return False
, return True , return True
) )

View file

@ -15,6 +15,7 @@ import qualified Git
import qualified Types.Remote as Remote import qualified Types.Remote as Remote
import Config import Config
import Messages import Messages
import Utility.FileSystemEncoding
import qualified Data.Map as M import qualified Data.Map as M
import Control.Applicative import Control.Applicative
@ -35,8 +36,8 @@ exportKey sha = mk <$> catKey sha
where where
mk (Just k) = AnnexKey k mk (Just k) = AnnexKey k
mk Nothing = GitKey $ Key mk Nothing = GitKey $ Key
{ keyName = Git.fromRef sha { keyName = encodeBS $ Git.fromRef sha
, keyVariety = SHA1Key (HasExt False) , keyVariety = SHA1Key (HasExt False) mempty
, keySize = Nothing , keySize = Nothing
, keyMtime = Nothing , keyMtime = Nothing
, keyChunkSize = Nothing , keyChunkSize = Nothing

View file

@ -76,8 +76,6 @@ module Annex.Locations (
hashDirLower, hashDirLower,
preSanitizeKeyName, preSanitizeKeyName,
reSanitizeKeyName, reSanitizeKeyName,
prop_isomorphic_fileKey
) where ) where
import Data.Char import Data.Char
@ -85,7 +83,6 @@ import Data.Default
import Common import Common
import Key import Key
import Types.Key
import Types.UUID import Types.UUID
import Types.GitConfig import Types.GitConfig
import Types.Difference import Types.Difference
@ -529,14 +526,6 @@ fileKey = file2key . unesc []
unesc r ('&':'a':cs) = unesc ('&':r) cs unesc r ('&':'a':cs) = unesc ('&':r) cs
unesc r (c:cs) = unesc (c:r) cs unesc r (c:cs) = unesc (c:r) cs
{- for quickcheck -}
prop_isomorphic_fileKey :: String -> Bool
prop_isomorphic_fileKey s
| null s = True -- it's not legal for a key to have no keyName
| otherwise= Just k == fileKey (keyFile k)
where
k = stubKey { keyName = s, keyVariety = OtherKey "test" }
{- A location to store a key on a special remote that uses a filesystem. {- A location to store a key on a special remote that uses a filesystem.
- A directory hash is used, to protect against filesystems that dislike - A directory hash is used, to protect against filesystems that dislike
- having many items in a single directory. - having many items in a single directory.

View file

@ -178,7 +178,7 @@ checkSecureHashes t a
| cryptographicallySecure variety = a | cryptographicallySecure variety = a
| otherwise = ifM (annexSecureHashesOnly <$> Annex.getGitConfig) | otherwise = ifM (annexSecureHashesOnly <$> Annex.getGitConfig)
( do ( do
warning $ "annex.securehashesonly blocked transfer of " ++ formatKeyVariety variety ++ " key" warning $ "annex.securehashesonly blocked transfer of " ++ decodeBS (formatKeyVariety variety) ++ " key"
return observeFailure return observeFailure
, a , a
) )

View file

@ -6,6 +6,7 @@
-} -}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Assistant.Threads.SanityChecker ( module Assistant.Threads.SanityChecker (
sanityCheckerStartupThread, sanityCheckerStartupThread,
@ -52,6 +53,7 @@ import Utility.DiskFree
import Data.Time.Clock.POSIX import Data.Time.Clock.POSIX
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.ByteString as S
{- This thread runs once at startup, and most other threads wait for it {- This thread runs once at startup, and most other threads wait for it
- to finish. (However, the webapp thread does not, to prevent the UI - to finish. (However, the webapp thread does not, to prevent the UI
@ -309,7 +311,7 @@ cleanReallyOldTmp = do
cleanjunk check f = case fileKey (takeFileName f) of cleanjunk check f = case fileKey (takeFileName f) of
Nothing -> cleanOld check f Nothing -> cleanOld check f
Just k Just k
| "GPGHMAC" `isPrefixOf` formatKeyVariety (keyVariety k) -> | "GPGHMAC" `S.isPrefixOf` formatKeyVariety (keyVariety k) ->
cleanOld check f cleanOld check f
| otherwise -> noop | otherwise -> noop

View file

@ -29,6 +29,7 @@ import qualified Backend.WORM
import qualified Backend.URL import qualified Backend.URL
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.ByteString.Char8 as S8
list :: [Backend] list :: [Backend]
list = Backend.Hash.backends ++ Backend.WORM.backends ++ Backend.URL.backends list = Backend.Hash.backends ++ Backend.WORM.backends ++ Backend.URL.backends
@ -46,7 +47,7 @@ defaultBackend = maybe cache return =<< Annex.getState Annex.backend
Annex.changeState $ \s -> s { Annex.backend = Just b } Annex.changeState $ \s -> s { Annex.backend = Just b }
return b return b
valid name = not (null name) valid name = not (null name)
lookupname = lookupBackendVariety . parseKeyVariety lookupname = lookupBackendVariety . parseKeyVariety . encodeBS
{- Generates a key for a file. -} {- Generates a key for a file. -}
genKey :: KeySource -> Maybe Backend -> Annex (Maybe (Key, Backend)) genKey :: KeySource -> Maybe Backend -> Annex (Maybe (Key, Backend))
@ -57,7 +58,7 @@ genKey source preferredbackend = do
Just k -> Just (makesane k, b) Just k -> Just (makesane k, b)
where where
-- keyNames should not contain newline characters. -- keyNames should not contain newline characters.
makesane k = k { keyName = map fixbadchar (keyName k) } makesane k = k { keyName = S8.map fixbadchar (keyName k) }
fixbadchar c fixbadchar c
| c == '\n' = '_' | c == '\n' = '_'
| otherwise = c | otherwise = c
@ -66,7 +67,7 @@ getBackend :: FilePath -> Key -> Annex (Maybe Backend)
getBackend file k = case maybeLookupBackendVariety (keyVariety k) of getBackend file k = case maybeLookupBackendVariety (keyVariety k) of
Just backend -> return $ Just backend Just backend -> return $ Just backend
Nothing -> do Nothing -> do
warning $ "skipping " ++ file ++ " (unknown backend " ++ formatKeyVariety (keyVariety k) ++ ")" warning $ "skipping " ++ file ++ " (unknown backend " ++ decodeBS (formatKeyVariety (keyVariety k)) ++ ")"
return Nothing return Nothing
{- Looks up the backend that should be used for a file. {- Looks up the backend that should be used for a file.
@ -75,7 +76,7 @@ getBackend file k = case maybeLookupBackendVariety (keyVariety k) of
chooseBackend :: FilePath -> Annex (Maybe Backend) chooseBackend :: FilePath -> Annex (Maybe Backend)
chooseBackend f = Annex.getState Annex.forcebackend >>= go chooseBackend f = Annex.getState Annex.forcebackend >>= go
where where
go Nothing = maybeLookupBackendVariety . parseKeyVariety go Nothing = maybeLookupBackendVariety . parseKeyVariety . encodeBS
<$> checkAttr "annex.backend" f <$> checkAttr "annex.backend" f
go (Just _) = Just <$> defaultBackend go (Just _) = Just <$> defaultBackend
@ -83,7 +84,7 @@ chooseBackend f = Annex.getState Annex.forcebackend >>= go
lookupBackendVariety :: KeyVariety -> Backend lookupBackendVariety :: KeyVariety -> Backend
lookupBackendVariety v = fromMaybe unknown $ maybeLookupBackendVariety v lookupBackendVariety v = fromMaybe unknown $ maybeLookupBackendVariety v
where where
unknown = giveup $ "unknown backend " ++ formatKeyVariety v unknown = giveup $ "unknown backend " ++ decodeBS (formatKeyVariety v)
maybeLookupBackendVariety :: KeyVariety -> Maybe Backend maybeLookupBackendVariety :: KeyVariety -> Maybe Backend
maybeLookupBackendVariety v = M.lookup v varietyMap maybeLookupBackendVariety v = M.lookup v varietyMap

View file

@ -1,11 +1,12 @@
{- git-annex hashing backends {- git-annex hashing backends
- -
- Copyright 2011-2018 Joey Hess <id@joeyh.name> - Copyright 2011-2019 Joey Hess <id@joeyh.name>
- -
- Licensed under the GNU GPL version 3 or higher. - Licensed under the GNU GPL version 3 or higher.
-} -}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Backend.Hash ( module Backend.Hash (
backends, backends,
@ -19,6 +20,8 @@ import Types.Backend
import Types.KeySource import Types.KeySource
import Utility.Hash import Utility.Hash
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import Data.Char import Data.Char
@ -71,15 +74,15 @@ genBackendE hash = (genBackend hash)
} }
hashKeyVariety :: Hash -> HasExt -> KeyVariety hashKeyVariety :: Hash -> HasExt -> KeyVariety
hashKeyVariety MD5Hash = MD5Key hashKeyVariety MD5Hash he = MD5Key he mempty
hashKeyVariety SHA1Hash = SHA1Key hashKeyVariety SHA1Hash he = SHA1Key he mempty
hashKeyVariety (SHA2Hash size) = SHA2Key size hashKeyVariety (SHA2Hash size) he = SHA2Key size he mempty
hashKeyVariety (SHA3Hash size) = SHA3Key size hashKeyVariety (SHA3Hash size) he = SHA3Key size he mempty
hashKeyVariety (SkeinHash size) = SKEINKey size hashKeyVariety (SkeinHash size) he = SKEINKey size he mempty
#if MIN_VERSION_cryptonite(0,23,0) #if MIN_VERSION_cryptonite(0,23,0)
hashKeyVariety (Blake2bHash size) = Blake2bKey size hashKeyVariety (Blake2bHash size) he = Blake2bKey size he mempty
hashKeyVariety (Blake2sHash size) = Blake2sKey size hashKeyVariety (Blake2sHash size) he = Blake2sKey size he mempty
hashKeyVariety (Blake2spHash size) = Blake2spKey size hashKeyVariety (Blake2spHash size) he = Blake2spKey size he mempty
#endif #endif
{- A key is a hash of its contents. -} {- A key is a hash of its contents. -}
@ -89,7 +92,7 @@ keyValue hash source = do
filesize <- liftIO $ getFileSize file filesize <- liftIO $ getFileSize file
s <- hashFile hash file s <- hashFile hash file
return $ Just $ stubKey return $ Just $ stubKey
{ keyName = s { keyName = encodeBS s
, keyVariety = hashKeyVariety hash (HasExt False) , keyVariety = hashKeyVariety hash (HasExt False)
, keySize = Just filesize , keySize = Just filesize
} }
@ -102,7 +105,7 @@ keyValueE hash source = keyValue hash source >>= maybe (return Nothing) addE
maxlen <- annexMaxExtensionLength <$> Annex.getGitConfig maxlen <- annexMaxExtensionLength <$> Annex.getGitConfig
let ext = selectExtension maxlen (keyFilename source) let ext = selectExtension maxlen (keyFilename source)
return $ Just $ k return $ Just $ k
{ keyName = keyName k ++ ext { keyName = keyName k <> encodeBS ext
, keyVariety = hashKeyVariety hash (HasExt True) , keyVariety = hashKeyVariety hash (HasExt True)
} }
@ -132,7 +135,7 @@ checkKeyChecksum hash key file = catchIOErrorType HardwareFault hwfault $ do
check <$> hashFile hash file check <$> hashFile hash file
_ -> return True _ -> return True
where where
expected = keyHash key expected = decodeBS (keyHash key)
check s check s
| s == expected = True | s == expected = True
{- A bug caused checksums to be prefixed with \ in some {- A bug caused checksums to be prefixed with \ in some
@ -145,8 +148,8 @@ checkKeyChecksum hash key file = catchIOErrorType HardwareFault hwfault $ do
warning $ "hardware fault: " ++ show e warning $ "hardware fault: " ++ show e
return False return False
keyHash :: Key -> String keyHash :: Key -> S.ByteString
keyHash key = dropExtensions (keyName key) keyHash = fst . splitKeyNameExtension
validInExtension :: Char -> Bool validInExtension :: Char -> Bool
validInExtension c validInExtension c
@ -163,8 +166,8 @@ validInExtension c
-} -}
needsUpgrade :: Key -> Bool needsUpgrade :: Key -> Bool
needsUpgrade key = or needsUpgrade key = or
[ "\\" `isPrefixOf` keyHash key [ "\\" `S8.isPrefixOf` keyHash key
, any (not . validInExtension) (takeExtensions $ keyName key) , any (not . validInExtension) (decodeBS $ snd $ splitKeyNameExtension key)
, not (hasExt (keyVariety key)) && keyHash key /= keyName key , not (hasExt (keyVariety key)) && keyHash key /= keyName key
] ]
@ -184,7 +187,7 @@ trivialMigrate' oldkey newbackend afile maxextlen
AssociatedFile Nothing -> Nothing AssociatedFile Nothing -> Nothing
AssociatedFile (Just file) -> Just $ oldkey AssociatedFile (Just file) -> Just $ oldkey
{ keyName = keyHash oldkey { keyName = keyHash oldkey
++ selectExtension maxextlen file <> encodeBS (selectExtension maxextlen file)
, keyVariety = newvariety , keyVariety = newvariety
} }
{- Upgrade to fix bad previous migration that created a {- Upgrade to fix bad previous migration that created a
@ -285,5 +288,5 @@ testKeyBackend =
let b = genBackendE (SHA2Hash (HashSize 256)) let b = genBackendE (SHA2Hash (HashSize 256))
in b { getKey = (fmap addE) <$$> getKey b } in b { getKey = (fmap addE) <$$> getKey b }
where where
addE k = k { keyName = keyName k ++ longext } addE k = k { keyName = keyName k <> longext }
longext = ".this-is-a-test-key" longext = ".this-is-a-test-key"

View file

@ -1,6 +1,6 @@
{- git-annex backend utilities {- git-annex backend utilities
- -
- Copyright 2012 Joey Hess <id@joeyh.name> - Copyright 2012-2019 Joey Hess <id@joeyh.name>
- -
- Licensed under the GNU GPL version 3 or higher. - Licensed under the GNU GPL version 3 or higher.
-} -}
@ -10,17 +10,19 @@ module Backend.Utilities where
import Annex.Common import Annex.Common
import Utility.Hash import Utility.Hash
import qualified Data.ByteString as S
{- Generates a keyName from an input string. Takes care of sanitizing it. {- Generates a keyName from an input string. Takes care of sanitizing it.
- If it's not too long, the full string is used as the keyName. - If it's not too long, the full string is used as the keyName.
- Otherwise, it's truncated, and its md5 is prepended to ensure a unique - Otherwise, it's truncated, and its md5 is prepended to ensure a unique
- key. -} - key. -}
genKeyName :: String -> String genKeyName :: String -> S.ByteString
genKeyName s genKeyName s
-- Avoid making keys longer than the length of a SHA256 checksum. -- Avoid making keys longer than the length of a SHA256 checksum.
| bytelen > sha256len = | bytelen > sha256len = encodeBS' $
truncateFilePath (sha256len - md5len - 1) s' ++ "-" ++ truncateFilePath (sha256len - md5len - 1) s' ++ "-" ++
show (md5 (encodeBL s)) show (md5 (encodeBL s))
| otherwise = s' | otherwise = encodeBS' s'
where where
s' = preSanitizeKeyName s s' = preSanitizeKeyName s
bytelen = length (decodeW8 s') bytelen = length (decodeW8 s')

View file

@ -14,6 +14,8 @@ import Types.KeySource
import Backend.Utilities import Backend.Utilities
import Git.FilePath import Git.FilePath
import qualified Data.ByteString.Char8 as S8
backends :: [Backend] backends :: [Backend]
backends = [backend] backends = [backend]
@ -45,12 +47,12 @@ keyValue source = do
{- Old WORM keys could contain spaces, and can be upgraded to remove them. -} {- Old WORM keys could contain spaces, and can be upgraded to remove them. -}
needsUpgrade :: Key -> Bool needsUpgrade :: Key -> Bool
needsUpgrade key = ' ' `elem` keyName key needsUpgrade key = ' ' `S8.elem` keyName key
removeSpaces :: Key -> Backend -> AssociatedFile -> Annex (Maybe Key) removeSpaces :: Key -> Backend -> AssociatedFile -> Annex (Maybe Key)
removeSpaces oldkey newbackend _ removeSpaces oldkey newbackend _
| migratable = return $ Just $ oldkey | migratable = return $ Just $ oldkey
{ keyName = reSanitizeKeyName (keyName oldkey) } { keyName = encodeBS $ reSanitizeKeyName $ decodeBS $ keyName oldkey }
| otherwise = return Nothing | otherwise = return Nothing
where where
migratable = oldvariety == newvariety migratable = oldvariety == newvariety

View file

@ -13,7 +13,9 @@ git-annex (7.20181212) UNRELEASED; urgency=medium
* Fix doubled progress display when downloading an url when -J is used. * Fix doubled progress display when downloading an url when -J is used.
* importfeed: Better error message when downloading the feed fails. * importfeed: Better error message when downloading the feed fails.
* Some optimisations, including a 10x faster timestamp parser, * Some optimisations, including a 10x faster timestamp parser,
and improved parsing and serialization of git-annex branch data. a 7x faster key parser, and improved parsing and serialization of
git-annex branch data.
* Stricter parser for keys doesn't allow doubled fields or out of order fields.
* The benchmark command, which only had some old benchmarking of the sqlite * The benchmark command, which only had some old benchmarking of the sqlite
databases before, now allows benchmarking any other git-annex commands. databases before, now allows benchmarking any other git-annex commands.
* Support being built with ghc 8.6.3 (MonadFail). * Support being built with ghc 8.6.3 (MonadFail).

View file

@ -410,4 +410,4 @@ completeRemotes = completer $ mkCompleter $ \input -> do
completeBackends :: HasCompleter f => Mod f a completeBackends :: HasCompleter f => Mod f a
completeBackends = completeWith $ completeBackends = completeWith $
map (formatKeyVariety . Backend.backendVariety) Backend.list map (decodeBS . formatKeyVariety . Backend.backendVariety) Backend.list

View file

@ -89,10 +89,10 @@ showFormatted format unformatted vars =
keyVars :: Key -> [(String, String)] keyVars :: Key -> [(String, String)]
keyVars key = keyVars key =
[ ("key", key2file key) [ ("key", key2file key)
, ("backend", formatKeyVariety $ keyVariety key) , ("backend", decodeBS $ formatKeyVariety $ keyVariety key)
, ("bytesize", size show) , ("bytesize", size show)
, ("humansize", size $ roughSize storageUnits True) , ("humansize", size $ roughSize storageUnits True)
, ("keyname", keyName key) , ("keyname", decodeBS $ keyName key)
, ("hashdirlower", hashDirLower def key) , ("hashdirlower", hashDirLower def key)
, ("hashdirmixed", hashDirMixed def key) , ("hashdirmixed", hashDirMixed def key)
, ("mtime", whenavail show $ keyMtime key) , ("mtime", whenavail show $ keyMtime key)

View file

@ -250,7 +250,7 @@ verifyLocationLog key keystatus ai = do
- config was set. -} - config was set. -}
when (present && not (cryptographicallySecure (keyVariety key))) $ when (present && not (cryptographicallySecure (keyVariety key))) $
whenM (annexSecureHashesOnly <$> Annex.getGitConfig) $ whenM (annexSecureHashesOnly <$> Annex.getGitConfig) $
warning $ "** Despite annex.securehashesonly being set, " ++ obj ++ " has content present in the annex using an insecure " ++ formatKeyVariety (keyVariety key) ++ " key" warning $ "** Despite annex.securehashesonly being set, " ++ obj ++ " has content present in the annex using an insecure " ++ decodeBS (formatKeyVariety (keyVariety key)) ++ " key"
{- In direct mode, modified files will show up as not present, {- In direct mode, modified files will show up as not present,
- but that is expected and not something to do anything about. -} - but that is expected and not something to do anything about. -}
@ -424,7 +424,7 @@ checkKeyUpgrade backend key ai (AssociatedFile (Just file)) =
[ actionItemDesc ai key [ actionItemDesc ai key
, ": Can be upgraded to an improved key format. " , ": Can be upgraded to an improved key format. "
, "You can do so by running: git annex migrate --backend=" , "You can do so by running: git annex migrate --backend="
, formatKeyVariety (keyVariety key) ++ " " , decodeBS (formatKeyVariety (keyVariety key)) ++ " "
, file , file
] ]
return True return True

View file

@ -481,7 +481,7 @@ disk_size = simpleStat "available local disk space" $
backend_usage :: Stat backend_usage :: Stat
backend_usage = stat "backend usage" $ json fmt $ backend_usage = stat "backend usage" $ json fmt $
ObjectMap . (M.mapKeys formatKeyVariety) . backendsKeys ObjectMap . (M.mapKeys (decodeBS . formatKeyVariety)) . backendsKeys
<$> cachedReferencedData <$> cachedReferencedData
where where
fmt = multiLine . map (\(b, n) -> b ++ ": " ++ show n) . sort . M.toList . fromObjectMap fmt = multiLine . map (\(b, n) -> b ++ ": " ++ show n) . sort . M.toList . fromObjectMap

View file

@ -59,7 +59,7 @@ showPackageVersion = do
vinfo "build flags" $ unwords buildFlags vinfo "build flags" $ unwords buildFlags
vinfo "dependency versions" $ unwords dependencyVersions vinfo "dependency versions" $ unwords dependencyVersions
vinfo "key/value backends" $ unwords $ vinfo "key/value backends" $ unwords $
map (formatKeyVariety . B.backendVariety) Backend.list map (decodeBS . formatKeyVariety . B.backendVariety) Backend.list
vinfo "remote types" $ unwords $ map R.typename Remote.remoteTypes vinfo "remote types" $ unwords $ map R.typename Remote.remoteTypes
vinfo "operating system" $ unwords [os, arch] vinfo "operating system" $ unwords [os, arch]
vinfo "supported repository versions" $ vinfo "supported repository versions" $

View file

@ -9,6 +9,7 @@
-} -}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-} {-# LANGUAGE Rank2Types #-}
module Crypto ( module Crypto (
@ -33,6 +34,7 @@ module Crypto (
prop_HmacSha1WithCipher_sane prop_HmacSha1WithCipher_sane
) where ) where
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import Data.ByteString.UTF8 (fromString) import Data.ByteString.UTF8 (fromString)
import qualified Data.Map as M import qualified Data.Map as M
@ -159,16 +161,17 @@ type EncKey = Key -> Key
- on content. It does need to be repeatable. -} - on content. It does need to be repeatable. -}
encryptKey :: Mac -> Cipher -> EncKey encryptKey :: Mac -> Cipher -> EncKey
encryptKey mac c k = stubKey encryptKey mac c k = stubKey
{ keyName = macWithCipher mac c (key2file k) { keyName = encodeBS (macWithCipher mac c (key2file k))
, keyVariety = OtherKey (encryptedBackendNamePrefix ++ showMac mac) , keyVariety = OtherKey $
encryptedBackendNamePrefix <> encodeBS (showMac mac)
} }
encryptedBackendNamePrefix :: String encryptedBackendNamePrefix :: S.ByteString
encryptedBackendNamePrefix = "GPG" encryptedBackendNamePrefix = "GPG"
isEncKey :: Key -> Bool isEncKey :: Key -> Bool
isEncKey k = case keyVariety k of isEncKey k = case keyVariety k of
OtherKey s -> encryptedBackendNamePrefix `isPrefixOf` s OtherKey s -> encryptedBackendNamePrefix `S.isPrefixOf` s
_ -> False _ -> False
type Feeder = Handle -> IO () type Feeder = Handle -> IO ()

View file

@ -257,7 +257,7 @@ limitInBackend :: MkLimit Annex
limitInBackend name = Right $ const $ checkKey check limitInBackend name = Right $ const $ checkKey check
where where
check key = pure $ keyVariety key == variety check key = pure $ keyVariety key == variety
variety = parseKeyVariety name variety = parseKeyVariety (encodeBS name)
{- Adds a limit to skip files not using a secure hash. -} {- Adds a limit to skip files not using a secure hash. -}
addSecureHash :: Annex () addSecureHash :: Annex ()

View file

@ -99,10 +99,10 @@ newtype SafeKey = SafeKey Key
mkSafeKey :: Key -> Either String SafeKey mkSafeKey :: Key -> Either String SafeKey
mkSafeKey k mkSafeKey k
| any isSpace (keyName k) = Left $ concat | any isSpace (decodeBS $ keyName k) = Left $ concat
[ "Sorry, this file cannot be stored on an external special remote because its key's name contains a space. " [ "Sorry, this file cannot be stored on an external special remote because its key's name contains a space. "
, "To avoid this problem, you can run: git-annex migrate --backend=" , "To avoid this problem, you can run: git-annex migrate --backend="
, formatKeyVariety (keyVariety k) , decodeBS (formatKeyVariety (keyVariety k))
, " and pass it the name of the file" , " and pass it the name of the file"
] ]
| otherwise = Right (SafeKey k) | otherwise = Right (SafeKey k)

View file

@ -208,5 +208,5 @@ adjustExportable r = case M.lookup "exporttree" (config r) of
ea <- exportActions r ea <- exportActions r
retrieveExport ea k l dest p retrieveExport ea k l dest p
else do else do
warning $ "exported content cannot be verified due to using the " ++ formatKeyVariety (keyVariety k) ++ " backend" warning $ "exported content cannot be verified due to using the " ++ decodeBS (formatKeyVariety (keyVariety k)) ++ " backend"
return False return False

View file

@ -159,7 +159,6 @@ properties :: TestTree
properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck" properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck"
[ testProperty "prop_encode_decode_roundtrip" Git.Filename.prop_encode_decode_roundtrip [ testProperty "prop_encode_decode_roundtrip" Git.Filename.prop_encode_decode_roundtrip
, testProperty "prop_encode_c_decode_c_roundtrip" Utility.Format.prop_encode_c_decode_c_roundtrip , testProperty "prop_encode_c_decode_c_roundtrip" Utility.Format.prop_encode_c_decode_c_roundtrip
, testProperty "prop_isomorphic_fileKey" Annex.Locations.prop_isomorphic_fileKey
, testProperty "prop_isomorphic_key_encode" Key.prop_isomorphic_key_encode , testProperty "prop_isomorphic_key_encode" Key.prop_isomorphic_key_encode
, testProperty "prop_isomorphic_key_decode" Key.prop_isomorphic_key_decode , testProperty "prop_isomorphic_key_decode" Key.prop_isomorphic_key_decode
, testProperty "prop_isomorphic_shellEscape" Utility.SafeCommand.prop_isomorphic_shellEscape , testProperty "prop_isomorphic_shellEscape" Utility.SafeCommand.prop_isomorphic_shellEscape

View file

@ -562,7 +562,7 @@ backendWORM :: Types.Backend
backendWORM = backend_ "WORM" backendWORM = backend_ "WORM"
backend_ :: String -> Types.Backend backend_ :: String -> Types.Backend
backend_ = Backend.lookupBackendVariety . Types.Key.parseKeyVariety backend_ = Backend.lookupBackendVariety . Types.Key.parseKeyVariety . encodeBS
getKey :: Types.Backend -> FilePath -> IO Types.Key getKey :: Types.Backend -> FilePath -> IO Types.Key
getKey b f = fromJust <$> annexeval go getKey b f = fromJust <$> annexeval go

View file

@ -12,6 +12,8 @@ module Types.Backend where
import Types.Key import Types.Key
import Types.KeySource import Types.KeySource
import Utility.FileSystemEncoding
data BackendA a = Backend data BackendA a = Backend
{ backendVariety :: KeyVariety { backendVariety :: KeyVariety
, getKey :: KeySource -> a (Maybe Key) , getKey :: KeySource -> a (Maybe Key)
@ -28,7 +30,7 @@ data BackendA a = Backend
} }
instance Show (BackendA a) where instance Show (BackendA a) where
show backend = "Backend { name =\"" ++ formatKeyVariety (backendVariety backend) ++ "\" }" show backend = "Backend { name =\"" ++ decodeBS (formatKeyVariety (backendVariety backend)) ++ "\" }"
instance Eq (BackendA a) where instance Eq (BackendA a) where
a == b = backendVariety a == backendVariety b a == b = backendVariety a == backendVariety b

View file

@ -11,6 +11,7 @@ import System.Posix.Types
import Data.Char import Data.Char
import Data.Default import Data.Default
import Data.ByteString.Builder import Data.ByteString.Builder
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy as L
import Annex.Common import Annex.Common
@ -133,7 +134,7 @@ oldlog2key l
where where
len = length l - 4 len = length l - 4
k = readKey1 (take len l) k = readKey1 (take len l)
sane = (not . null $ keyName k) && (not . null $ formatKeyVariety $ keyVariety k) sane = (not . S.null $ keyName k) && (not . S.null $ formatKeyVariety $ keyVariety k)
-- WORM backend keys: "WORM:mtime:size:filename" -- WORM backend keys: "WORM:mtime:size:filename"
-- all the rest: "backend:key" -- all the rest: "backend:key"
@ -145,8 +146,8 @@ readKey1 :: String -> Key
readKey1 v readKey1 v
| mixup = fromJust $ file2key $ intercalate ":" $ Prelude.tail bits | mixup = fromJust $ file2key $ intercalate ":" $ Prelude.tail bits
| otherwise = stubKey | otherwise = stubKey
{ keyName = n { keyName = encodeBS n
, keyVariety = parseKeyVariety b , keyVariety = parseKeyVariety (encodeBS b)
, keySize = s , keySize = s
, keyMtime = t , keyMtime = t
} }
@ -165,11 +166,11 @@ readKey1 v
showKey1 :: Key -> String showKey1 :: Key -> String
showKey1 Key { keyName = n , keyVariety = v, keySize = s, keyMtime = t } = showKey1 Key { keyName = n , keyVariety = v, keySize = s, keyMtime = t } =
intercalate ":" $ filter (not . null) [b, showifhere t, showifhere s, n] intercalate ":" $ filter (not . null) [b, showifhere t, showifhere s, decodeBS n]
where where
showifhere Nothing = "" showifhere Nothing = ""
showifhere (Just x) = show x showifhere (Just x) = show x
b = formatKeyVariety v b = decodeBS $ formatKeyVariety v
keyFile1 :: Key -> FilePath keyFile1 :: Key -> FilePath
keyFile1 key = replace "/" "%" $ replace "%" "&s" $ replace "&" "&a" $ showKey1 key keyFile1 key = replace "/" "%" $ replace "%" "&s" $ replace "&" "&a" $ showKey1 key
@ -202,8 +203,8 @@ lookupFile1 file = do
Just backend -> return $ Just (k, backend) Just backend -> return $ Just (k, backend)
where where
k = fileKey1 l k = fileKey1 l
bname = formatKeyVariety (keyVariety k) bname = decodeBS (formatKeyVariety (keyVariety k))
kname = keyName k kname = decodeBS (keyName k)
skip = "skipping " ++ file ++ skip = "skipping " ++ file ++
" (unknown backend " ++ bname ++ ")" " (unknown backend " ++ bname ++ ")"