convert key2file and file2key to use builder and attoparsec
The new parser is significantly stricter than the old one: The old file2key allowed the fields to come in any order, but the new one requires the fixed order that git-annex has always used. Hopefully this will not cause any breakage. And the old file2key allowed eg SHA1-m1-m2-m3-m4-m5-m6--xxxx while the new does not allow duplication of fields. This could potentially improve security, because allowing lots of extra junk like that in a key could potentially be used in a SHA1 collision attack, although the current attacks need binary data and not this kind of structured numeric data. Speed improved of course, and fairly substantially, in microbenchmarks: benchmarking old/key2file time 2.264 μs (2.257 μs .. 2.273 μs) 1.000 R² (1.000 R² .. 1.000 R²) mean 2.265 μs (2.260 μs .. 2.275 μs) std dev 21.17 ns (13.06 ns .. 39.26 ns) benchmarking new/key2file' time 1.744 μs (1.741 μs .. 1.747 μs) 1.000 R² (1.000 R² .. 1.000 R²) mean 1.745 μs (1.742 μs .. 1.751 μs) std dev 13.55 ns (9.099 ns .. 21.89 ns) benchmarking old/file2key time 6.114 μs (6.102 μs .. 6.129 μs) 1.000 R² (1.000 R² .. 1.000 R²) mean 6.118 μs (6.106 μs .. 6.143 μs) std dev 55.00 ns (30.08 ns .. 100.2 ns) benchmarking new/file2key' time 1.791 μs (1.782 μs .. 1.801 μs) 1.000 R² (0.999 R² .. 1.000 R²) mean 1.792 μs (1.785 μs .. 1.804 μs) std dev 32.46 ns (20.59 ns .. 50.82 ns) variance introduced by outliers: 19% (moderately inflated)
This commit is contained in:
parent
b552551b33
commit
151562b537
2 changed files with 93 additions and 69 deletions
160
Key.hs
160
Key.hs
|
@ -1,6 +1,6 @@
|
|||
{- git-annex Keys
|
||||
-
|
||||
- Copyright 2011-2017 Joey Hess <id@joeyh.name>
|
||||
- Copyright 2011-2019 Joey Hess <id@joeyh.name>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
@ -11,19 +11,31 @@ module Key (
|
|||
Key(..),
|
||||
AssociatedFile(..),
|
||||
stubKey,
|
||||
key2file,
|
||||
buildKeyFile,
|
||||
keyFileParser,
|
||||
file2key,
|
||||
key2file,
|
||||
file2key',
|
||||
key2file',
|
||||
nonChunkKey,
|
||||
chunkKeyOffset,
|
||||
isChunkKey,
|
||||
isKeyPrefix,
|
||||
splitKeyNameExtension,
|
||||
|
||||
prop_isomorphic_key_encode,
|
||||
prop_isomorphic_key_decode
|
||||
) where
|
||||
|
||||
import Data.Char
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.ByteString as S
|
||||
import qualified Data.ByteString.Char8 as S8
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import Data.ByteString.Builder
|
||||
import Data.ByteString.Builder.Extra
|
||||
import qualified Data.Attoparsec.ByteString as A
|
||||
import qualified Data.Attoparsec.ByteString.Char8 as A8
|
||||
import Foreign.C.Types
|
||||
|
||||
import Common
|
||||
import Types.Key
|
||||
|
@ -34,8 +46,8 @@ import qualified Utility.SimpleProtocol as Proto
|
|||
|
||||
stubKey :: Key
|
||||
stubKey = Key
|
||||
{ keyName = ""
|
||||
, keyVariety = OtherKey ""
|
||||
{ keyName = mempty
|
||||
, keyVariety = OtherKey mempty
|
||||
, keySize = Nothing
|
||||
, keyMtime = Nothing
|
||||
, keyChunkSize = Nothing
|
||||
|
@ -65,69 +77,81 @@ isKeyPrefix s = [fieldSep, fieldSep] `isInfixOf` s
|
|||
fieldSep :: Char
|
||||
fieldSep = '-'
|
||||
|
||||
{- Converts a key to a string that is suitable for use as a filename.
|
||||
- The name field is always shown last, separated by doubled fieldSeps,
|
||||
{- Builds a ByteString that is suitable for use as a filename representing
|
||||
- a Key. 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 { keyVariety = kv, keySize = s, keyMtime = m, keyChunkSize = cs, keyChunkNum = cn, keyName = n } =
|
||||
formatKeyVariety kv +++ ('s' ?: s) +++ ('m' ?: m) +++ ('S' ?: cs) +++ ('C' ?: cn) +++ (fieldSep : n)
|
||||
buildKeyFile :: Key -> Builder
|
||||
buildKeyFile k = byteString (formatKeyVariety (keyVariety k))
|
||||
<> 's' ?: (integerDec <$> keySize k)
|
||||
<> 'm' ?: (integerDec . (\(CTime t) -> fromIntegral t) <$> keyMtime k)
|
||||
<> 'S' ?: (integerDec <$> keyChunkSize k)
|
||||
<> 'C' ?: (integerDec <$> keyChunkNum k)
|
||||
<> sepbefore (sepbefore (byteString (keyName k)))
|
||||
where
|
||||
"" +++ y = y
|
||||
x +++ "" = x
|
||||
x +++ y = x ++ fieldSep:y
|
||||
f ?: (Just v) = f : show v
|
||||
_ ?: _ = ""
|
||||
sepbefore s = char7 fieldSep <> s
|
||||
c ?: (Just b) = sepbefore (char7 c <> b)
|
||||
_ ?: Nothing = mempty
|
||||
|
||||
key2file :: Key -> FilePath
|
||||
key2file = decodeBL . key2file'
|
||||
|
||||
key2file' :: Key -> L.ByteString
|
||||
key2file' = toLazyByteStringWith (safeStrategy 128 smallChunkSize) L.empty . buildKeyFile
|
||||
|
||||
{- This is a strict parser for security reasons; a key
|
||||
- can contain only 4 fields, which all consist only of numbers.
|
||||
- Any key containing other fields, or non-numeric data will fail
|
||||
- to parse.
|
||||
-
|
||||
- If a key contained non-numeric fields, they could be used to
|
||||
- embed data used in a SHA1 collision attack, which would be a
|
||||
- problem since the keys are committed to git.
|
||||
-}
|
||||
keyFileParser :: A.Parser Key
|
||||
keyFileParser = do
|
||||
-- key variety cannot be empty
|
||||
v <- (parseKeyVariety <$> A8.takeWhile1 (/= fieldSep))
|
||||
s <- parsesize
|
||||
m <- parsemtime
|
||||
cs <- parsechunksize
|
||||
cn <- parsechunknum
|
||||
_ <- A8.char fieldSep
|
||||
_ <- A8.char fieldSep
|
||||
n <- A.takeByteString
|
||||
if validKeyName v n
|
||||
then return $ Key
|
||||
{ keyName = n
|
||||
, keyVariety = v
|
||||
, keySize = s
|
||||
, keyMtime = m
|
||||
, keyChunkSize = cs
|
||||
, keyChunkNum = cn
|
||||
}
|
||||
else fail "invalid keyName"
|
||||
where
|
||||
parseopt p = (Just <$> (A8.char fieldSep *> p)) <|> pure Nothing
|
||||
parsesize = parseopt $ A8.char 's' *> A8.decimal
|
||||
parsemtime = parseopt $ CTime <$> (A8.char 'm' *> A8.decimal)
|
||||
parsechunksize = parseopt $ A8.char 'S' *> A8.decimal
|
||||
parsechunknum = parseopt $ A8.char 'C' *> A8.decimal
|
||||
|
||||
file2key :: FilePath -> Maybe Key
|
||||
file2key s
|
||||
| key == Just stubKey || (keyName <$> key) == Just "" || (keyVariety <$> key) == Just (OtherKey "") = Nothing
|
||||
| otherwise = key
|
||||
where
|
||||
key = startbackend stubKey s
|
||||
file2key = file2key' . encodeBS
|
||||
|
||||
startbackend k v = sepfield k v addvariety
|
||||
|
||||
sepfield k v a = case span (/= fieldSep) v of
|
||||
(v', _:r) -> findfields r $ a k v'
|
||||
_ -> Nothing
|
||||
file2key' :: S.ByteString -> Maybe Key
|
||||
file2key' b = eitherToMaybe $ A.parseOnly keyFileParser b
|
||||
|
||||
findfields (c:v) (Just k)
|
||||
| c == fieldSep = addkeyname k v
|
||||
| otherwise = sepfield k v $ addfield c
|
||||
findfields _ v = v
|
||||
{- This splits any extension out of the keyName, returning the
|
||||
- keyName minus extension, and the extension (including leading dot).
|
||||
-}
|
||||
splitKeyNameExtension :: Key -> (S.ByteString, S.ByteString)
|
||||
splitKeyNameExtension = splitKeyNameExtension' . keyName
|
||||
|
||||
addvariety k v = Just k { keyVariety = parseKeyVariety v }
|
||||
splitKeyNameExtension' :: S.ByteString -> (S.ByteString, S.ByteString)
|
||||
splitKeyNameExtension' keyname = S8.span (/= '.') keyname
|
||||
|
||||
-- This is a strict parser for security reasons; a key
|
||||
-- can contain only 4 fields, which all consist only of numbers.
|
||||
-- Any key containing other fields, or non-numeric data is
|
||||
-- rejected with Nothing.
|
||||
--
|
||||
-- If a key contained non-numeric fields, they could be used to
|
||||
-- embed data used in a SHA1 collision attack, which would be a
|
||||
-- problem since the keys are committed to git.
|
||||
addfield _ _ v | not (all isDigit v) = Nothing
|
||||
addfield 's' k v = do
|
||||
sz <- readish v
|
||||
return $ k { keySize = Just sz }
|
||||
addfield 'm' k v = do
|
||||
mtime <- readish v
|
||||
return $ k { keyMtime = Just mtime }
|
||||
addfield 'S' k v = do
|
||||
chunksize <- readish v
|
||||
return $ k { keyChunkSize = Just chunksize }
|
||||
addfield 'C' k v = case readish v of
|
||||
Just chunknum | chunknum > 0 ->
|
||||
return $ k { keyChunkNum = Just chunknum }
|
||||
_ -> Nothing
|
||||
addfield _ _ _ = Nothing
|
||||
|
||||
addkeyname k v
|
||||
| validKeyName k v = Just $ k { keyName = v }
|
||||
| otherwise = Nothing
|
||||
|
||||
{- When a key HasExt, the length of the extension is limited in order to
|
||||
- mitigate against SHA1 collision attacks.
|
||||
{- Limits the length of the extension in the keyName to mitigate against
|
||||
- SHA1 collision 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
|
||||
|
@ -137,23 +161,25 @@ file2key s
|
|||
- characters; 20 is used here to give a little future wiggle-room.
|
||||
- The SHA1 common-prefix attack needs 128 bytes of data.
|
||||
-}
|
||||
validKeyName :: Key -> String -> Bool
|
||||
validKeyName k name
|
||||
| hasExt (keyVariety k) = length (takeExtensions name) <= 20
|
||||
validKeyName :: KeyVariety -> S.ByteString -> Bool
|
||||
validKeyName kv name
|
||||
| hasExt kv =
|
||||
let ext = snd $ splitKeyNameExtension' name
|
||||
in S.length ext <= 20
|
||||
| otherwise = True
|
||||
|
||||
instance Arbitrary Key where
|
||||
arbitrary = Key
|
||||
<$> (listOf1 $ elements $ ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "-_\r\n \t")
|
||||
<*> (parseKeyVariety <$> (listOf1 $ elements ['A'..'Z'])) -- BACKEND
|
||||
<$> (encodeBS <$> (listOf1 $ elements $ ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "-_\r\n \t"))
|
||||
<*> (parseKeyVariety . encodeBS <$> (listOf1 $ elements ['A'..'Z'])) -- BACKEND
|
||||
<*> ((abs <$>) <$> arbitrary) -- size cannot be negative
|
||||
<*> ((abs . fromInteger <$>) <$> arbitrary) -- mtime cannot be negative
|
||||
<*> ((abs <$>) <$> arbitrary) -- chunksize cannot be negative
|
||||
<*> ((succ . abs <$>) <$> arbitrary) -- chunknum cannot be 0 or negative
|
||||
|
||||
instance Hashable Key where
|
||||
hashIO32 = hashIO32 . key2file
|
||||
hashIO64 = hashIO64 . key2file
|
||||
hashIO32 = hashIO32 . key2file'
|
||||
hashIO64 = hashIO64 . key2file'
|
||||
|
||||
instance ToJSON' Key where
|
||||
toJSON' = toJSON' . key2file
|
||||
|
|
|
@ -12,8 +12,6 @@ module Types.Key where
|
|||
|
||||
import qualified Data.ByteString as S
|
||||
import qualified Data.ByteString.Char8 as S8
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import Data.ByteString.Builder
|
||||
import System.Posix.Types
|
||||
|
||||
{- A Key has a unique name, which is derived from a particular backend,
|
||||
|
|
Loading…
Reference in a new issue