convert KeySource to RawFilePath
This commit is contained in:
parent
e468fbc518
commit
c31e1be781
14 changed files with 74 additions and 55 deletions
|
@ -369,8 +369,8 @@ downloadImport remote importtreeconfig importablecontents = do
|
|||
f <- fromRepo $ fromTopFilePath $ locworktreefilename loc
|
||||
backend <- chooseBackend (fromRawFilePath f)
|
||||
let ks = KeySource
|
||||
{ keyFilename = (fromRawFilePath f)
|
||||
, contentLocation = tmpfile
|
||||
{ keyFilename = f
|
||||
, contentLocation = toRawFilePath tmpfile
|
||||
, inodeCache = Nothing
|
||||
}
|
||||
fmap fst <$> genKey ks nullMeterUpdate backend
|
||||
|
|
|
@ -49,6 +49,7 @@ import Annex.AdjustedBranch
|
|||
import Annex.FileMatcher
|
||||
|
||||
import Control.Exception (IOException)
|
||||
import qualified Utility.RawFilePath as R
|
||||
|
||||
data LockedDown = LockedDown
|
||||
{ lockDownConfig :: LockDownConfig
|
||||
|
@ -91,13 +92,15 @@ lockDown' cfg file = tryIO $ ifM crippledFileSystem
|
|||
Just tmpdir -> withhardlink tmpdir
|
||||
)
|
||||
where
|
||||
file' = toRawFilePath file
|
||||
|
||||
nohardlink = withTSDelta $ liftIO . nohardlink'
|
||||
|
||||
nohardlink' delta = do
|
||||
cache <- genInodeCache (toRawFilePath file) delta
|
||||
return $ LockedDown cfg $ KeySource
|
||||
{ keyFilename = file
|
||||
, contentLocation = file
|
||||
{ keyFilename = file'
|
||||
, contentLocation = file'
|
||||
, inodeCache = cache
|
||||
}
|
||||
|
||||
|
@ -116,8 +119,8 @@ lockDown' cfg file = tryIO $ ifM crippledFileSystem
|
|||
createLink file tmpfile
|
||||
cache <- genInodeCache (toRawFilePath tmpfile) delta
|
||||
return $ LockedDown cfg $ KeySource
|
||||
{ keyFilename = file
|
||||
, contentLocation = tmpfile
|
||||
{ keyFilename = file'
|
||||
, contentLocation = toRawFilePath tmpfile
|
||||
, inodeCache = cache
|
||||
}
|
||||
|
||||
|
@ -135,10 +138,11 @@ ingestAdd' meterupdate ld@(Just (LockedDown cfg source)) mk = do
|
|||
Just k -> do
|
||||
let f = keyFilename source
|
||||
if lockingFile cfg
|
||||
then addLink f k mic
|
||||
then addLink (fromRawFilePath f) k mic
|
||||
else do
|
||||
mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus (contentLocation source)
|
||||
stagePointerFile (toRawFilePath f) mode =<< hashPointerFile k
|
||||
mode <- liftIO $ catchMaybeIO $
|
||||
fileMode <$> R.getFileStatus (contentLocation source)
|
||||
stagePointerFile f mode =<< hashPointerFile k
|
||||
return (Just k)
|
||||
|
||||
{- Ingests a locked down file into the annex. Does not update the working
|
||||
|
@ -151,12 +155,15 @@ ingest' _ _ Nothing _ _ = return (Nothing, Nothing)
|
|||
ingest' preferredbackend meterupdate (Just (LockedDown cfg source)) mk restage = withTSDelta $ \delta -> do
|
||||
k <- case mk of
|
||||
Nothing -> do
|
||||
backend <- maybe (chooseBackend $ keyFilename source) (return . Just) preferredbackend
|
||||
backend <- maybe
|
||||
(chooseBackend $ fromRawFilePath $ keyFilename source)
|
||||
(return . Just)
|
||||
preferredbackend
|
||||
fmap fst <$> genKey source meterupdate backend
|
||||
Just k -> return (Just k)
|
||||
let src = contentLocation source
|
||||
ms <- liftIO $ catchMaybeIO $ getFileStatus src
|
||||
mcache <- maybe (pure Nothing) (liftIO . toInodeCache delta src) ms
|
||||
ms <- liftIO $ catchMaybeIO $ R.getFileStatus src
|
||||
mcache <- maybe (pure Nothing) (liftIO . toInodeCache delta (fromRawFilePath src)) ms
|
||||
case (mcache, inodeCache source) of
|
||||
(_, Nothing) -> go k mcache ms
|
||||
(Just newc, Just c) | compareStrong c newc -> go k mcache ms
|
||||
|
@ -168,12 +175,12 @@ ingest' preferredbackend meterupdate (Just (LockedDown cfg source)) mk restage =
|
|||
go _ _ _ = failure "failed to generate a key"
|
||||
|
||||
golocked key mcache s =
|
||||
tryNonAsync (moveAnnex key $ contentLocation source) >>= \case
|
||||
tryNonAsync (moveAnnex key $ fromRawFilePath $ contentLocation source) >>= \case
|
||||
Right True -> do
|
||||
populateAssociatedFiles key source restage
|
||||
success key mcache s
|
||||
Right False -> giveup "failed to add content to annex"
|
||||
Left e -> restoreFile (keyFilename source) key e
|
||||
Left e -> restoreFile (fromRawFilePath $ keyFilename source) key e
|
||||
|
||||
gounlocked key (Just cache) s = do
|
||||
-- Remove temp directory hard link first because
|
||||
|
@ -181,7 +188,7 @@ ingest' preferredbackend meterupdate (Just (LockedDown cfg source)) mk restage =
|
|||
-- already has a hard link.
|
||||
cleanCruft source
|
||||
cleanOldKeys (keyFilename source) key
|
||||
linkToAnnex key (keyFilename source) (Just cache) >>= \case
|
||||
linkToAnnex key (fromRawFilePath $ keyFilename source) (Just cache) >>= \case
|
||||
LinkAnnexFailed -> failure "failed to link to annex"
|
||||
_ -> do
|
||||
finishIngestUnlocked' key source restage
|
||||
|
@ -189,11 +196,11 @@ ingest' preferredbackend meterupdate (Just (LockedDown cfg source)) mk restage =
|
|||
gounlocked _ _ _ = failure "failed statting file"
|
||||
|
||||
success k mcache s = do
|
||||
genMetaData k (toRawFilePath (keyFilename source)) s
|
||||
genMetaData k (keyFilename source) s
|
||||
return (Just k, mcache)
|
||||
|
||||
failure msg = do
|
||||
warning $ keyFilename source ++ " " ++ msg
|
||||
warning $ fromRawFilePath (keyFilename source) ++ " " ++ msg
|
||||
cleanCruft source
|
||||
return (Nothing, Nothing)
|
||||
|
||||
|
@ -205,7 +212,7 @@ finishIngestUnlocked key source = do
|
|||
finishIngestUnlocked' :: Key -> KeySource -> Restage -> Annex ()
|
||||
finishIngestUnlocked' key source restage = do
|
||||
Database.Keys.addAssociatedFile key
|
||||
=<< inRepo (toTopFilePath (toRawFilePath (keyFilename source)))
|
||||
=<< inRepo (toTopFilePath (keyFilename source))
|
||||
populateAssociatedFiles key source restage
|
||||
|
||||
{- Copy to any other locations using the same key. -}
|
||||
|
@ -214,22 +221,22 @@ populateAssociatedFiles key source restage = do
|
|||
obj <- calcRepo (gitAnnexLocation key)
|
||||
g <- Annex.gitRepo
|
||||
ingestedf <- flip fromTopFilePath g
|
||||
<$> inRepo (toTopFilePath (toRawFilePath (keyFilename source)))
|
||||
<$> inRepo (toTopFilePath (keyFilename source))
|
||||
afs <- map (`fromTopFilePath` g) <$> Database.Keys.getAssociatedFiles key
|
||||
forM_ (filter (/= ingestedf) afs) $
|
||||
populatePointerFile restage key obj
|
||||
|
||||
cleanCruft :: KeySource -> Annex ()
|
||||
cleanCruft source = when (contentLocation source /= keyFilename source) $
|
||||
liftIO $ nukeFile $ contentLocation source
|
||||
liftIO $ nukeFile $ fromRawFilePath $ contentLocation source
|
||||
|
||||
-- If a worktree file was was hard linked to an annex object before,
|
||||
-- modifying the file would have caused the object to have the wrong
|
||||
-- content. Clean up from that.
|
||||
cleanOldKeys :: FilePath -> Key -> Annex ()
|
||||
cleanOldKeys :: RawFilePath -> Key -> Annex ()
|
||||
cleanOldKeys file newkey = do
|
||||
g <- Annex.gitRepo
|
||||
topf <- inRepo (toTopFilePath (toRawFilePath file))
|
||||
topf <- inRepo (toTopFilePath file)
|
||||
ingestedf <- fromRepo $ fromTopFilePath topf
|
||||
oldkeys <- filter (/= newkey)
|
||||
<$> Database.Keys.getAssociatedKey topf
|
||||
|
|
|
@ -286,9 +286,9 @@ handleAdds lockdowndir havelsof delayadd cs = returnWhen (null incomplete) $ do
|
|||
ks = keySource ld
|
||||
doadd = sanitycheck ks $ do
|
||||
(mkey, _mcache) <- liftAnnex $ do
|
||||
showStart "add" $ toRawFilePath $ keyFilename ks
|
||||
showStart "add" $ keyFilename ks
|
||||
ingest nullMeterUpdate (Just $ LockedDown lockdownconfig ks) Nothing
|
||||
maybe (failedingest change) (done change $ keyFilename ks) mkey
|
||||
maybe (failedingest change) (done change $ fromRawFilePath $ keyFilename ks) mkey
|
||||
add _ _ = return Nothing
|
||||
|
||||
{- Avoid overhead of re-injesting a renamed unlocked file, by
|
||||
|
@ -320,7 +320,7 @@ handleAdds lockdowndir havelsof delayadd cs = returnWhen (null incomplete) $ do
|
|||
fastadd change key = do
|
||||
let source = keySource $ lockedDown change
|
||||
liftAnnex $ finishIngestUnlocked key source
|
||||
done change (keyFilename source) key
|
||||
done change (fromRawFilePath $ keyFilename source) key
|
||||
|
||||
removedKeysMap :: InodeComparisonType -> [Change] -> Annex (M.Map InodeCacheKey Key)
|
||||
removedKeysMap ct l = do
|
||||
|
@ -347,14 +347,14 @@ handleAdds lockdowndir havelsof delayadd cs = returnWhen (null incomplete) $ do
|
|||
- and is still a hard link to its contentLocation,
|
||||
- before ingesting it. -}
|
||||
sanitycheck keysource a = do
|
||||
fs <- liftIO $ getSymbolicLinkStatus $ keyFilename keysource
|
||||
ks <- liftIO $ getSymbolicLinkStatus $ contentLocation keysource
|
||||
fs <- liftIO $ getSymbolicLinkStatus $ fromRawFilePath $ keyFilename keysource
|
||||
ks <- liftIO $ getSymbolicLinkStatus $ fromRawFilePath $ contentLocation keysource
|
||||
if deviceID ks == deviceID fs && fileID ks == fileID fs
|
||||
then a
|
||||
else do
|
||||
-- remove the hard link
|
||||
when (contentLocation keysource /= keyFilename keysource) $
|
||||
void $ liftIO $ tryIO $ removeFile $ contentLocation keysource
|
||||
void $ liftIO $ tryIO $ removeFile $ fromRawFilePath $ contentLocation keysource
|
||||
return Nothing
|
||||
|
||||
{- Shown an alert while performing an action to add a file or
|
||||
|
@ -400,7 +400,7 @@ safeToAdd lockdowndir lockdownconfig havelsof delayadd pending inprocess = do
|
|||
else return checked
|
||||
where
|
||||
check openfiles change@(InProcessAddChange { lockedDown = ld })
|
||||
| S.member (contentLocation (keySource ld)) openfiles = Left change
|
||||
| S.member (fromRawFilePath (contentLocation (keySource ld))) openfiles = Left change
|
||||
check _ change = Right change
|
||||
|
||||
mkinprocess (c, Just ld) = Just InProcessAddChange
|
||||
|
@ -411,11 +411,11 @@ safeToAdd lockdowndir lockdownconfig havelsof delayadd pending inprocess = do
|
|||
|
||||
canceladd (InProcessAddChange { lockedDown = ld }) = do
|
||||
let ks = keySource ld
|
||||
warning $ keyFilename ks
|
||||
warning $ fromRawFilePath (keyFilename ks)
|
||||
++ " still has writers, not adding"
|
||||
-- remove the hard link
|
||||
when (contentLocation ks /= keyFilename ks) $
|
||||
void $ liftIO $ tryIO $ removeFile $ contentLocation ks
|
||||
void $ liftIO $ tryIO $ removeFile $ fromRawFilePath $ contentLocation ks
|
||||
canceladd _ = noop
|
||||
|
||||
openwrite (_file, mode, _pid)
|
||||
|
@ -434,7 +434,8 @@ safeToAdd lockdowndir lockdownconfig havelsof delayadd pending inprocess = do
|
|||
-}
|
||||
findopenfiles keysources = ifM crippledFileSystem
|
||||
( liftIO $ do
|
||||
let segments = segmentXargsUnordered $ map keyFilename keysources
|
||||
let segments = segmentXargsUnordered $
|
||||
map (fromRawFilePath . keyFilename) keysources
|
||||
concat <$> forM segments (\fs -> Lsof.query $ "--" : fs)
|
||||
, liftIO $ Lsof.queryDir lockdowndir
|
||||
)
|
||||
|
|
|
@ -12,6 +12,7 @@ module Assistant.Types.Changes where
|
|||
import Types.KeySource
|
||||
import Types.Key
|
||||
import Utility.TList
|
||||
import Utility.FileSystemEncoding
|
||||
import Annex.Ingest
|
||||
|
||||
import Control.Concurrent.STM
|
||||
|
@ -57,7 +58,7 @@ changeInfoKey _ = Nothing
|
|||
changeFile :: Change -> FilePath
|
||||
changeFile (Change _ f _) = f
|
||||
changeFile (PendingAddChange _ f) = f
|
||||
changeFile (InProcessAddChange _ ld) = keyFilename $ keySource ld
|
||||
changeFile (InProcessAddChange _ ld) = fromRawFilePath $ keyFilename $ keySource ld
|
||||
|
||||
isPendingAddChange :: Change -> Bool
|
||||
isPendingAddChange (PendingAddChange {}) = True
|
||||
|
|
|
@ -90,7 +90,7 @@ hashKeyVariety (Blake2spHash size) he = Blake2spKey size he
|
|||
{- A key is a hash of its contents. -}
|
||||
keyValue :: Hash -> KeySource -> MeterUpdate -> Annex (Maybe Key)
|
||||
keyValue hash source meterupdate = do
|
||||
let file = contentLocation source
|
||||
let file = fromRawFilePath (contentLocation source)
|
||||
filesize <- liftIO $ getFileSize file
|
||||
s <- hashFile hash file meterupdate
|
||||
return $ Just $ mkKey $ \k -> k
|
||||
|
@ -106,7 +106,7 @@ keyValueE hash source meterupdate =
|
|||
where
|
||||
addE k = do
|
||||
maxlen <- annexMaxExtensionLength <$> Annex.getGitConfig
|
||||
let ext = selectExtension maxlen (toRawFilePath (keyFilename source))
|
||||
let ext = selectExtension maxlen (keyFilename source)
|
||||
return $ Just $ alterKey k $ \d -> d
|
||||
{ keyName = keyName d <> ext
|
||||
, keyVariety = hashKeyVariety hash (HasExt True)
|
||||
|
|
|
@ -16,6 +16,7 @@ import Git.FilePath
|
|||
import Utility.Metered
|
||||
|
||||
import qualified Data.ByteString.Char8 as S8
|
||||
import qualified Utility.RawFilePath as R
|
||||
|
||||
backends :: [Backend]
|
||||
backends = [backend]
|
||||
|
@ -36,10 +37,10 @@ backend = Backend
|
|||
keyValue :: KeySource -> MeterUpdate -> Annex (Maybe Key)
|
||||
keyValue source _ = do
|
||||
let f = contentLocation source
|
||||
stat <- liftIO $ getFileStatus f
|
||||
sz <- liftIO $ getFileSize' f stat
|
||||
stat <- liftIO $ R.getFileStatus f
|
||||
sz <- liftIO $ getFileSize' (fromRawFilePath f) stat
|
||||
relf <- fromRawFilePath . getTopFilePath
|
||||
<$> inRepo (toTopFilePath $ toRawFilePath $ keyFilename source)
|
||||
<$> inRepo (toTopFilePath $ keyFilename source)
|
||||
return $ Just $ mkKey $ \k -> k
|
||||
{ keyName = genKeyName relf
|
||||
, keyVariety = WORMKey
|
||||
|
|
|
@ -367,8 +367,8 @@ finishDownloadWith :: AddUnlockedMatcher -> FilePath -> UUID -> URLString -> Fil
|
|||
finishDownloadWith addunlockedmatcher tmp u url file = do
|
||||
backend <- chooseBackend file
|
||||
let source = KeySource
|
||||
{ keyFilename = file
|
||||
, contentLocation = tmp
|
||||
{ keyFilename = toRawFilePath file
|
||||
, contentLocation = toRawFilePath tmp
|
||||
, inodeCache = Nothing
|
||||
}
|
||||
genKey source nullMeterUpdate backend >>= \case
|
||||
|
|
|
@ -20,8 +20,11 @@ cmd = noCommit $ noMessages $ dontCheck repoExists $
|
|||
(batchable run (pure ()))
|
||||
|
||||
run :: () -> String -> Annex Bool
|
||||
run _ file = genKey (KeySource file file Nothing) nullMeterUpdate Nothing >>= \case
|
||||
run _ file = genKey ks nullMeterUpdate Nothing >>= \case
|
||||
Just (k, _) -> do
|
||||
liftIO $ putStrLn $ serializeKey k
|
||||
return True
|
||||
Nothing -> return False
|
||||
where
|
||||
ks = KeySource file' file' Nothing
|
||||
file' = toRawFilePath file
|
||||
|
|
|
@ -118,11 +118,13 @@ seek o@(RemoteImportOptions {}) = startConcurrency commandStages $ do
|
|||
startLocal :: AddUnlockedMatcher -> GetFileMatcher -> DuplicateMode -> (FilePath, FilePath) -> CommandStart
|
||||
startLocal addunlockedmatcher largematcher mode (srcfile, destfile) =
|
||||
ifM (liftIO $ isRegularFile <$> getSymbolicLinkStatus srcfile)
|
||||
( starting "import" (ActionItemWorkTreeFile (toRawFilePath destfile))
|
||||
( starting "import" (ActionItemWorkTreeFile destfile')
|
||||
pickaction
|
||||
, stop
|
||||
)
|
||||
where
|
||||
destfile' = toRawFilePath destfile
|
||||
|
||||
deletedup k = do
|
||||
showNote $ "duplicate of " ++ serializeKey k
|
||||
verifyExisting k destfile
|
||||
|
@ -182,7 +184,7 @@ startLocal addunlockedmatcher largematcher mode (srcfile, destfile) =
|
|||
-- weakly the same as the origianlly locked down file's
|
||||
-- inode cache. (Since the file may have been copied,
|
||||
-- its inodes may not be the same.)
|
||||
newcache <- withTSDelta $ liftIO . genInodeCache (toRawFilePath destfile)
|
||||
newcache <- withTSDelta $ liftIO . genInodeCache destfile'
|
||||
let unchanged = case (newcache, inodeCache (keySource ld)) of
|
||||
(_, Nothing) -> True
|
||||
(Just newc, Just c) | compareWeak c newc -> True
|
||||
|
@ -193,8 +195,8 @@ startLocal addunlockedmatcher largematcher mode (srcfile, destfile) =
|
|||
-- is what will be ingested.
|
||||
let ld' = ld
|
||||
{ keySource = KeySource
|
||||
{ keyFilename = destfile
|
||||
, contentLocation = destfile
|
||||
{ keyFilename = destfile'
|
||||
, contentLocation = destfile'
|
||||
, inodeCache = newcache
|
||||
}
|
||||
}
|
||||
|
@ -203,7 +205,7 @@ startLocal addunlockedmatcher largematcher mode (srcfile, destfile) =
|
|||
>>= maybe
|
||||
stop
|
||||
(\addedk -> next $ Command.Add.cleanup addedk True)
|
||||
, next $ Command.Add.addSmall $ toRawFilePath destfile
|
||||
, next $ Command.Add.addSmall destfile'
|
||||
)
|
||||
notoverwriting why = do
|
||||
warning $ "not overwriting existing " ++ destfile ++ " " ++ why
|
||||
|
|
|
@ -85,8 +85,8 @@ perform file oldkey oldbackend newbackend = go =<< genkey (fastMigrate oldbacken
|
|||
genkey Nothing = do
|
||||
content <- calcRepo $ gitAnnexLocation oldkey
|
||||
let source = KeySource
|
||||
{ keyFilename = fromRawFilePath file
|
||||
, contentLocation = fromRawFilePath content
|
||||
{ keyFilename = file
|
||||
, contentLocation = content
|
||||
, inodeCache = Nothing
|
||||
}
|
||||
v <- genKey source nullMeterUpdate (Just newbackend)
|
||||
|
|
|
@ -55,7 +55,7 @@ startSrcDest _ = giveup "specify a src file and a dest file"
|
|||
startKnown :: FilePath -> CommandStart
|
||||
startKnown src = notAnnexed src $
|
||||
starting "reinject" (ActionItemOther (Just src)) $ do
|
||||
mkb <- genKey (KeySource src src Nothing) nullMeterUpdate Nothing
|
||||
mkb <- genKey ks nullMeterUpdate Nothing
|
||||
case mkb of
|
||||
Nothing -> error "Failed to generate key"
|
||||
Just (key, _) -> ifM (isKnownKey key)
|
||||
|
@ -64,6 +64,9 @@ startKnown src = notAnnexed src $
|
|||
warning "Not known content; skipping"
|
||||
next $ return True
|
||||
)
|
||||
where
|
||||
ks = KeySource src' src' Nothing
|
||||
src' = toRawFilePath src
|
||||
|
||||
notAnnexed :: FilePath -> CommandStart -> CommandStart
|
||||
notAnnexed src a =
|
||||
|
|
|
@ -322,8 +322,8 @@ randKey sz = withTmpFile "randkey" $ \f h -> do
|
|||
Right (rand, _) -> liftIO $ B.hPut h rand
|
||||
liftIO $ hClose h
|
||||
let ks = KeySource
|
||||
{ keyFilename = f
|
||||
, contentLocation = f
|
||||
{ keyFilename = toRawFilePath f
|
||||
, contentLocation = toRawFilePath f
|
||||
, inodeCache = Nothing
|
||||
}
|
||||
k <- fromMaybe (error "failed to generate random key")
|
||||
|
|
|
@ -584,7 +584,7 @@ getKey b f = fromJust <$> annexeval go
|
|||
where
|
||||
go = Types.Backend.getKey b ks Utility.Metered.nullMeterUpdate
|
||||
ks = Types.KeySource.KeySource
|
||||
{ Types.KeySource.keyFilename = f
|
||||
, Types.KeySource.contentLocation = f
|
||||
{ Types.KeySource.keyFilename = toRawFilePath f
|
||||
, Types.KeySource.contentLocation = toRawFilePath f
|
||||
, Types.KeySource.inodeCache = Nothing
|
||||
}
|
||||
|
|
|
@ -8,6 +8,7 @@
|
|||
module Types.KeySource where
|
||||
|
||||
import Utility.InodeCache
|
||||
import System.FilePath.ByteString (RawFilePath)
|
||||
|
||||
{- When content is in the process of being ingested into the annex,
|
||||
- and a Key generated from it, this data type is used.
|
||||
|
@ -22,8 +23,8 @@ import Utility.InodeCache
|
|||
- files that may be made while they're in the process of being ingested.
|
||||
-}
|
||||
data KeySource = KeySource
|
||||
{ keyFilename :: FilePath
|
||||
, contentLocation :: FilePath
|
||||
{ keyFilename :: RawFilePath
|
||||
, contentLocation :: RawFilePath
|
||||
, inodeCache :: Maybe InodeCache
|
||||
}
|
||||
deriving (Show)
|
||||
|
|
Loading…
Reference in a new issue