make everything build again after ByteString Key changes
This commit is contained in:
parent
151562b537
commit
727767e1e2
23 changed files with 79 additions and 72 deletions
|
@ -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
|
||||||
)
|
)
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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.
|
||||||
|
|
|
@ -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
|
||||||
)
|
)
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
11
Backend.hs
11
Backend.hs
|
@ -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
|
||||||
|
|
|
@ -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"
|
||||||
|
|
|
@ -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')
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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).
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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" $
|
||||||
|
|
11
Crypto.hs
11
Crypto.hs
|
@ -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 ()
|
||||||
|
|
2
Limit.hs
2
Limit.hs
|
@ -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 ()
|
||||||
|
|
4
Remote/External/Types.hs
vendored
4
Remote/External/Types.hs
vendored
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
1
Test.hs
1
Test.hs
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 ++ ")"
|
||||||
|
|
||||||
|
|
Loading…
Add table
Reference in a new issue