add KeyVariety type
Where before the "name" of a key and a backend was a string, this makes it a concrete data type. This is groundwork for allowing some varieties of keys to be disabled in file2key, so git-annex won't use them at all. Benchmarks ran in my big repo: old git-annex info: real 0m3.338s user 0m3.124s sys 0m0.244s new git-annex info: real 0m3.216s user 0m3.024s sys 0m0.220s new git-annex find: real 0m7.138s user 0m6.924s sys 0m0.252s old git-annex find: real 0m7.433s user 0m7.240s sys 0m0.232s Surprising result; I'd have expected it to be slower since it now parses all the key varieties. But, the parser is very simple and perhaps sharing KeyVarieties uses less memory or something like that. This commit was supported by the NSF-funded DataLad project.
This commit is contained in:
Joey Hess
parent
ca0daa8bb8
commit
9c4650358c
22 changed files with 202 additions and 99 deletions
|
|
@ -341,7 +341,7 @@ verifyKeyContent v UnVerified k f = ifM (shouldVerify v)
|
|||
Just size -> do
|
||||
size' <- liftIO $ catchDefaultIO 0 $ getFileSize f
|
||||
return (size' == size)
|
||||
verifycontent = case Types.Backend.verifyKeyContent =<< Backend.maybeLookupBackendName (keyBackendName k) of
|
||||
verifycontent = case Types.Backend.verifyKeyContent =<< Backend.maybeLookupBackendVariety (keyVariety k) of
|
||||
Nothing -> return True
|
||||
Just verifier -> verifier k f
|
||||
|
||||
|
|
|
|||
|
|
@ -78,6 +78,7 @@ import Data.Default
|
|||
|
||||
import Common
|
||||
import Key
|
||||
import Types.Key
|
||||
import Types.UUID
|
||||
import Types.GitConfig
|
||||
import Types.Difference
|
||||
|
|
@ -478,7 +479,7 @@ 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, keyBackendName = "test" }
|
||||
k = stubKey { keyName = s, keyVariety = OtherKey "test" }
|
||||
|
||||
{- 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
|
||||
|
|
|
|||
|
|
@ -39,6 +39,7 @@ import Git.Index
|
|||
import Assistant.Unused
|
||||
import Logs.Unused
|
||||
import Types.Transfer
|
||||
import Types.Key
|
||||
import Annex.Path
|
||||
import qualified Annex
|
||||
#ifdef WITH_WEBAPP
|
||||
|
|
@ -308,7 +309,7 @@ cleanReallyOldTmp = do
|
|||
cleanjunk check f = case fileKey (takeFileName f) of
|
||||
Nothing -> cleanOld check f
|
||||
Just k
|
||||
| "GPGHMAC" `isPrefixOf` keyBackendName k ->
|
||||
| "GPGHMAC" `isPrefixOf` formatKeyVariety (keyVariety k) ->
|
||||
cleanOld check f
|
||||
| otherwise -> noop
|
||||
|
||||
|
|
|
|||
|
|
@ -115,7 +115,7 @@ distributionDownloadComplete d dest cleanup t
|
|||
| otherwise = cleanup
|
||||
where
|
||||
k = distributionKey d
|
||||
fsckit f = case Backend.maybeLookupBackendName (Types.Key.keyBackendName k) of
|
||||
fsckit f = case Backend.maybeLookupBackendVariety (Types.Key.keyVariety k) of
|
||||
Nothing -> return $ Just f
|
||||
Just b -> case Types.Backend.verifyKeyContent b of
|
||||
Nothing -> return $ Just f
|
||||
|
|
|
|||
38
Backend.hs
38
Backend.hs
|
|
@ -1,6 +1,6 @@
|
|||
{- git-annex key/value backends
|
||||
-
|
||||
- Copyright 2010-2014 Joey Hess <id@joeyh.name>
|
||||
- Copyright 2010-2017 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
|
@ -11,14 +11,15 @@ module Backend (
|
|||
genKey,
|
||||
getBackend,
|
||||
chooseBackend,
|
||||
lookupBackendName,
|
||||
maybeLookupBackendName,
|
||||
lookupBackendVariety,
|
||||
maybeLookupBackendVariety,
|
||||
isStableKey,
|
||||
) where
|
||||
|
||||
import Annex.Common
|
||||
import qualified Annex
|
||||
import Annex.CheckAttr
|
||||
import Types.Key
|
||||
import Types.KeySource
|
||||
import qualified Types.Backend as B
|
||||
|
||||
|
|
@ -42,14 +43,15 @@ orderedList = do
|
|||
f <- Annex.getState Annex.forcebackend
|
||||
case f of
|
||||
Just name | not (null name) ->
|
||||
return [lookupBackendName name]
|
||||
return [lookupname name]
|
||||
_ -> do
|
||||
l' <- gen . annexBackends <$> Annex.getGitConfig
|
||||
Annex.changeState $ \s -> s { Annex.backends = l' }
|
||||
return l'
|
||||
where
|
||||
gen [] = list
|
||||
gen l = map lookupBackendName l
|
||||
gen ns = map lookupname ns
|
||||
lookupname = lookupBackendVariety . parseKeyVariety
|
||||
|
||||
{- Generates a key for a file, trying each backend in turn until one
|
||||
- accepts it. -}
|
||||
|
|
@ -73,11 +75,10 @@ genKey' (b:bs) source = do
|
|||
| otherwise = c
|
||||
|
||||
getBackend :: FilePath -> Key -> Annex (Maybe Backend)
|
||||
getBackend file k = let bname = keyBackendName k in
|
||||
case maybeLookupBackendName bname of
|
||||
getBackend file k = case maybeLookupBackendVariety (keyVariety k) of
|
||||
Just backend -> return $ Just backend
|
||||
Nothing -> do
|
||||
warning $ "skipping " ++ file ++ " (unknown backend " ++ bname ++ ")"
|
||||
warning $ "skipping " ++ file ++ " (unknown backend " ++ formatKeyVariety (keyVariety k) ++ ")"
|
||||
return Nothing
|
||||
|
||||
{- Looks up the backend that should be used for a file.
|
||||
|
|
@ -85,21 +86,22 @@ getBackend file k = let bname = keyBackendName k in
|
|||
chooseBackend :: FilePath -> Annex (Maybe Backend)
|
||||
chooseBackend f = Annex.getState Annex.forcebackend >>= go
|
||||
where
|
||||
go Nothing = maybeLookupBackendName <$> checkAttr "annex.backend" f
|
||||
go Nothing = maybeLookupBackendVariety . parseKeyVariety
|
||||
<$> checkAttr "annex.backend" f
|
||||
go (Just _) = Just . Prelude.head <$> orderedList
|
||||
|
||||
{- Looks up a backend by name. May fail if unknown. -}
|
||||
lookupBackendName :: String -> Backend
|
||||
lookupBackendName s = fromMaybe unknown $ maybeLookupBackendName s
|
||||
{- Looks up a backend by variety. May fail if unsupported or disabled. -}
|
||||
lookupBackendVariety :: KeyVariety -> Backend
|
||||
lookupBackendVariety v = fromMaybe unknown $ maybeLookupBackendVariety v
|
||||
where
|
||||
unknown = error $ "unknown backend " ++ s
|
||||
unknown = error $ "unknown backend " ++ formatKeyVariety v
|
||||
|
||||
maybeLookupBackendName :: String -> Maybe Backend
|
||||
maybeLookupBackendName s = M.lookup s nameMap
|
||||
maybeLookupBackendVariety :: KeyVariety -> Maybe Backend
|
||||
maybeLookupBackendVariety v = M.lookup v varietyMap
|
||||
|
||||
nameMap :: M.Map String Backend
|
||||
nameMap = M.fromList $ zip (map B.name list) list
|
||||
varietyMap :: M.Map KeyVariety Backend
|
||||
varietyMap = M.fromList $ zip (map B.backendVariety list) list
|
||||
|
||||
isStableKey :: Key -> Bool
|
||||
isStableKey k = maybe False (`B.isStableKey` k)
|
||||
(maybeLookupBackendName (keyBackendName k))
|
||||
(maybeLookupBackendVariety (keyVariety k))
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
{- git-annex hashing backends
|
||||
-
|
||||
- Copyright 2011-2015 Joey Hess <id@joeyh.name>
|
||||
- Copyright 2011-2017 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
|
@ -14,6 +14,7 @@ module Backend.Hash (
|
|||
|
||||
import Annex.Common
|
||||
import qualified Annex
|
||||
import Types.Key
|
||||
import Types.Backend
|
||||
import Types.KeySource
|
||||
import Utility.Hash
|
||||
|
|
@ -29,17 +30,16 @@ data Hash
|
|||
| SHA2Hash HashSize
|
||||
| SHA3Hash HashSize
|
||||
| SkeinHash HashSize
|
||||
type HashSize = Int
|
||||
|
||||
{- Order is slightly significant; want SHA256 first, and more general
|
||||
- sizes earlier. -}
|
||||
hashes :: [Hash]
|
||||
hashes = concat
|
||||
[ map SHA2Hash [256, 512, 224, 384]
|
||||
[ map (SHA2Hash . HashSize) [256, 512, 224, 384]
|
||||
#ifdef WITH_CRYPTONITE
|
||||
, map SHA3Hash [256, 512, 224, 384]
|
||||
, map (SHA3Hash . HashSize) [256, 512, 224, 384]
|
||||
#endif
|
||||
, map SkeinHash [256, 512]
|
||||
, map (SkeinHash . HashSize) [256, 512]
|
||||
, [SHA1Hash]
|
||||
, [MD5Hash]
|
||||
]
|
||||
|
|
@ -50,7 +50,7 @@ backends = concatMap (\h -> [genBackendE h, genBackend h]) hashes
|
|||
|
||||
genBackend :: Hash -> Backend
|
||||
genBackend hash = Backend
|
||||
{ name = hashName hash
|
||||
{ backendVariety = hashKeyVariety hash (HasExt False)
|
||||
, getKey = keyValue hash
|
||||
, verifyKeyContent = Just $ checkKeyChecksum hash
|
||||
, canUpgradeKey = Just needsUpgrade
|
||||
|
|
@ -60,19 +60,16 @@ genBackend hash = Backend
|
|||
|
||||
genBackendE :: Hash -> Backend
|
||||
genBackendE hash = (genBackend hash)
|
||||
{ name = hashNameE hash
|
||||
{ backendVariety = hashKeyVariety hash (HasExt True)
|
||||
, getKey = keyValueE hash
|
||||
}
|
||||
|
||||
hashName :: Hash -> String
|
||||
hashName MD5Hash = "MD5"
|
||||
hashName SHA1Hash = "SHA1"
|
||||
hashName (SHA2Hash size) = "SHA" ++ show size
|
||||
hashName (SHA3Hash size) = "SHA3_" ++ show size
|
||||
hashName (SkeinHash size) = "SKEIN" ++ show size
|
||||
|
||||
hashNameE :: Hash -> String
|
||||
hashNameE hash = hashName hash ++ "E"
|
||||
hashKeyVariety :: Hash -> HasExt -> KeyVariety
|
||||
hashKeyVariety MD5Hash = MD5Key
|
||||
hashKeyVariety SHA1Hash = SHA1Key
|
||||
hashKeyVariety (SHA2Hash size) = SHA2Key size
|
||||
hashKeyVariety (SHA3Hash size) = SHA3Key size
|
||||
hashKeyVariety (SkeinHash size) = SKEINKey size
|
||||
|
||||
{- A key is a hash of its contents. -}
|
||||
keyValue :: Hash -> KeySource -> Annex (Maybe Key)
|
||||
|
|
@ -82,7 +79,7 @@ keyValue hash source = do
|
|||
s <- hashFile hash file filesize
|
||||
return $ Just $ stubKey
|
||||
{ keyName = s
|
||||
, keyBackendName = hashName hash
|
||||
, keyVariety = hashKeyVariety hash (HasExt False)
|
||||
, keySize = Just filesize
|
||||
}
|
||||
|
||||
|
|
@ -92,7 +89,7 @@ keyValueE hash source = keyValue hash source >>= maybe (return Nothing) addE
|
|||
where
|
||||
addE k = return $ Just $ k
|
||||
{ keyName = keyName k ++ selectExtension (keyFilename source)
|
||||
, keyBackendName = hashNameE hash
|
||||
, keyVariety = hashKeyVariety hash (HasExt True)
|
||||
}
|
||||
|
||||
selectExtension :: FilePath -> String
|
||||
|
|
@ -149,24 +146,29 @@ needsUpgrade key = "\\" `isPrefixOf` keyHash key ||
|
|||
trivialMigrate :: Key -> Backend -> AssociatedFile -> Maybe Key
|
||||
trivialMigrate oldkey newbackend afile
|
||||
{- Fast migration from hashE to hash backend. -}
|
||||
| keyBackendName oldkey == name newbackend ++ "E" = Just $ oldkey
|
||||
| migratable && hasExt newvariety = Just $ oldkey
|
||||
{ keyName = keyHash oldkey
|
||||
, keyBackendName = name newbackend
|
||||
, keyVariety = newvariety
|
||||
}
|
||||
{- Fast migration from hash to hashE backend. -}
|
||||
| keyBackendName oldkey ++"E" == name newbackend = case afile of
|
||||
| migratable && hasExt oldvariety = case afile of
|
||||
Nothing -> Nothing
|
||||
Just file -> Just $ oldkey
|
||||
{ keyName = keyHash oldkey ++ selectExtension file
|
||||
, keyBackendName = name newbackend
|
||||
, keyVariety = newvariety
|
||||
}
|
||||
| otherwise = Nothing
|
||||
where
|
||||
migratable = oldvariety /= newvariety
|
||||
&& sameExceptExt oldvariety newvariety
|
||||
oldvariety = keyVariety oldkey
|
||||
newvariety = backendVariety newbackend
|
||||
|
||||
hashFile :: Hash -> FilePath -> Integer -> Annex String
|
||||
hashFile hash file filesize = go hash
|
||||
where
|
||||
go MD5Hash = use md5Hasher
|
||||
go SHA1Hash = usehasher 1
|
||||
go SHA1Hash = usehasher (HashSize 1)
|
||||
go (SHA2Hash hashsize) = usehasher hashsize
|
||||
go (SHA3Hash hashsize) = use (sha3Hasher hashsize)
|
||||
go (SkeinHash hashsize) = use (skeinHasher hashsize)
|
||||
|
|
@ -176,10 +178,10 @@ hashFile hash file filesize = go hash
|
|||
-- Force full evaluation so file is read and closed.
|
||||
return (length h `seq` h)
|
||||
|
||||
usehasher hashsize = case shaHasher hashsize filesize of
|
||||
usehasher hashsize@(HashSize sz) = case shaHasher hashsize filesize of
|
||||
Left sha -> use sha
|
||||
Right (external, internal) -> do
|
||||
v <- liftIO $ externalSHA external hashsize file
|
||||
v <- liftIO $ externalSHA external sz file
|
||||
case v of
|
||||
Right r -> return r
|
||||
Left e -> do
|
||||
|
|
@ -189,7 +191,7 @@ hashFile hash file filesize = go hash
|
|||
use internal
|
||||
|
||||
shaHasher :: HashSize -> Integer -> Either (L.ByteString -> String) (String, L.ByteString -> String)
|
||||
shaHasher hashsize filesize
|
||||
shaHasher (HashSize hashsize) filesize
|
||||
| hashsize == 1 = use SysConfig.sha1 sha1
|
||||
| hashsize == 256 = use SysConfig.sha256 sha2_256
|
||||
| hashsize == 224 = use SysConfig.sha224 sha2_224
|
||||
|
|
@ -209,7 +211,7 @@ shaHasher hashsize filesize
|
|||
usehasher hasher = show . hasher
|
||||
|
||||
sha3Hasher :: HashSize -> (L.ByteString -> String)
|
||||
sha3Hasher hashsize
|
||||
sha3Hasher (HashSize hashsize)
|
||||
#ifdef WITH_CRYPTONITE
|
||||
| hashsize == 256 = show . sha3_256
|
||||
| hashsize == 224 = show . sha3_224
|
||||
|
|
@ -219,7 +221,7 @@ sha3Hasher hashsize
|
|||
| otherwise = error $ "unsupported SHA3 size " ++ show hashsize
|
||||
|
||||
skeinHasher :: HashSize -> (L.ByteString -> String)
|
||||
skeinHasher hashsize
|
||||
skeinHasher (HashSize hashsize)
|
||||
| hashsize == 256 = show . skein256
|
||||
| hashsize == 512 = show . skein512
|
||||
| otherwise = error $ "unsupported SKEIN size " ++ show hashsize
|
||||
|
|
@ -236,7 +238,7 @@ md5Hasher = show . md5
|
|||
-}
|
||||
testKeyBackend :: Backend
|
||||
testKeyBackend =
|
||||
let b = genBackendE (SHA2Hash 256)
|
||||
let b = genBackendE (SHA2Hash (HashSize 256))
|
||||
in b { getKey = (fmap addE) <$$> getKey b }
|
||||
where
|
||||
addE k = k { keyName = keyName k ++ longext }
|
||||
|
|
|
|||
|
|
@ -11,6 +11,7 @@ module Backend.URL (
|
|||
) where
|
||||
|
||||
import Annex.Common
|
||||
import Types.Key
|
||||
import Types.Backend
|
||||
import Backend.Utilities
|
||||
|
||||
|
|
@ -19,7 +20,7 @@ backends = [backend]
|
|||
|
||||
backend :: Backend
|
||||
backend = Backend
|
||||
{ name = "URL"
|
||||
{ backendVariety = URLKey
|
||||
, getKey = const $ return Nothing
|
||||
, verifyKeyContent = Nothing
|
||||
, canUpgradeKey = Nothing
|
||||
|
|
@ -33,6 +34,6 @@ backend = Backend
|
|||
fromUrl :: String -> Maybe Integer -> Key
|
||||
fromUrl url size = stubKey
|
||||
{ keyName = genKeyName url
|
||||
, keyBackendName = "URL"
|
||||
, keyVariety = URLKey
|
||||
, keySize = size
|
||||
}
|
||||
|
|
|
|||
|
|
@ -8,6 +8,7 @@
|
|||
module Backend.WORM (backends) where
|
||||
|
||||
import Annex.Common
|
||||
import Types.Key
|
||||
import Types.Backend
|
||||
import Types.KeySource
|
||||
import Backend.Utilities
|
||||
|
|
@ -18,7 +19,7 @@ backends = [backend]
|
|||
|
||||
backend :: Backend
|
||||
backend = Backend
|
||||
{ name = "WORM"
|
||||
{ backendVariety = WORMKey
|
||||
, getKey = keyValue
|
||||
, verifyKeyContent = Nothing
|
||||
, canUpgradeKey = Nothing
|
||||
|
|
@ -37,7 +38,7 @@ keyValue source = do
|
|||
relf <- getTopFilePath <$> inRepo (toTopFilePath $ keyFilename source)
|
||||
return $ Just $ stubKey
|
||||
{ keyName = genKeyName relf
|
||||
, keyBackendName = name backend
|
||||
, keyVariety = WORMKey
|
||||
, keySize = Just sz
|
||||
, keyMtime = Just $ modificationTime stat
|
||||
}
|
||||
|
|
|
|||
|
|
@ -15,6 +15,7 @@ import Annex.Common
|
|||
import qualified Git.Config
|
||||
import qualified Git.Construct
|
||||
import Git.Types
|
||||
import Types.Key
|
||||
import Types.TrustLevel
|
||||
import Types.NumCopies
|
||||
import Types.Messages
|
||||
|
|
@ -346,4 +347,5 @@ completeRemotes = completer $ mkCompleter $ \input -> do
|
|||
|
||||
|
||||
completeBackends :: HasCompleter f => Mod f a
|
||||
completeBackends = completeWith (map Backend.name Backend.list)
|
||||
completeBackends = completeWith $
|
||||
map (formatKeyVariety . Backend.backendVariety) Backend.list
|
||||
|
|
|
|||
|
|
@ -13,6 +13,7 @@ import qualified Data.Map as M
|
|||
import Command
|
||||
import Annex.Content
|
||||
import Limit
|
||||
import Types.Key
|
||||
import qualified Utility.Format
|
||||
import Utility.DataUnits
|
||||
|
||||
|
|
@ -76,7 +77,7 @@ showFormatted format unformatted vars =
|
|||
keyVars :: Key -> [(String, String)]
|
||||
keyVars key =
|
||||
[ ("key", key2file key)
|
||||
, ("backend", keyBackendName key)
|
||||
, ("backend", formatKeyVariety $ keyVariety key)
|
||||
, ("bytesize", size show)
|
||||
, ("humansize", size $ roughSize storageUnits True)
|
||||
, ("keyname", keyName key)
|
||||
|
|
|
|||
|
|
@ -175,7 +175,7 @@ performRemote key afile backend numcopies remote =
|
|||
|
||||
startKey :: Maybe Remote -> Incremental -> Key -> ActionItem -> NumCopies -> CommandStart
|
||||
startKey from inc key ai numcopies =
|
||||
case Backend.maybeLookupBackendName (keyBackendName key) of
|
||||
case Backend.maybeLookupBackendVariety (keyVariety key) of
|
||||
Nothing -> stop
|
||||
Just backend -> runFsck inc ai key $
|
||||
case from of
|
||||
|
|
|
|||
|
|
@ -36,6 +36,7 @@ import qualified Git.LsTree as LsTree
|
|||
import Utility.Percentage
|
||||
import Types.Transfer
|
||||
import Logs.Transfer
|
||||
import Types.Key
|
||||
import Types.TrustLevel
|
||||
import Types.FileMatcher
|
||||
import qualified Limit
|
||||
|
|
@ -51,7 +52,7 @@ data KeyData = KeyData
|
|||
{ countKeys :: Integer
|
||||
, sizeKeys :: Integer
|
||||
, unknownSizeKeys :: Integer
|
||||
, backendsKeys :: M.Map String Integer
|
||||
, backendsKeys :: M.Map KeyVariety Integer
|
||||
}
|
||||
|
||||
data NumCopiesStats = NumCopiesStats
|
||||
|
|
@ -451,7 +452,8 @@ disk_size = simpleStat "available local disk space" $
|
|||
|
||||
backend_usage :: Stat
|
||||
backend_usage = stat "backend usage" $ json fmt $
|
||||
ObjectMap . backendsKeys <$> cachedReferencedData
|
||||
ObjectMap . (M.mapKeys formatKeyVariety) . backendsKeys
|
||||
<$> cachedReferencedData
|
||||
where
|
||||
fmt = multiLine . map (\(b, n) -> b ++ ": " ++ show n) . sort . M.toList . fromObjectMap
|
||||
|
||||
|
|
@ -598,7 +600,7 @@ addKey key (KeyData count size unknownsize backends) =
|
|||
{- All calculations strict to avoid thunks when repeatedly
|
||||
- applied to many keys. -}
|
||||
!count' = count + 1
|
||||
!backends' = M.insertWith (+) (keyBackendName key) 1 backends
|
||||
!backends' = M.insertWith (+) (keyVariety key) 1 backends
|
||||
!size' = maybe size (+ size) ks
|
||||
!unknownsize' = maybe (unknownsize + 1) (const unknownsize) ks
|
||||
ks = keySize key
|
||||
|
|
|
|||
|
|
@ -84,7 +84,7 @@ clean file = do
|
|||
-- for this file before, so that when
|
||||
-- git re-cleans a file its backend does
|
||||
-- not change.
|
||||
currbackend <- maybe Nothing (maybeLookupBackendName . keyBackendName)
|
||||
currbackend <- maybe Nothing (maybeLookupBackendVariety . keyVariety)
|
||||
<$> catKeyFile file
|
||||
liftIO . emitPointer
|
||||
=<< go
|
||||
|
|
|
|||
|
|
@ -149,7 +149,7 @@ test st r k =
|
|||
Annex.eval st (Annex.setOutput QuietOutput >> a) @? "failed"
|
||||
present b = check ("present " ++ show b) $
|
||||
(== Right b) <$> Remote.hasKey r k
|
||||
fsck = case maybeLookupBackendName (keyBackendName k) of
|
||||
fsck = case maybeLookupBackendVariety (keyVariety k) of
|
||||
Nothing -> return True
|
||||
Just b -> case Backend.verifyKeyContent b of
|
||||
Nothing -> return True
|
||||
|
|
|
|||
|
|
@ -11,6 +11,7 @@ import Command
|
|||
import qualified Build.SysConfig as SysConfig
|
||||
import Annex.Version
|
||||
import BuildFlags
|
||||
import Types.Key
|
||||
import qualified Types.Backend as B
|
||||
import qualified Types.Remote as R
|
||||
import qualified Remote
|
||||
|
|
@ -62,7 +63,8 @@ showPackageVersion :: IO ()
|
|||
showPackageVersion = do
|
||||
vinfo "git-annex version" SysConfig.packageversion
|
||||
vinfo "build flags" $ unwords buildFlags
|
||||
vinfo "key/value backends" $ unwords $ map B.name Backend.list
|
||||
vinfo "key/value backends" $ unwords $
|
||||
map (formatKeyVariety . B.backendVariety) Backend.list
|
||||
vinfo "remote types" $ unwords $ map R.typename Remote.remoteTypes
|
||||
|
||||
showRawVersion :: IO ()
|
||||
|
|
|
|||
|
|
@ -42,6 +42,7 @@ import Annex.Common
|
|||
import qualified Utility.Gpg as Gpg
|
||||
import Types.Crypto
|
||||
import Types.Remote
|
||||
import Types.Key
|
||||
|
||||
{- The beginning of a Cipher is used for MAC'ing; the remainder is used
|
||||
- as the GPG symmetric encryption passphrase when using the hybrid
|
||||
|
|
@ -159,14 +160,16 @@ type EncKey = Key -> Key
|
|||
encryptKey :: Mac -> Cipher -> EncKey
|
||||
encryptKey mac c k = stubKey
|
||||
{ keyName = macWithCipher mac c (key2file k)
|
||||
, keyBackendName = encryptedBackendNamePrefix ++ showMac mac
|
||||
, keyVariety = OtherKey (encryptedBackendNamePrefix ++ showMac mac)
|
||||
}
|
||||
|
||||
encryptedBackendNamePrefix :: String
|
||||
encryptedBackendNamePrefix = "GPG"
|
||||
|
||||
isEncKey :: Key -> Bool
|
||||
isEncKey k = encryptedBackendNamePrefix `isPrefixOf` keyBackendName k
|
||||
isEncKey k = case keyVariety k of
|
||||
OtherKey s -> encryptedBackendNamePrefix `isPrefixOf` s
|
||||
_ -> False
|
||||
|
||||
type Feeder = Handle -> IO ()
|
||||
type Reader m a = Handle -> m a
|
||||
|
|
|
|||
30
Key.hs
30
Key.hs
|
|
@ -35,7 +35,7 @@ import qualified Utility.SimpleProtocol as Proto
|
|||
stubKey :: Key
|
||||
stubKey = Key
|
||||
{ keyName = ""
|
||||
, keyBackendName = ""
|
||||
, keyVariety = OtherKey ""
|
||||
, keySize = Nothing
|
||||
, keyMtime = Nothing
|
||||
, keyChunkSize = Nothing
|
||||
|
|
@ -69,8 +69,8 @@ fieldSep = '-'
|
|||
- The name field is always shown last, separated by doubled fieldSeps,
|
||||
- and is the only field allowed to contain the fieldSep. -}
|
||||
key2file :: Key -> FilePath
|
||||
key2file Key { keyBackendName = b, keySize = s, keyMtime = m, keyChunkSize = cs, keyChunkNum = cn, keyName = n } =
|
||||
b +++ ('s' ?: s) +++ ('m' ?: m) +++ ('S' ?: cs) +++ ('C' ?: cn) +++ (fieldSep : n)
|
||||
key2file Key { keyVariety = kv, keySize = s, keyMtime = m, keyChunkSize = cs, keyChunkNum = cn, keyName = n } =
|
||||
formatKeyVariety kv +++ ('s' ?: s) +++ ('m' ?: m) +++ ('S' ?: cs) +++ ('C' ?: cn) +++ (fieldSep : n)
|
||||
where
|
||||
"" +++ y = y
|
||||
x +++ "" = x
|
||||
|
|
@ -80,12 +80,12 @@ key2file Key { keyBackendName = b, keySize = s, keyMtime = m, keyChunkSize = cs,
|
|||
|
||||
file2key :: FilePath -> Maybe Key
|
||||
file2key s
|
||||
| key == Just stubKey || (keyName <$> key) == Just "" || (keyBackendName <$> key) == Just "" = Nothing
|
||||
| key == Just stubKey || (keyName <$> key) == Just "" || (keyVariety <$> key) == Just (OtherKey "") = Nothing
|
||||
| otherwise = key
|
||||
where
|
||||
key = startbackend stubKey s
|
||||
|
||||
startbackend k v = sepfield k v addbackend
|
||||
startbackend k v = sepfield k v addvariety
|
||||
|
||||
sepfield k v a = case span (/= fieldSep) v of
|
||||
(v', _:r) -> findfields r $ a k v'
|
||||
|
|
@ -96,7 +96,7 @@ file2key s
|
|||
| otherwise = sepfield k v $ addfield c
|
||||
findfields _ v = v
|
||||
|
||||
addbackend k v = Just k { keyBackendName = v }
|
||||
addvariety k v = Just k { keyVariety = parseKeyVariety v }
|
||||
|
||||
-- This is a strict parser for security reasons; a key
|
||||
-- can contain only 4 fields, which all consist only of numbers.
|
||||
|
|
@ -126,31 +126,27 @@ file2key s
|
|||
| validKeyName k v = Just $ k { keyName = v }
|
||||
| otherwise = Nothing
|
||||
|
||||
{- A key with a backend ending in "E" is an extension preserving key,
|
||||
- using some hash.
|
||||
{- When a key HasExt, the length of the extension is limited in order to
|
||||
- mitigate against SHA1 collision attacks (specifically, chosen-prefix
|
||||
- attacks).
|
||||
-
|
||||
- The length of the extension is limited in order to mitigate against
|
||||
- SHA1 collision attacks (specifically, chosen-prefix attacks).
|
||||
- In such an attack, the extension of the key could be made to contain
|
||||
- the collision generation data, with the result that a signed git commit
|
||||
- including such keys would not be secure.
|
||||
-
|
||||
- The maximum extension length ever generated for such a key was 8
|
||||
- characters; 20 is used here to give a little future wiggle-room.
|
||||
- The SHA1 common-prefix attack used 128 bytes of data.
|
||||
-
|
||||
- This code is here, and not in Backend.Hash (where it really belongs)
|
||||
- so that file2key can check it whenever a Key is constructed.
|
||||
- The SHA1 common-prefix attack needs 128 bytes of data.
|
||||
-}
|
||||
validKeyName :: Key -> String -> Bool
|
||||
validKeyName k v
|
||||
| end (keyBackendName k) == "E" = length (takeExtensions v) <= 20
|
||||
validKeyName k name
|
||||
| hasExt (keyVariety k) = length (takeExtensions name) <= 20
|
||||
| otherwise = True
|
||||
|
||||
instance Arbitrary Key where
|
||||
arbitrary = Key
|
||||
<$> (listOf1 $ elements $ ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "-_\r\n \t")
|
||||
<*> (listOf1 $ elements ['A'..'Z']) -- BACKEND
|
||||
<*> (parseKeyVariety <$> (listOf1 $ elements ['A'..'Z'])) -- BACKEND
|
||||
<*> ((abs <$>) <$> arbitrary) -- size cannot be negative
|
||||
<*> arbitrary
|
||||
<*> ((abs <$>) <$> arbitrary) -- chunksize cannot be negative
|
||||
|
|
|
|||
4
Limit.hs
4
Limit.hs
|
|
@ -19,6 +19,7 @@ import Annex.Action
|
|||
import Annex.UUID
|
||||
import Logs.Trust
|
||||
import Annex.NumCopies
|
||||
import Types.Key
|
||||
import Types.TrustLevel
|
||||
import Types.Group
|
||||
import Types.FileMatcher
|
||||
|
|
@ -251,7 +252,8 @@ addInBackend = addLimit . limitInBackend
|
|||
limitInBackend :: MkLimit Annex
|
||||
limitInBackend name = Right $ const $ checkKey check
|
||||
where
|
||||
check key = pure $ keyBackendName key == name
|
||||
check key = pure $ keyVariety key == variety
|
||||
variety = parseKeyVariety name
|
||||
|
||||
{- Adds a limit to skip files that are too large or too small -}
|
||||
addLargerThan :: String -> Annex ()
|
||||
|
|
|
|||
3
Test.hs
3
Test.hs
|
|
@ -64,6 +64,7 @@ import qualified Logs.PreferredContent
|
|||
import qualified Types.MetaData
|
||||
import qualified Remote
|
||||
import qualified Key
|
||||
import qualified Types.Key
|
||||
import qualified Types.Messages
|
||||
import qualified Config
|
||||
import qualified Config.Cost
|
||||
|
|
@ -2152,7 +2153,7 @@ backendWORM :: Types.Backend
|
|||
backendWORM = backend_ "WORM"
|
||||
|
||||
backend_ :: String -> Types.Backend
|
||||
backend_ = Backend.lookupBackendName
|
||||
backend_ = Backend.lookupBackendVariety . Types.Key.parseKeyVariety
|
||||
|
||||
getKey :: Types.Backend -> FilePath -> IO Types.Key
|
||||
getKey b f = fromJust <$> annexeval go
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
-
|
||||
- Most things should not need this, using Types instead
|
||||
-
|
||||
- Copyright 2010,2012 Joey Hess <id@joeyh.name>
|
||||
- Copyright 2010-2017 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
|
@ -13,7 +13,7 @@ import Types.Key
|
|||
import Types.KeySource
|
||||
|
||||
data BackendA a = Backend
|
||||
{ name :: String
|
||||
{ backendVariety :: KeyVariety
|
||||
, getKey :: KeySource -> a (Maybe Key)
|
||||
-- Verifies the content of a key.
|
||||
, verifyKeyContent :: Maybe (Key -> FilePath -> a Bool)
|
||||
|
|
@ -28,7 +28,7 @@ data BackendA a = Backend
|
|||
}
|
||||
|
||||
instance Show (BackendA a) where
|
||||
show backend = "Backend { name =\"" ++ name backend ++ "\" }"
|
||||
show backend = "Backend { name =\"" ++ formatKeyVariety (backendVariety backend) ++ "\" }"
|
||||
|
||||
instance Eq (BackendA a) where
|
||||
a == b = name a == name b
|
||||
a == b = backendVariety a == backendVariety b
|
||||
|
|
|
|||
86
Types/Key.hs
86
Types/Key.hs
|
|
@ -7,13 +7,15 @@
|
|||
|
||||
module Types.Key where
|
||||
|
||||
import Utility.PartialPrelude
|
||||
|
||||
import System.Posix.Types
|
||||
|
||||
{- A Key has a unique name, which is derived from a particular backend,
|
||||
- and may contain other optional metadata. -}
|
||||
data Key = Key
|
||||
{ keyName :: String
|
||||
, keyBackendName :: String
|
||||
, keyVariety :: KeyVariety
|
||||
, keySize :: Maybe Integer
|
||||
, keyMtime :: Maybe EpochTime
|
||||
, keyChunkSize :: Maybe Integer
|
||||
|
|
@ -22,3 +24,85 @@ data Key = Key
|
|||
|
||||
{- A filename may be associated with a Key. -}
|
||||
type AssociatedFile = Maybe FilePath
|
||||
|
||||
{- There are several different varieties of keys. -}
|
||||
data KeyVariety
|
||||
= SHA2Key HashSize HasExt
|
||||
| SHA3Key HashSize HasExt
|
||||
| SKEINKey HashSize HasExt
|
||||
| SHA1Key HasExt
|
||||
| MD5Key HasExt
|
||||
| WORMKey
|
||||
| URLKey
|
||||
-- Some repositories may contain keys of other varieties,
|
||||
-- which can still be processed to some extent.
|
||||
| OtherKey String
|
||||
deriving (Eq, Ord, Read, Show)
|
||||
|
||||
{- Some varieties of keys may contain an extension at the end of the
|
||||
- keyName -}
|
||||
newtype HasExt = HasExt Bool
|
||||
deriving (Eq, Ord, Read, Show)
|
||||
|
||||
newtype HashSize = HashSize Int
|
||||
deriving (Eq, Ord, Read, Show)
|
||||
|
||||
hasExt :: KeyVariety -> Bool
|
||||
hasExt (SHA2Key _ (HasExt b)) = b
|
||||
hasExt (SHA3Key _ (HasExt b)) = b
|
||||
hasExt (SKEINKey _ (HasExt b)) = b
|
||||
hasExt (SHA1Key (HasExt b)) = b
|
||||
hasExt (MD5Key (HasExt b)) = b
|
||||
hasExt WORMKey = False
|
||||
hasExt URLKey = False
|
||||
hasExt (OtherKey s) = end s == "E"
|
||||
|
||||
sameExceptExt :: KeyVariety -> KeyVariety -> Bool
|
||||
sameExceptExt (SHA2Key sz1 _) (SHA2Key sz2 _) = sz1 == sz2
|
||||
sameExceptExt (SHA3Key sz1 _) (SHA3Key sz2 _) = sz1 == sz2
|
||||
sameExceptExt (SKEINKey sz1 _) (SKEINKey sz2 _) = sz1 == sz2
|
||||
sameExceptExt (SHA1Key _) (SHA1Key _) = True
|
||||
sameExceptExt (MD5Key _) (MD5Key _) = True
|
||||
sameExceptExt _ _ = False
|
||||
|
||||
formatKeyVariety :: KeyVariety -> String
|
||||
formatKeyVariety v = case v of
|
||||
SHA2Key sz e -> adde e (addsz sz "SHA")
|
||||
SHA3Key sz e -> adde e (addsz sz "SHA3_")
|
||||
SKEINKey sz e -> adde e (addsz sz "SKEIN")
|
||||
SHA1Key e -> adde e "SHA1"
|
||||
MD5Key e -> adde e "MD5"
|
||||
WORMKey -> "WORM"
|
||||
URLKey -> "URL"
|
||||
OtherKey s -> s
|
||||
where
|
||||
adde (HasExt False) s = s
|
||||
adde (HasExt True) s = s ++ "E"
|
||||
addsz (HashSize n) s = s ++ show n
|
||||
|
||||
parseKeyVariety :: String -> KeyVariety
|
||||
parseKeyVariety "SHA256" = SHA2Key (HashSize 256) (HasExt False)
|
||||
parseKeyVariety "SHA256E" = SHA2Key (HashSize 256) (HasExt True)
|
||||
parseKeyVariety "SHA512" = SHA2Key (HashSize 512) (HasExt False)
|
||||
parseKeyVariety "SHA512E" = SHA2Key (HashSize 512) (HasExt True)
|
||||
parseKeyVariety "SHA224" = SHA2Key (HashSize 224) (HasExt False)
|
||||
parseKeyVariety "SHA224E" = SHA2Key (HashSize 224) (HasExt True)
|
||||
parseKeyVariety "SHA384" = SHA2Key (HashSize 384) (HasExt False)
|
||||
parseKeyVariety "SHA384E" = SHA2Key (HashSize 384) (HasExt True)
|
||||
parseKeyVariety "SHA3_512" = SHA3Key (HashSize 512) (HasExt False)
|
||||
parseKeyVariety "SHA3_512E" = SHA3Key (HashSize 512) (HasExt True)
|
||||
parseKeyVariety "SHA3_384" = SHA3Key (HashSize 384) (HasExt False)
|
||||
parseKeyVariety "SHA3_384E" = SHA3Key (HashSize 384) (HasExt True)
|
||||
parseKeyVariety "SHA3_256" = SHA3Key (HashSize 256) (HasExt False)
|
||||
parseKeyVariety "SHA3_256E" = SHA3Key (HashSize 256) (HasExt True)
|
||||
parseKeyVariety "SHA3_224" = SHA3Key (HashSize 224) (HasExt False)
|
||||
parseKeyVariety "SHA3_224E" = SHA3Key (HashSize 224) (HasExt True)
|
||||
parseKeyVariety "SKEIN512" = SKEINKey (HashSize 512) (HasExt False)
|
||||
parseKeyVariety "SKEIN512E" = SKEINKey (HashSize 512) (HasExt True)
|
||||
parseKeyVariety "SKEIN256" = SKEINKey (HashSize 256) (HasExt False)
|
||||
parseKeyVariety "SKEIN256E" = SKEINKey (HashSize 256) (HasExt True)
|
||||
parseKeyVariety "SHA1" = SHA1Key (HasExt False)
|
||||
parseKeyVariety "MD5" = MD5Key (HasExt False)
|
||||
parseKeyVariety "WORM" = WORMKey
|
||||
parseKeyVariety "URL" = URLKey
|
||||
parseKeyVariety s = OtherKey s
|
||||
|
|
|
|||
|
|
@ -14,6 +14,7 @@ import Data.Default
|
|||
import Annex.Common
|
||||
import Annex.Content
|
||||
import Annex.Link
|
||||
import Types.Key
|
||||
import Logs.Presence
|
||||
import qualified Annex.Queue
|
||||
import qualified Git
|
||||
|
|
@ -130,7 +131,7 @@ oldlog2key l
|
|||
where
|
||||
len = length l - 4
|
||||
k = readKey1 (take len l)
|
||||
sane = (not . null $ keyName k) && (not . null $ keyBackendName k)
|
||||
sane = (not . null $ keyName k) && (not . null $ formatKeyVariety $ keyVariety k)
|
||||
|
||||
-- WORM backend keys: "WORM:mtime:size:filename"
|
||||
-- all the rest: "backend:key"
|
||||
|
|
@ -143,7 +144,7 @@ readKey1 v
|
|||
| mixup = fromJust $ file2key $ intercalate ":" $ Prelude.tail bits
|
||||
| otherwise = stubKey
|
||||
{ keyName = n
|
||||
, keyBackendName = b
|
||||
, keyVariety = parseKeyVariety b
|
||||
, keySize = s
|
||||
, keyMtime = t
|
||||
}
|
||||
|
|
@ -161,11 +162,12 @@ readKey1 v
|
|||
mixup = wormy && isUpper (Prelude.head $ bits !! 1)
|
||||
|
||||
showKey1 :: Key -> String
|
||||
showKey1 Key { keyName = n , keyBackendName = b, keySize = s, keyMtime = t } =
|
||||
showKey1 Key { keyName = n , keyVariety = v, keySize = s, keyMtime = t } =
|
||||
intercalate ":" $ filter (not . null) [b, showifhere t, showifhere s, n]
|
||||
where
|
||||
showifhere Nothing = ""
|
||||
showifhere (Just v) = show v
|
||||
showifhere (Just x) = show x
|
||||
b = formatKeyVariety v
|
||||
|
||||
keyFile1 :: Key -> FilePath
|
||||
keyFile1 key = replace "/" "%" $ replace "%" "&s" $ replace "&" "&a" $ showKey1 key
|
||||
|
|
@ -189,7 +191,7 @@ lookupFile1 file = do
|
|||
Right l -> makekey l
|
||||
where
|
||||
getsymlink = takeFileName <$> readSymbolicLink file
|
||||
makekey l = case maybeLookupBackendName bname of
|
||||
makekey l = case maybeLookupBackendVariety (keyVariety k) of
|
||||
Nothing -> do
|
||||
unless (null kname || null bname ||
|
||||
not (isLinkToAnnex l)) $
|
||||
|
|
@ -198,7 +200,7 @@ lookupFile1 file = do
|
|||
Just backend -> return $ Just (k, backend)
|
||||
where
|
||||
k = fileKey1 l
|
||||
bname = keyBackendName k
|
||||
bname = formatKeyVariety (keyVariety k)
|
||||
kname = keyName k
|
||||
skip = "skipping " ++ file ++
|
||||
" (unknown backend " ++ bname ++ ")"
|
||||
|
|
|
|||
Loading…
Reference in a new issue