mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions
git-annex/Types/Key.hs
Joey Hess 24af51e66d
git-annex unused --from remote skips its git-remote-annex keys 
This turns out to only be necessary is edge cases. Most of the
time, git-annex unused --from remote doesn't see git-remote-annex keys
at all, because it does not record a location log for them.

On the other hand, git-annex unused does find them, since it does not
rely on the location log. And that's good because they're a local cache
that the user should be able to drop.

If, however, the user ran git-annex unused and then git-annex move
--unused --to remote, the keys would have a location log for that
remote. Then git-annex unused --from remote would see them, and would
consider them unused. Even when they are present on the special remote
they belong to. And that risks losing data if they drop the keys from
the special remote, but didn't expect it would delete git branches they
had pushed to it.

So, make git-annex unused --from skip git-remote-annex keys whose uuid
is the same as the remote.
2024-05-14 15:17:40 -04:00

363 lines
13 KiB
Haskell
Raw Blame History

{- git-annex Key data type
-
- Copyright 2011-2024 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}
module Types.Key (
KeyData(..),
Key,
fromKey,
keyData,
mkKey,
alterKey,
isKeyPrefix,
splitKeyNameExtension,
keyParser,
keySerialization,
AssociatedFile(..),
KeyVariety(..),
HasExt(..),
HashSize(..),
hasExt,
sameExceptExt,
formatKeyVariety,
parseKeyVariety,
) where
import qualified Data.ByteString as S
import qualified Data.ByteString.Short as S (ShortByteString, toShort, fromShort)
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 Utility.FileSystemEncoding
import Data.List
import Data.Char
import System.Posix.Types
import Foreign.C.Types
import Data.Monoid
import Control.Applicative
import GHC.Generics
import Control.DeepSeq
import Prelude
{- A Key has a unique name, which is derived from a particular backend,
- and may contain other optional metadata. -}
data KeyData = Key
{ keyName :: S.ShortByteString
, keyVariety :: KeyVariety
, keySize :: Maybe Integer
, keyMtime :: Maybe EpochTime
, keyChunkSize :: Maybe Integer
, keyChunkNum :: Maybe Integer
} deriving (Eq, Ord, Read, Show, Generic)
instance NFData KeyData
{- Caching the serialization of a key is an optimization.
-
- This constructor is not exported, and all smart constructors maintain
- the serialization.
-}
data Key = MkKey
{ keyData :: KeyData
, keySerialization :: S.ShortByteString
} deriving (Show, Generic)
instance Eq Key where
-- comparing the serialization would be unnecessary work
a == b = keyData a == keyData b
instance Ord Key where
compare a b = compare (keyData a) (keyData b)
instance NFData Key
{- Access a field of data from the KeyData. -}
{-# INLINE fromKey #-}
fromKey :: (KeyData -> a) -> Key -> a
fromKey f = f . keyData
{- Smart constructor for a Key. The provided KeyData has all values empty. -}
mkKey :: (KeyData -> KeyData) -> Key
mkKey f =
let d = f stub
in MkKey d (mkKeySerialization d)
where
stub = Key
{ keyName = mempty
, keyVariety = OtherKey mempty
, keySize = Nothing
, keyMtime = Nothing
, keyChunkSize = Nothing
, keyChunkNum = Nothing
}
{- Alter a Key's data. -}
alterKey :: Key -> (KeyData -> KeyData) -> Key
alterKey k f =
let d = f (keyData k)
in MkKey d (mkKeySerialization d)
-- Checks if a string looks like at least the start of a key.
isKeyPrefix :: String -> Bool
isKeyPrefix s = [fieldSep, fieldSep] `isInfixOf` s
fieldSep :: Char
fieldSep = '-'
mkKeySerialization :: KeyData -> S.ShortByteString
mkKeySerialization = S.toShort . L.toStrict
. toLazyByteStringWith (safeStrategy 128 smallChunkSize) L.empty
. buildKeyData
{- Builds a ByteString from a KeyData.
-
- The name field is always shown last, separated by doubled fieldSeps,
- and is the only field allowed to contain the fieldSep.
-}
buildKeyData :: KeyData -> Builder
buildKeyData 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 (shortByteString (keyName k)))
where
sepbefore s = char7 fieldSep <> s
c ?: (Just b) = sepbefore (char7 c <> b)
_ ?: Nothing = mempty
{- This is a strict parser for security reasons; in addition to keyName,
- 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 other 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.
-}
keyParser :: A.Parser Key
keyParser = 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
let d = Key
{ keyName = S.toShort n
, keyVariety = v
, keySize = s
, keyMtime = m
, keyChunkSize = cs
, keyChunkNum = cn
}
in pure $ MkKey d (mkKeySerialization d)
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
{- 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
- including such keys would not be secure.
-
- The maximum extension length ever generated for such a key was 8
- characters, but they may be unicode which could use up to 4 bytes each,
- so 32 bytes. 64 bytes is used here to give a little future wiggle-room.
- The SHA1 common-prefix attack needs 128 bytes of data.
-}
validKeyName :: KeyVariety -> S.ByteString -> Bool
validKeyName kv name
| hasExt kv =
let ext = snd $ splitKeyNameExtension' name
in S.length ext <= 64
| otherwise = True
{- 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' . S.fromShort . keyName . keyData
splitKeyNameExtension' :: S.ByteString -> (S.ByteString, S.ByteString)
splitKeyNameExtension' keyname = S8.span (/= '.') keyname
{- A filename may be associated with a Key. -}
newtype AssociatedFile = AssociatedFile (Maybe RawFilePath)
deriving (Show, Read, Eq, Ord)
{- There are several different varieties of keys. -}
data KeyVariety
= SHA2Key HashSize HasExt
| SHA3Key HashSize HasExt
| SKEINKey HashSize HasExt
| Blake2bKey HashSize HasExt
| Blake2bpKey HashSize HasExt
| Blake2sKey HashSize HasExt
| Blake2spKey HashSize HasExt
| SHA1Key HasExt
| MD5Key HasExt
| WORMKey
| URLKey
| VURLKey
| GitBundleKey
| GitManifestKey
-- A key that is handled by some external backend.
| ExternalKey S.ByteString HasExt
-- Some repositories may contain keys of other varieties,
-- which can still be processed to some extent.
| OtherKey S.ByteString
deriving (Eq, Ord, Read, Show, Generic)
instance NFData KeyVariety
{- Some varieties of keys may contain an extension at the end of the
- keyName -}
newtype HasExt = HasExt Bool
deriving (Eq, Ord, Read, Show, Generic)
instance NFData HasExt
newtype HashSize = HashSize Int
deriving (Eq, Ord, Read, Show, Generic)
instance NFData HashSize
hasExt :: KeyVariety -> Bool
hasExt (SHA2Key _ (HasExt b)) = b
hasExt (SHA3Key _ (HasExt b)) = b
hasExt (SKEINKey _ (HasExt b)) = b
hasExt (Blake2bKey _ (HasExt b)) = b
hasExt (Blake2bpKey _ (HasExt b)) = b
hasExt (Blake2sKey _ (HasExt b)) = b
hasExt (Blake2spKey _ (HasExt b)) = b
hasExt (SHA1Key (HasExt b)) = b
hasExt (MD5Key (HasExt b)) = b
hasExt WORMKey = False
hasExt URLKey = False
hasExt VURLKey = False
hasExt GitBundleKey = False
hasExt GitManifestKey = False
hasExt (ExternalKey _ (HasExt b)) = b
hasExt (OtherKey s) = (snd <$> S8.unsnoc s) == Just '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 (Blake2bKey sz1 _) (Blake2bKey sz2 _) = sz1 == sz2
sameExceptExt (Blake2bpKey sz1 _) (Blake2bpKey sz2 _) = sz1 == sz2
sameExceptExt (Blake2sKey sz1 _) (Blake2sKey sz2 _) = sz1 == sz2
sameExceptExt (Blake2spKey sz1 _) (Blake2spKey sz2 _) = sz1 == sz2
sameExceptExt (SHA1Key _) (SHA1Key _) = True
sameExceptExt (MD5Key _) (MD5Key _) = True
sameExceptExt _ _ = False
formatKeyVariety :: KeyVariety -> S.ByteString
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")
Blake2bKey sz e -> adde e (addsz sz "BLAKE2B")
Blake2bpKey sz e -> adde e (addsz sz "BLAKE2BP")
Blake2sKey sz e -> adde e (addsz sz "BLAKE2S")
Blake2spKey sz e -> adde e (addsz sz "BLAKE2SP")
SHA1Key e -> adde e "SHA1"
MD5Key e -> adde e "MD5"
WORMKey -> "WORM"
URLKey -> "URL"
VURLKey -> "VURL"
GitBundleKey -> "GITBUNDLE"
GitManifestKey -> "GITMANIFEST"
ExternalKey s e -> adde e ("X" <> s)
OtherKey s -> s
where
adde (HasExt False) s = s
adde (HasExt True) s = s <> "E"
addsz (HashSize n) s = s <> case n of
256 -> "256"
512 -> "512"
224 -> "224"
384 -> "384"
160 -> "160"
-- This is relatively slow, which is why the common hash
-- sizes are hardcoded above.
_ -> S8.pack (show n)
parseKeyVariety :: S.ByteString -> 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 "BLAKE2B160" = Blake2bKey (HashSize 160) (HasExt False)
parseKeyVariety "BLAKE2B160E" = Blake2bKey (HashSize 160) (HasExt True)
parseKeyVariety "BLAKE2B224" = Blake2bKey (HashSize 224) (HasExt False)
parseKeyVariety "BLAKE2B224E" = Blake2bKey (HashSize 224) (HasExt True)
parseKeyVariety "BLAKE2B256" = Blake2bKey (HashSize 256) (HasExt False)
parseKeyVariety "BLAKE2B256E" = Blake2bKey (HashSize 256) (HasExt True)
parseKeyVariety "BLAKE2B384" = Blake2bKey (HashSize 384) (HasExt False)
parseKeyVariety "BLAKE2B384E" = Blake2bKey (HashSize 384) (HasExt True)
parseKeyVariety "BLAKE2B512" = Blake2bKey (HashSize 512) (HasExt False)
parseKeyVariety "BLAKE2B512E" = Blake2bKey (HashSize 512) (HasExt True)
parseKeyVariety "BLAKE2BP512" = Blake2bpKey (HashSize 512) (HasExt False)
parseKeyVariety "BLAKE2BP512E" = Blake2bpKey (HashSize 512) (HasExt True)
parseKeyVariety "BLAKE2S160" = Blake2sKey (HashSize 160) (HasExt False)
parseKeyVariety "BLAKE2S160E" = Blake2sKey (HashSize 160) (HasExt True)
parseKeyVariety "BLAKE2S224" = Blake2sKey (HashSize 224) (HasExt False)
parseKeyVariety "BLAKE2S224E" = Blake2sKey (HashSize 224) (HasExt True)
parseKeyVariety "BLAKE2S256" = Blake2sKey (HashSize 256) (HasExt False)
parseKeyVariety "BLAKE2S256E" = Blake2sKey (HashSize 256) (HasExt True)
parseKeyVariety "BLAKE2SP224" = Blake2spKey (HashSize 224) (HasExt False)
parseKeyVariety "BLAKE2SP224E" = Blake2spKey (HashSize 224) (HasExt True)
parseKeyVariety "BLAKE2SP256" = Blake2spKey (HashSize 256) (HasExt False)
parseKeyVariety "BLAKE2SP256E" = Blake2spKey (HashSize 256) (HasExt True)
parseKeyVariety "SHA1" = SHA1Key (HasExt False)
parseKeyVariety "SHA1E" = SHA1Key (HasExt True)
parseKeyVariety "MD5" = MD5Key (HasExt False)
parseKeyVariety "MD5E" = MD5Key (HasExt True)
parseKeyVariety "WORM" = WORMKey
parseKeyVariety "URL" = URLKey
parseKeyVariety "VURL" = VURLKey
parseKeyVariety "GITBUNDLE" = GitBundleKey
parseKeyVariety b
| "X" `S.isPrefixOf` b =
let b' = S.tail b
in if not (S.null b') && S.last b' == fromIntegral (ord 'E')
then ExternalKey (S.init b') (HasExt True)
else ExternalKey b' (HasExt False)
| otherwise = OtherKey b
Reference in a new issue View git blame Copy permalink