rename key2file and file2key

What these generate is not really suitable to be used as a filename,
which is why keyFile and fileKey further escape it. These are just
serializing Keys.

Also removed a quickcheck test that was very unlikely to test anything
useful, since it relied on random chance creating something that looks
like a serialized key. The other test is sufficient for testing what
that was intended to test anyway.
This commit is contained in:
Joey Hess 2019-01-14 13:03:35 -04:00
parent ff0a2bee2d
commit d3ab5e626b
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
40 changed files with 97 additions and 108 deletions

View file

@ -65,14 +65,14 @@ hashDirs (HashLevels 1) sz s = addTrailingPathSeparator $ take sz s
hashDirs _ sz s = addTrailingPathSeparator $ take sz s </> drop sz s
hashDirLower :: HashLevels -> Hasher
hashDirLower n k = hashDirs n 3 $ take 6 $ show $ md5 $ key2file' $ nonChunkKey k
hashDirLower n k = hashDirs n 3 $ take 6 $ show $ md5 $ serializeKey' $ nonChunkKey k
{- This was originally using Data.Hash.MD5 from MissingH. This new version
- is faster, but ugly as it has to replicate the 4 Word32's that produced. -}
hashDirMixed :: HashLevels -> Hasher
hashDirMixed n k = hashDirs n 2 $ take 4 $ concatMap display_32bits_as_dir $
encodeWord32 $ map fromIntegral $ Data.ByteArray.unpack $
Utility.Hash.md5 $ key2file' $ nonChunkKey k
Utility.Hash.md5 $ serializeKey' $ nonChunkKey k
where
encodeWord32 (b1:b2:b3:b4:rest) =
(shiftL b4 24 .|. shiftL b3 16 .|. shiftL b2 8 .|. b1)

View file

@ -115,7 +115,7 @@ handleDropsFrom locs rs reason fromhere key afile preverified runner = do
liftIO $ debugM "drop" $ unwords
[ "dropped"
, case afile of
AssociatedFile Nothing -> key2file key
AssociatedFile Nothing -> serializeKey key
AssociatedFile (Just af) -> af
, "(from " ++ maybe "here" show u ++ ")"
, "(copies now " ++ show (fromNumCopies have - 1) ++ ")"

View file

@ -506,7 +506,7 @@ reSanitizeKeyName = preSanitizeKeyName' True
- can cause existing objects to get lost.
-}
keyFile :: Key -> FilePath
keyFile = concatMap esc . key2file
keyFile = concatMap esc . serializeKey
where
esc '&' = "&a"
esc '%' = "&s"
@ -517,7 +517,7 @@ keyFile = concatMap esc . key2file
{- Reverses keyFile, converting a filename fragment (ie, the basename of
- the symlink target) into a key. -}
fileKey :: FilePath -> Maybe Key
fileKey = file2key . unesc []
fileKey = deserializeKey . unesc []
where
unesc r [] = reverse r
unesc r ('%':cs) = unesc ('/':r) cs

View file

@ -34,8 +34,8 @@ mkVariant file variant = takeDirectory file
-}
variantFile :: FilePath -> Key -> FilePath
variantFile file key
| doubleconflict = mkVariant file (key2file key)
| otherwise = mkVariant file (shortHash $ key2file key)
| doubleconflict = mkVariant file (serializeKey key)
| otherwise = mkVariant file (shortHash $ serializeKey key)
where
doubleconflict = variantMarker `isInfixOf` file

View file

@ -74,7 +74,7 @@ expireUnused duration = do
now <- liftIO getPOSIXTime
let oldkeys = M.keys $ M.filter (tooold now) m
forM_ oldkeys $ \k -> do
debug ["removing old unused key", key2file k]
debug ["removing old unused key", serializeKey k]
liftAnnex $ tryNonAsync $ do
lockContentForRemoval k removeAnnex
logStatus k InfoMissing

View file

