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
parent
ff0a2bee2d
commit
d3ab5e626b
40 changed files with 97 additions and 108 deletions
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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) ++ ")"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -126,5 +126,5 @@ instance TCSerialized RemoteName where
|
|||
deserialize n = Just n
|
||||
|
||||
instance TCSerialized Key where
|
||||
serialize = key2file
|
||||
deserialize = file2key
|
||||
serialize = serializeKey
|
||||
deserialize = deserializeKey
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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
72
Key.hs
|
|
@ -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
|
||||
|
|
|
|||
2
Logs.hs
2
Logs.hs
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 $
|
||||
|
|
|
|||
|
|
@ -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 ':'
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ->
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
11
Test.hs
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Reference in a new issue