diff options
| -rw-r--r-- | Annex/Content.hs | 2 | ||||
| -rw-r--r-- | Annex/Locations.hs | 3 | ||||
| -rw-r--r-- | Assistant/Threads/SanityChecker.hs | 3 | ||||
| -rw-r--r-- | Assistant/Upgrade.hs | 2 | ||||
| -rw-r--r-- | Backend.hs | 44 | ||||
| -rw-r--r-- | Backend/Hash.hs | 60 | ||||
| -rw-r--r-- | Backend/URL.hs | 5 | ||||
| -rw-r--r-- | Backend/WORM.hs | 5 | ||||
| -rw-r--r-- | CmdLine/GitAnnex/Options.hs | 4 | ||||
| -rw-r--r-- | Command/Find.hs | 3 | ||||
| -rw-r--r-- | Command/Fsck.hs | 2 | ||||
| -rw-r--r-- | Command/Info.hs | 8 | ||||
| -rw-r--r-- | Command/Smudge.hs | 2 | ||||
| -rw-r--r-- | Command/TestRemote.hs | 2 | ||||
| -rw-r--r-- | Command/Version.hs | 4 | ||||
| -rw-r--r-- | Crypto.hs | 7 | ||||
| -rw-r--r-- | Key.hs | 30 | ||||
| -rw-r--r-- | Limit.hs | 4 | ||||
| -rw-r--r-- | Test.hs | 3 | ||||
| -rw-r--r-- | Types/Backend.hs | 8 | ||||
| -rw-r--r-- | Types/Key.hs | 86 | ||||
| -rw-r--r-- | Upgrade/V1.hs | 14 |
22 files changed, 202 insertions, 99 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs index e879e4eeb..8e225548f 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -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 diff --git a/Annex/Locations.hs b/Annex/Locations.hs index 3138b2322..6bc24c4a8 100644 --- a/Annex/Locations.hs +++ b/Annex/Locations.hs @@ -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 diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs index 62ba8f0d0..0c79ef605 100644 --- a/Assistant/Threads/SanityChecker.hs +++ b/Assistant/Threads/SanityChecker.hs @@ -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 diff --git a/Assistant/Upgrade.hs b/Assistant/Upgrade.hs index afbb61924..f91fde06c 100644 --- a/Assistant/Upgrade.hs +++ b/Assistant/Upgrade.hs @@ -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 diff --git a/Backend.hs b/Backend.hs index f7bbed6b5..40b618355 100644 --- a/Backend.hs +++ b/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,33 +75,33 @@ 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 - Just backend -> return $ Just backend - Nothing -> do - warning $ "skipping " ++ file ++ " (unknown backend " ++ bname ++ ")" - return Nothing +getBackend file k = case maybeLookupBackendVariety (keyVariety k) of + Just backend -> return $ Just backend + Nothing -> do + warning $ "skipping " ++ file ++ " (unknown backend " ++ formatKeyVariety (keyVariety k) ++ ")" + return Nothing {- Looks up the backend that should be used for a file. - That can be configured on a per-file basis in the gitattributes file. -} 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)) diff --git a/Backend/Hash.hs b/Backend/Hash.hs index c85047d51..a1640435c 100644 --- a/Backend/Hash.hs +++ b/Backend/Hash.hs @@ -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 } diff --git a/Backend/URL.hs b/Backend/URL.hs index 92b7a4482..b9d8264d6 100644 --- a/Backend/URL.hs +++ b/Backend/URL.hs @@ -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 } diff --git a/Backend/WORM.hs b/Backend/WORM.hs index 99a853f47..d7220a431 100644 --- a/Backend/WORM.hs +++ b/Backend/WORM.hs @@ -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 } diff --git a/CmdLine/GitAnnex/Options.hs b/CmdLine/GitAnnex/Options.hs index f0d00981b..f7e0dcf07 100644 --- a/CmdLine/GitAnnex/Options.hs +++ b/CmdLine/GitAnnex/Options.hs @@ -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 diff --git a/Command/Find.hs b/Command/Find.hs index 553ddc419..d3571c6f8 100644 --- a/Command/Find.hs +++ b/Command/Find.hs @@ -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) diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 96ffd35da..f1b0b78a6 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -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 diff --git a/Command/Info.hs b/Command/Info.hs index 9def38838..835a8498d 100644 --- a/Command/Info.hs +++ b/Command/Info.hs @@ -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 diff --git a/Command/Smudge.hs b/Command/Smudge.hs index cf5272f82..1644ee257 100644 --- a/Command/Smudge.hs +++ b/Command/Smudge.hs @@ -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 diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs index 4c0ff9e3c..78921b856 100644 --- a/Command/TestRemote.hs +++ b/Command/TestRemote.hs @@ -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 diff --git a/Command/Version.hs b/Command/Version.hs index e15f1fb91..ece5fbb05 100644 --- a/Command/Version.hs +++ b/Command/Version.hs @@ -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 @@ -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 @@ -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 () @@ -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 diff --git a/Types/Backend.hs b/Types/Backend.hs index 9a1c44cc8..f1d8919a4 100644 --- a/Types/Backend.hs +++ b/Types/Backend.hs @@ -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 diff --git a/Types/Key.hs b/Types/Key.hs index 0615adfe4..27d56dfd9 100644 --- a/Types/Key.hs +++ b/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 diff --git a/Upgrade/V1.hs b/Upgrade/V1.hs index 725bb4089..d0f9e51d3 100644 --- a/Upgrade/V1.hs +++ b/Upgrade/V1.hs @@ -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 ++ ")" |