@ -44,7 +44,7 @@ transfersDisplay = do
isrunning info = not $
transferPaused info || isNothing (startedTime info)
desc transfer info = case associatedFile info of
AssociatedFile Nothing -> key2file $ transferKey transfer
AssociatedFile Nothing -> serializeKey $ transferKey transfer
AssociatedFile (Just af) -> af
{- Simplifies a list of transfers, avoiding display of redundant

View file

@ -150,7 +150,7 @@ perform file = do
cleanup :: Key -> Bool -> CommandCleanup
cleanup key hascontent = do
maybeShowJSON $ JSONChunk [("key", key2file key)]
maybeShowJSON $ JSONChunk [("key", serializeKey key)]
when hascontent $
logStatus key InfoPresent
return True

View file

@ -32,7 +32,7 @@ perform key = next $ do
addLink file key Nothing
return True
where
file = "unused." ++ key2file key
file = "unused." ++ serializeKey key
{- The content is not in the annex, but in another directory, and
- it seems better to error out, rather than moving bad/tmp content into

View file

@ -400,7 +400,7 @@ addWorkTree u url file key mtmp = case mtmp of
else void $ Command.Add.addSmall file
where
go = do
maybeShowJSON $ JSONChunk [("key", key2file key)]
maybeShowJSON $ JSONChunk [("key", serializeKey key)]
setUrlPresent key url
logChange key u InfoPresent
ifM (addAnnexedFile file key mtmp)

View file

@ -21,6 +21,6 @@ cmd = noCommit $ noMessages $ dontCheck repoExists $
run :: () -> String -> Annex Bool
run _ file = genKey (KeySource file file Nothing) Nothing >>= \case
Just (k, _) -> do
liftIO $ putStrLn $ key2file k
liftIO $ putStrLn $ serializeKey k
return True
Nothing -> return False

View file

@ -33,7 +33,7 @@ seek (DeadKeys ks) = commandActions $ map startKey ks
startKey :: Key -> CommandStart
startKey key = do
showStart' "dead" (Just $ key2file key)
showStart' "dead" (Just $ serializeKey key)
keyLocations key >>= \case
[] -> next $ performKey key
_ -> giveup "This key is still known to be present in some locations; not marking as dead."

View file

@ -21,6 +21,6 @@ cmd = noCommit $ noMessages $ dontCheck repoExists $
run :: Maybe Utility.Format.Format -> String -> Annex Bool
run format p = do
let k = fromMaybe (giveup "bad key") $ file2key p
showFormatted format (key2file k) (keyVars k)
let k = fromMaybe (giveup "bad key") $ deserializeKey p
showFormatted format (serializeKey k) (keyVars k)
return True

View file

@ -66,7 +66,7 @@ optParser _ = ExportOptions
-- to a stable temporary name based on the key.
exportTempName :: ExportKey -> ExportLocation
exportTempName ek = mkExportLocation $
".git-annex-tmp-content-" ++ key2file (asKey (ek))
".git-annex-tmp-content-" ++ serializeKey (asKey (ek))
seek :: ExportOptions -> CommandSeek
seek o = do

View file

@ -88,7 +88,7 @@ showFormatted format unformatted vars =
keyVars :: Key -> [(String, String)]
keyVars key =
[ ("key", key2file key)
[ ("key", serializeKey key)
, ("backend", decodeBS $ formatKeyVariety $ keyVariety key)
, ("bytesize", size show)
, ("humansize", size $ roughSize storageUnits True)

View file

@ -498,7 +498,7 @@ checkBackendOr' bad backend key file ai postcheck =
checkKeyNumCopies :: Key -> AssociatedFile -> NumCopies -> Annex Bool
checkKeyNumCopies key afile numcopies = do
let (desc, hasafile) = case afile of
AssociatedFile Nothing -> (key2file key, False)
AssociatedFile Nothing -> (serializeKey key, False)
AssociatedFile (Just af) -> (af, True)
locs <- loggedLocations key
(untrustedlocations, otherlocations) <- trustPartition UnTrusted locs
@ -562,7 +562,7 @@ badContentDirect file key = do
badContentRemote :: Remote -> FilePath -> Key -> Annex String
badContentRemote remote localcopy key = do
bad <- fromRepo gitAnnexBadDir
let destbad = bad </> key2file key
let destbad = bad </> serializeKey key
movedbad <- ifM (inAnnex key <||> liftIO (doesFileExist destbad))
( return False
, do

View file

@ -86,7 +86,7 @@ start largematcher mode (srcfile, destfile) =
)
where
deletedup k = do
showNote $ "duplicate of " ++ key2file k
showNote $ "duplicate of " ++ serializeKey k
verifyExisting k destfile
( do
liftIO $ removeFile srcfile

View file

@ -410,7 +410,7 @@ key_size :: Key -> Stat
key_size k = simpleStat "size" $ showSizeKeys $ foldKeys [k]
key_name :: Key -> Stat
key_name k = simpleStat "key" $ pure $ key2file k
key_name k = simpleStat "key" $ pure $ serializeKey k
content_present :: Key -> Stat
content_present k = stat "present" $ json boolConfig $ lift $ inAnnex k

View file

@ -144,7 +144,7 @@ showLogIncremental outputter ps = do
- as showLogIncremental. -}
showLog :: (String -> Outputter) -> [RefChange] -> Annex ()
showLog outputter cs = forM_ cs $ \c -> do
let keyname = key2file (changekey c)
let keyname = serializeKey (changekey c)
new <- S.fromList <$> loggedLocationsRef (newref c)
old <- S.fromList <$> loggedLocationsRef (oldref c)
sequence_ $ compareChanges (outputter keyname)

View file

@ -23,7 +23,7 @@ run _ file = seekSingleGitFile file >>= \case
Nothing -> return False
Just file' -> catKeyFile file' >>= \case
Just k -> do
liftIO $ putStrLn $ key2file k
liftIO $ putStrLn $ serializeKey k
return True
Nothing -> return False

View file

@ -178,7 +178,7 @@ test st r k =
Nothing -> return True
Just b -> case Backend.verifyKeyContent b of
Nothing -> return True
Just verifier -> verifier k (key2file k)
Just verifier -> verifier k (serializeKey k)
get = getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k $ \dest ->
Remote.retrieveKeyFile r k (AssociatedFile Nothing)
dest nullMeterUpdate

View file

@ -126,5 +126,5 @@ instance TCSerialized RemoteName where
deserialize n = Just n
instance TCSerialized Key where
serialize = key2file
deserialize = file2key
serialize = serializeKey
deserialize = deserializeKey

View file

@ -118,7 +118,7 @@ number n (x:xs) = (n+1, x) : number (n+1) xs
table :: [(Int, Key)] -> [String]
table l = " NUMBER KEY" : map cols l
where
cols (n,k) = " " ++ pad 6 (show n) ++ " " ++ key2file k
cols (n,k) = " " ++ pad 6 (show n) ++ " " ++ serializeKey k
pad n s = s ++ replicate (n - length s) ' '
staleTmpMsg :: [(Int, Key)] -> String

View file

@ -161,7 +161,7 @@ type EncKey = Key -> Key
- on content. It does need to be repeatable. -}
encryptKey :: Mac -> Cipher -> EncKey
encryptKey mac c k = stubKey
{ keyName = encodeBS (macWithCipher mac c (key2file k))
{ keyName = encodeBS (macWithCipher mac c (serializeKey k))
, keyVariety = OtherKey $
encryptedBackendNamePrefix <> encodeBS (showMac mac)
}

View file

@ -23,10 +23,10 @@ newtype SKey = SKey String
deriving (Show, Read)
toSKey :: Key -> SKey
toSKey = SKey . key2file
toSKey = SKey . serializeKey
fromSKey :: SKey -> Key
fromSKey (SKey s) = fromMaybe (error $ "bad serialized Key " ++ s) (file2key s)
fromSKey (SKey s) = fromMaybe (error $ "bad serialized Key " ++ s) (deserializeKey s)
derivePersistField "SKey"
@ -41,10 +41,10 @@ instance Show IKey where
show (IKey s) = s
toIKey :: Key -> IKey
toIKey = IKey . key2file
toIKey = IKey . serializeKey
fromIKey :: IKey -> Key
fromIKey (IKey s) = fromMaybe (error $ "bad serialized Key " ++ s) (file2key s)
fromIKey (IKey s) = fromMaybe (error $ "bad serialized Key " ++ s) (deserializeKey s)
derivePersistField "IKey"

72
Key.hs
View file

@ -11,20 +11,19 @@ module Key (
Key(..),
AssociatedFile(..),
stubKey,
buildKeyFile,
keyFileParser,
file2key,
key2file,
file2key',
key2file',
buildKey,
keyParser,
serializeKey,
serializeKey,
deserializeKey',
deserializeKey',
nonChunkKey,
chunkKeyOffset,
isChunkKey,
isKeyPrefix,
splitKeyNameExtension,
prop_isomorphic_key_encode,
prop_isomorphic_key_decode
prop_isomorphic_key_encode
) where
import qualified Data.Text as T
@ -77,11 +76,13 @@ isKeyPrefix s = [fieldSep, fieldSep] `isInfixOf` s
fieldSep :: Char
fieldSep = '-'
{- 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. -}
buildKeyFile :: Key -> Builder
buildKeyFile k = byteString (formatKeyVariety (keyVariety k))
{- Builds a ByteString from a Key.
-
- The name field is always shown last, separated by doubled fieldSeps,
- and is the only field allowed to contain the fieldSep.
-}
buildKey :: Key -> Builder
buildKey k = byteString (formatKeyVariety (keyVariety k))
<> 's' ?: (integerDec <$> keySize k)
<> 'm' ?: (integerDec . (\(CTime t) -> fromIntegral t) <$> keyMtime k)
<> 'S' ?: (integerDec <$> keyChunkSize k)
@ -92,11 +93,11 @@ buildKeyFile k = byteString (formatKeyVariety (keyVariety k))
c ?: (Just b) = sepbefore (char7 c <> b)
_ ?: Nothing = mempty
key2file :: Key -> FilePath
key2file = decodeBL' . key2file'
serializeKey :: Key -> String
serializeKey = decodeBL' . serializeKey'
key2file' :: Key -> L.ByteString
key2file' = toLazyByteStringWith (safeStrategy 128 smallChunkSize) L.empty . buildKeyFile
serializeKey' :: Key -> L.ByteString
serializeKey' = toLazyByteStringWith (safeStrategy 128 smallChunkSize) L.empty . buildKey
{- This is a strict parser for security reasons; a key
- can contain only 4 fields, which all consist only of numbers.
@ -107,8 +108,8 @@ key2file' = toLazyByteStringWith (safeStrategy 128 smallChunkSize) L.empty . bui
- 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
keyParser :: A.Parser Key
keyParser = do
-- key variety cannot be empty
v <- (parseKeyVariety <$> A8.takeWhile1 (/= fieldSep))
s <- parsesize
@ -135,11 +136,11 @@ keyFileParser = do
parsechunksize = parseopt $ A8.char 'S' *> A8.decimal
parsechunknum = parseopt $ A8.char 'C' *> A8.decimal
file2key :: FilePath -> Maybe Key
file2key = file2key' . encodeBS'
deserializeKey :: String -> Maybe Key
deserializeKey = deserializeKey' . encodeBS'
file2key' :: S.ByteString -> Maybe Key
file2key' b = eitherToMaybe $ A.parseOnly keyFileParser b
deserializeKey' :: S.ByteString -> Maybe Key
deserializeKey' b = eitherToMaybe $ A.parseOnly keyParser b
{- This splits any extension out of the keyName, returning the
- keyName minus extension, and the extension (including leading dot).
@ -178,30 +179,19 @@ instance Arbitrary Key where
<*> ((succ . abs <$>) <$> arbitrary) -- chunknum cannot be 0 or negative
instance Hashable Key where
hashIO32 = hashIO32 . key2file'
hashIO64 = hashIO64 . key2file'
hashIO32 = hashIO32 . deserializeKey'
hashIO64 = hashIO64 . deserializeKey'
instance ToJSON' Key where
toJSON' = toJSON' . key2file
toJSON' = toJSON' . serializeKey
instance FromJSON Key where
parseJSON (String t) = maybe mempty pure $ file2key $ T.unpack t
parseJSON (String t) = maybe mempty pure $ deserializeKey $ T.unpack t
parseJSON _ = mempty
instance Proto.Serializable Key where
serialize = key2file
deserialize = file2key
serialize = serializeKey
deserialize = deserializeKey
prop_isomorphic_key_encode :: Key -> Bool
prop_isomorphic_key_encode k = Just k == (file2key . key2file) k
prop_isomorphic_key_decode :: FilePath -> Bool
prop_isomorphic_key_decode f
| normalfieldorder = maybe True (\k -> key2file k == f) (file2key f)
| otherwise = True
where
-- file2key will accept the fields in any order, so don't
-- try the test unless the fields are in the normal order
normalfieldorder = fields `isPrefixOf` "smSC"
fields = map (f !!) $ filter (< length f) $ map succ $
elemIndices fieldSep f
prop_isomorphic_key_encode k = Just k == (deserializeKey . serializeKey) k

View file

@ -124,7 +124,7 @@ urlLogFile config key = branchHashDir config key </> keyFile key ++ urlLogExt
{- Old versions stored the urls elsewhere. -}
oldurlLogs :: GitConfig -> Key -> [FilePath]
oldurlLogs config key =
[ "remote/web" </> hdir </> key2file key ++ ".log"
[ "remote/web" </> hdir </> serializeKey key ++ ".log"
, "remote/web" </> hdir </> keyFile key ++ ".log"
]
where

View file

@ -16,7 +16,7 @@ smudgeLog :: Key -> TopFilePath -> Annex ()
smudgeLog k f = do
logf <- fromRepo gitAnnexSmudgeLog
appendLogFile logf gitAnnexSmudgeLock $
key2file k ++ " " ++ getTopFilePath f
serializeKey k ++ " " ++ getTopFilePath f
-- | Streams all smudged files, and then empties the log at the end.
--
@ -36,5 +36,5 @@ streamSmudged a = do
parse l =
let (ks, f) = separate (== ' ') l
in do
k <- file2key ks
k <- deserializeKey ks
return (k, asTopFilePath f)

View file

@ -66,8 +66,8 @@ writeUnusedLog prefix l = do
logfile <- fromRepo $ gitAnnexUnusedLog prefix
writeLogFile logfile $ unlines $ map format $ M.toList l
where
format (k, (i, Just t)) = show i ++ " " ++ key2file k ++ " " ++ show t
format (k, (i, Nothing)) = show i ++ " " ++ key2file k
format (k, (i, Just t)) = show i ++ " " ++ serializeKey k ++ " " ++ show t
format (k, (i, Nothing)) = show i ++ " " ++ serializeKey k
readUnusedLog :: FilePath -> Annex UnusedLog
readUnusedLog prefix = do
@ -78,7 +78,7 @@ readUnusedLog prefix = do
, return M.empty
)
where
parse line = case (readish sint, file2key skey, parsePOSIXTime ts) of
parse line = case (readish sint, deserializeKey skey, parsePOSIXTime ts) of
(Just int, Just key, mtimestamp) -> Just (key, (int, mtimestamp))
_ -> Nothing
where

View file

@ -186,7 +186,7 @@ checkKey' r serial aloc = do
androidLocation :: AndroidPath -> Key -> AndroidPath
androidLocation adir k = AndroidPath $
fromAndroidPath (androidHashDir adir k) ++ key2file k
fromAndroidPath (androidHashDir adir k) ++ serializeKey k
androidHashDir :: AndroidPath -> Key -> AndroidPath
androidHashDir adir k = AndroidPath $

View file

@ -280,7 +280,7 @@ bupRef k
| Git.Ref.legal True shown = shown
| otherwise = "git-annex-" ++ show (sha2_256 (fromString shown))
where
shown = key2file k
shown = serializeKey k
bupLocal :: BupRepo -> Bool
bupLocal = notElem ':'

View file

@ -110,7 +110,7 @@ store ddarrepo = fileStorer $ \k src _p -> do
let params =
[ Param "c"
, Param "-N"
, Param $ key2file k
, Param $ serializeKey k
, Param $ ddarRepoLocation ddarrepo
, File src
]
@ -138,7 +138,7 @@ ddarRemoteCall cs ddarrepo cmd params
{- Specialized ddarRemoteCall that includes extraction command and flags -}
ddarExtractRemoteCall :: ConsumeStdin -> DdarRepo -> Key -> Annex (String, [CommandParam])
ddarExtractRemoteCall cs ddarrepo k =
ddarRemoteCall cs ddarrepo 'x' [Param "--force-stdout", Param $ key2file k]
ddarRemoteCall cs ddarrepo 'x' [Param "--force-stdout", Param $ serializeKey k]
retrieve :: DdarRepo -> Retriever
retrieve ddarrepo = byteRetriever $ \k sink -> do
@ -154,7 +154,7 @@ retrieveCheap _ _ _ = return False
remove :: DdarRepo -> Remover
remove ddarrepo key = do
(cmd, params) <- ddarRemoteCall NoConsumeStdin ddarrepo 'd'
[Param $ key2file key]
[Param $ serializeKey key]
liftIO $ boolSystem cmd params
ddarDirectoryExists :: DdarRepo -> Annex (Either String Bool)
@ -188,7 +188,7 @@ inDdarManifest ddarrepo k = do
contents <- hGetContents h
return $ elem k' $ lines contents
where
k' = key2file k
k' = serializeKey k
checkKey :: DdarRepo -> CheckPresent
checkKey ddarrepo key = do

View file

@ -427,7 +427,7 @@ lockKey' repo r (State connpool duc _) key callback
fallback = do
Just (cmd, params) <- Ssh.git_annex_shell ConsumeStdin
repo "lockcontent"
[Param $ key2file key] []
[Param $ serializeKey key] []
(Just hin, Just hout, Nothing, p) <- liftIO $
withFile devNull WriteMode $ \nullh ->
createProcess $
@ -530,7 +530,7 @@ copyFromRemote'' repo forcersync r (State connpool _ _) key file dest meterupdat
: maybe [] (\f -> [(Fields.associatedFile, f)]) afile
Just (cmd, params) <- Ssh.git_annex_shell ConsumeStdin
repo "transferinfo"
[Param $ key2file key] fields
[Param $ serializeKey key] fields
v <- liftIO (newEmptySV :: IO (MSampleVar Integer))
pidv <- liftIO $ newEmptyMVar
tid <- liftIO $ forkIO $ void $ tryIO $ do

View file

@ -197,7 +197,7 @@ checkKey r k = do
{- glacier checkpresent outputs the archive name to stdout if
- it's present. -}
s <- liftIO $ readProcessEnv "glacier" (toCommand params) (Just e)
let probablypresent = key2file k `elem` lines s
let probablypresent = serializeKey k `elem` lines s
if probablypresent
then ifM (Annex.getFlag "trustglacier")
( return True, giveup untrusted )
@ -253,7 +253,7 @@ getVault = fromMaybe (giveup "Missing vault configuration")
. M.lookup "vault"
archive :: Remote -> Key -> Archive
archive r k = fileprefix ++ key2file k
archive r k = fileprefix ++ serializeKey k
where
fileprefix = M.findWithDefault "" "fileprefix" $ config r
@ -306,7 +306,7 @@ jobList r keys = go =<< glacierEnv (config r) (gitconfig r) (uuid r)
parse c [] = c
parse c@(succeeded, failed) ((status:_date:vault:key:[]):rest)
| vault == myvault =
case file2key key of
case deserializeKey key of
Nothing -> parse c rest
Just k
| "a/d" `isPrefixOf` status ->

View file

@ -98,7 +98,7 @@ onRemote cs r (with, errorval) command params fields = do
inAnnex :: Git.Repo -> Key -> Annex Bool
inAnnex r k = do
showChecking r
onRemote NoConsumeStdin r (runcheck, cantCheck r) "inannex" [Param $ key2file k] []
onRemote NoConsumeStdin r (runcheck, cantCheck r) "inannex" [Param $ serializeKey k] []
where
runcheck c p = dispatch =<< safeSystem c p
dispatch ExitSuccess = return True
@ -109,7 +109,7 @@ inAnnex r k = do
dropKey :: Git.Repo -> Key -> Annex Bool
dropKey r key = onRemote NoConsumeStdin r (boolSystem, return False) "dropkey"
[ Param "--quiet", Param "--force"
, Param $ key2file key
, Param $ serializeKey key
]
[]
@ -141,7 +141,7 @@ rsyncParamsRemote unlocked r direction key file (AssociatedFile afile) = do
repo <- getRepo r
Just (shellcmd, shellparams) <- git_annex_shell ConsumeStdin repo
(if direction == Download then "sendkey" else "recvkey")
[ Param $ key2file key ]
[ Param $ serializeKey key ]
fields
-- Convert the ssh command into rsync command line.
let eparam = rsyncShell (Param shellcmd:shellparams)

View file

@ -92,7 +92,7 @@ hookEnv action k f = Just <$> mergeenv (fileenv f ++ keyenv)
mergeenv l = addEntries l <$> getEnvironment
envvar s v = ("ANNEX_" ++ s, v)
keyenv = catMaybes
[ Just $ envvar "KEY" (key2file k)
[ Just $ envvar "KEY" (serializeKey k)
, Just $ envvar "ACTION" action
, envvar "HASH_1" <$> headMaybe hashbits
, envvar "HASH_2" <$> headMaybe (drop 1 hashbits)
@ -151,7 +151,7 @@ checkKey r h k = do
liftIO $ check v
where
action = "checkpresent"
findkey s = key2file k `elem` lines s
findkey s = serializeKey k `elem` lines s
check Nothing = giveup $ action ++ " hook misconfigured"
check (Just hook) = do
environ <- hookEnv action k Nothing

View file

@ -653,7 +653,7 @@ getFilePrefix :: RemoteConfig -> String
getFilePrefix = M.findWithDefault "" "fileprefix"
getBucketObject :: RemoteConfig -> Key -> BucketObject
getBucketObject c = munge . key2file
getBucketObject c = munge . serializeKey
where
munge s = case M.lookup "mungekeys" c of
Just "ia" -> iaMunge $ getFilePrefix c ++ s

11
Test.hs
View file

@ -160,7 +160,6 @@ properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck"
[ 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_isomorphic_key_encode" Key.prop_isomorphic_key_encode
, testProperty "prop_isomorphic_key_decode" Key.prop_isomorphic_key_decode
, testProperty "prop_isomorphic_shellEscape" Utility.SafeCommand.prop_isomorphic_shellEscape
, testProperty "prop_isomorphic_shellEscape_multiword" Utility.SafeCommand.prop_isomorphic_shellEscape_multiword
, testProperty "prop_isomorphic_configEscape" Logs.Remote.prop_isomorphic_configEscape
@ -397,7 +396,7 @@ test_reinject = intmpclonerepoInDirect $ do
git_annex "drop" ["--force", sha1annexedfile] @? "drop failed"
annexed_notpresent sha1annexedfile
writecontent tmp $ content sha1annexedfile
key <- Key.key2file <$> getKey backendSHA1 tmp
key <- Key.serializeKey <$> getKey backendSHA1 tmp
git_annex "reinject" [tmp, sha1annexedfile] @? "reinject failed"
annexed_present sha1annexedfile
-- fromkey can't be used on a crippled filesystem, since it makes a
@ -867,9 +866,9 @@ test_unused = intmpclonerepoInDirect $ do
checkunused [annexedfilekey, sha1annexedfilekey] "after rm sha1annexedfile"
-- good opportunity to test dropkey also
git_annex "dropkey" ["--force", Key.key2file annexedfilekey]
git_annex "dropkey" ["--force", Key.serializeKey annexedfilekey]
@? "dropkey failed"
checkunused [sha1annexedfilekey] ("after dropkey --force " ++ Key.key2file annexedfilekey)
checkunused [sha1annexedfilekey] ("after dropkey --force " ++ Key.serializeKey annexedfilekey)
git_annex_shouldfail "dropunused" ["1"] @? "dropunused failed to fail without --force"
git_annex "dropunused" ["--force", "1"] @? "dropunused failed"
@ -1682,12 +1681,12 @@ test_crypto = do
let encparams = (mempty :: Types.Remote.RemoteConfig, dummycfg)
cipher <- Crypto.decryptCipher gpgcmd encparams cip
files <- filterM doesFileExist $
map ("dir" </>) $ concatMap (key2files cipher) keys
map ("dir" </>) $ concatMap (serializeKeys cipher) keys
return (not $ null files) <&&> allM (checkFile mvariant) files
checkFile mvariant filename =
Utility.Gpg.checkEncryptionFile gpgcmd filename $
if mvariant == Just Types.Crypto.PubKey then ks else Nothing
key2files cipher = Annex.Locations.keyPaths .
serializeKeys cipher = Annex.Locations.keyPaths .
Crypto.encryptKey Types.Crypto.HmacSha1 cipher
#else
test_crypto = putStrLn "gpg testing not implemented on Windows"

View file

@ -341,7 +341,7 @@ checklocationlog f expected = do
case r of
Just k -> do
uuids <- annexeval $ Remote.keyLocations k
assertEqual ("bad content in location log for " ++ f ++ " key " ++ Key.key2file k ++ " uuid " ++ show thisuuid)
assertEqual ("bad content in location log for " ++ f ++ " key " ++ Key.serializeKey k ++ " uuid " ++ show thisuuid)
expected (thisuuid `elem` uuids)
_ -> assertFailure $ f ++ " failed to look up key"

View file

@ -36,8 +36,8 @@ instance MkActionItem (Transfer, TransferInfo) where
actionItemDesc :: ActionItem -> Key -> String
actionItemDesc (ActionItemAssociatedFile (AssociatedFile (Just f))) _ = f
actionItemDesc (ActionItemAssociatedFile (AssociatedFile Nothing)) k = key2file k
actionItemDesc ActionItemKey k = key2file k
actionItemDesc (ActionItemAssociatedFile (AssociatedFile Nothing)) k = serializeKey k
actionItemDesc ActionItemKey k = serializeKey k
actionItemDesc (ActionItemBranchFilePath bfp) _ = descBranchFilePath bfp
actionItemDesc (ActionItemFailedTransfer _ i) k =
actionItemDesc (ActionItemAssociatedFile (associatedFile i)) k

View file

@ -46,7 +46,7 @@ parseInfoFile s = case lines s of
formatGitAnnexDistribution :: GitAnnexDistribution -> String
formatGitAnnexDistribution d = unlines
[ distributionUrl d
, key2file (distributionKey d)
, serializeKey (distributionKey d)
, distributionVersion d
, show (distributionReleasedate d)
, maybe "" show (distributionUrgentUpgrade d)
@ -56,7 +56,7 @@ parseGitAnnexDistribution :: String -> Maybe GitAnnexDistribution
parseGitAnnexDistribution s = case lines s of
(u:k:v:d:uu:_) -> GitAnnexDistribution
<$> pure u
<*> file2key k
<*> deserializeKey k
<*> pure v
<*> readish d
<*> pure (readish uu)