mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

finish v6 support for assistant

Browse source 
Seems to basically work now!
This commit is contained in:
Joey Hess 2015-12-22 15:23:27 -04:00
parent 4392140946
commit 4f60234690
Failed to extract signature
4 changed files with 99 additions and 87 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

102
Annex/Ingest.hs
View file

@ -8,6 +8,7 @@
{-# LANGUAGE CPP #-}
module Annex.Ingest (
LockedDown(..),
lockDown,
ingest,
finishIngestDirect,
@ -33,7 +34,6 @@ import Annex.ReplaceFile
import Utility.Tmp
import Utility.CopyFile
import Annex.InodeSentinal
import Annex.Version
#ifdef WITH_CLIBS
#ifndef __ANDROID__
import Utility.Touch
@ -42,46 +42,42 @@ import Utility.Touch
import Control.Exception (IOException)
data LockedDown = LockedDown
{ lockingFile :: Bool
, keySource :: KeySource
}
deriving (Show)
{- The file that's being ingested is locked down before a key is generated,
- to prevent it from being modified in between. This lock down is not
- perfect at best (and pretty weak at worst). For example, it does not
- guard against files that are already opened for write by another process.
- So a KeySource is returned. Its inodeCache can be used to detect any
- changes that might be made to the file after it was locked down.
- So, the InodeCache can be used to detect any changes that might be made
- to the file after it was locked down.
-
- When possible, the file is hard linked to a temp directory. This guards
- against some changes, like deletion or overwrite of the file, and
- allows lsof checks to be done more efficiently when adding a lot of files.
-
- If the file is to be locked, lockingfile is True. Then the write
- bit is removed from the file as part of lock down to guard against
- further writes.
-
- Lockdown can fail if a file gets deleted, and Nothing will be returned.
-}
lockDown :: FilePath -> Annex (Maybe KeySource)
lockDown = either
lockDown :: Bool -> FilePath -> Annex (Maybe LockedDown)
lockDown lockingfile file = either
(\e -> warning (show e) >> return Nothing)
(return . Just)
<=< lockDown'
=<< lockDown' lockingfile file
lockDown' :: FilePath -> Annex (Either IOException KeySource)
lockDown' file = ifM crippledFileSystem
lockDown' :: Bool -> FilePath -> Annex (Either IOException LockedDown)
lockDown' lockingfile file = ifM crippledFileSystem
( withTSDelta $ liftIO . tryIO . nohardlink
, tryIO $ do
tmp <- fromRepo gitAnnexTmpMiscDir
createAnnexDirectory tmp
go tmp
)
where
{- In indirect mode, the write bit is removed from the file as part
- of lock down to guard against further writes, and because objects
- in the annex have their write bit disabled anyway.
-
- Freezing the content early also lets us fail early when
- someone else owns the file.
-
- This is not done in direct mode, because files there need to
- remain writable at all times.
-}
go tmp = do
unlessM isDirect $
when lockingfile $
freezeContent file
withTSDelta $ \delta -> liftIO $ do
(tmpfile, h) <- openTempFile tmp $
@ -89,9 +85,11 @@ lockDown' file = ifM crippledFileSystem
hClose h
nukeFile tmpfile
withhardlink delta tmpfile `catchIO` const (nohardlink delta)
)
where
nohardlink delta = do
cache <- genInodeCache file delta
return KeySource
return $ LockedDown lockingfile $ KeySource
{ keyFilename = file
, contentLocation = file
, inodeCache = cache
@ -99,7 +97,7 @@ lockDown' file = ifM crippledFileSystem
withhardlink delta tmpfile = do
createLink file tmpfile
cache <- genInodeCache tmpfile delta
return KeySource
return $ LockedDown lockingfile $ KeySource
{ keyFilename = file
, contentLocation = tmpfile
, inodeCache = cache
@ -107,12 +105,13 @@ lockDown' file = ifM crippledFileSystem
{- Ingests a locked down file into the annex.
-
- In direct mode, leaves the file alone, and just updates bookkeeping
- information.
- The file may be added to the git repository as a locked or an unlocked
- file. When unlocked, the work tree file is left alone. When locked,
- the work tree file is deleted, in preparation for adding the symlink.
-}
ingest :: Maybe KeySource -> Annex (Maybe Key, Maybe InodeCache)
ingest :: Maybe LockedDown -> Annex (Maybe Key, Maybe InodeCache)
ingest Nothing = return (Nothing, Nothing)
ingest (Just source) = withTSDelta $ \delta -> do
ingest (Just (LockedDown lockingfile source)) = withTSDelta $ \delta -> do
backend <- chooseBackend $ keyFilename source
k <- genKey source backend
let src = contentLocation source
@ -123,43 +122,56 @@ ingest (Just source) = withTSDelta $ \delta -> do
(Just newc, Just c) | compareStrong c newc -> go k mcache ms
_ -> failure "changed while it was being added"
where
go k mcache ms = ifM isDirect
( godirect k mcache ms
, goindirect k mcache ms
)
go (Just (key, _)) mcache (Just s)
| lockingfile = golocked key mcache s
| otherwise = ifM isDirect
( godirect key mcache s
, gounlocked key mcache s
)
go _ _ _ = failure "failed to generate a key"
goindirect (Just (key, _)) mcache ms = do
golocked key mcache s = do
catchNonAsync (moveAnnex key $ contentLocation source)
(restoreFile (keyFilename source) key)
maybe noop (genMetaData key (keyFilename source)) ms
liftIO $ nukeFile $ keyFilename source
return (Just key, mcache)
goindirect _ _ _ = failure "failed to generate a key"
success key mcache s
godirect (Just (key, _)) (Just cache) ms = do
gounlocked key (Just cache) s = do
r <- linkAnnex key (keyFilename source) (Just cache)
case r of
LinkAnnexFailed -> failure "failed to link to annex"
_ -> success key (Just cache) s
gounlocked _ _ _ = failure "failed statting file"
godirect key (Just cache) s = do
addInodeCache key cache
maybe noop (genMetaData key (keyFilename source)) ms
finishIngestDirect key source
return (Just key, Just cache)
godirect _ _ _ = failure "failed to generate a key"
success key (Just cache) s
godirect _ _ _ = failure "failed statting file"
success k mcache s = do
genMetaData k (keyFilename source) s
return (Just k, mcache)
failure msg = do
warning $ keyFilename source ++ " " ++ msg
when (contentLocation source /= keyFilename source) $
liftIO $ nukeFile $ contentLocation source
cleanCruft source
return (Nothing, Nothing)
finishIngestDirect :: Key -> KeySource -> Annex ()
finishIngestDirect key source = do
void $ addAssociatedFile key $ keyFilename source
when (contentLocation source /= keyFilename source) $
liftIO $ nukeFile $ contentLocation source
cleanCruft source
{- Copy to any other locations using the same key. -}
otherfs <- filter (/= keyFilename source) <$> associatedFiles key
forM_ otherfs $
addContentWhenNotPresent key (keyFilename source)
cleanCruft :: KeySource -> Annex ()
cleanCruft source = when (contentLocation source /= keyFilename source) $
liftIO $ nukeFile $ contentLocation source
{- On error, put the file back so it doesn't seem to have vanished.
- This can be called before or after the symlink is in place. -}
restoreFile :: FilePath -> Key -> SomeException -> Annex a

67
Assistant/Threads/Committer.hs
View file

@ -266,10 +266,12 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do
let (pending, inprocess) = partition isPendingAddChange incomplete
direct <- liftAnnex isDirect
unlocked <- liftAnnex versionSupportsUnlockedPointers
let lockingfiles = not (unlocked || direct)
(pending', cleanup) <- if unlocked || direct
then return (pending, noop)
else findnew pending
(postponed, toadd) <- partitionEithers <$> safeToAdd havelsof delayadd pending' inprocess
(postponed, toadd) <- partitionEithers
<$> safeToAdd lockingfiles havelsof delayadd pending' inprocess
cleanup
unless (null postponed) $
@ -278,9 +280,9 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do
returnWhen (null toadd) $ do
added <- addaction toadd $
catMaybes <$>
if unlocked || direct
if not lockingfiles
then addunlocked direct toadd
else forM toadd add
else forM toadd (add lockingfiles)
if DirWatcher.eventsCoalesce || null added || unlocked || direct
then return $ added ++ otherchanges
else do
@ -307,16 +309,17 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do
| c = return otherchanges
| otherwise = a
add :: Change -> Assistant (Maybe Change)
add change@(InProcessAddChange { keySource = ks }) =
add :: Bool -> Change -> Assistant (Maybe Change)
add lockingfile change@(InProcessAddChange { lockedDown = ld }) =
catchDefaultIO Nothing <~> doadd
where
ks = keySource ld
doadd = sanitycheck ks $ do
(mkey, mcache) <- liftAnnex $ do
showStart "add" $ keyFilename ks
ingest $ Just ks
ingest $ Just $ LockedDown lockingfile ks
maybe (failedingest change) (done change mcache $ keyFilename ks) mkey
add _ = return Nothing
add _ _ = return Nothing
{- Avoid overhead of re-injesting a renamed unlocked file, by
- examining the other Changes to see if a removed file has the
@ -329,29 +332,22 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do
m <- liftAnnex $ removedKeysMap isdirect ct cs
delta <- liftAnnex getTSDelta
if M.null m
then forM toadd add
then forM toadd (add False)
else forM toadd $ \c -> do
mcache <- liftIO $ genInodeCache (changeFile c) delta
case mcache of
Nothing -> add c
Nothing -> add False c
Just cache ->
case M.lookup (inodeCacheToKey ct cache) m of
Nothing -> add c
Just k -> if isdirect
then fastadddirect c k
else fastaddunlocked c k
Nothing -> add False c
Just k -> fastadd isdirect c k
fastadddirect :: Change -> Key -> Assistant (Maybe Change)
fastadddirect change key = do
let source = keySource change
liftAnnex $ finishIngestDirect key source
done change Nothing (keyFilename source) key
fastaddunlocked :: Change -> Key -> Assistant (Maybe Change)
fastaddunlocked change key = do
let source = keySource change
liftAnnex $ do
Database.Keys.addAssociatedFile key (keyFilename source)
fastadd :: Bool -> Change -> Key -> Assistant (Maybe Change)
fastadd isdirect change key = do
let source = keySource $ lockedDown change
liftAnnex $ if isdirect
then finishIngestDirect key source
else Database.Keys.addAssociatedFile key (keyFilename source)
done change Nothing (keyFilename source) key
removedKeysMap :: Bool -> InodeComparisonType -> [Change] -> Annex (M.Map InodeCacheKey Key)
@ -419,16 +415,16 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do
-
- Check by running lsof on the repository.
-}
safeToAdd :: Bool -> Maybe Seconds -> [Change] -> [Change] -> Assistant [Either Change Change]
safeToAdd _ _ [] [] = return []
safeToAdd havelsof delayadd pending inprocess = do
safeToAdd :: Bool -> Bool -> Maybe Seconds -> [Change] -> [Change] -> Assistant [Either Change Change]
safeToAdd _ _ _ [] [] = return []
safeToAdd lockingfiles havelsof delayadd pending inprocess = do
maybe noop (liftIO . threadDelaySeconds) delayadd
liftAnnex $ do
keysources <- forM pending $ lockDown . changeFile
let inprocess' = inprocess ++ mapMaybe mkinprocess (zip pending keysources)
lockeddown <- forM pending $ lockDown lockingfiles . changeFile
let inprocess' = inprocess ++ mapMaybe mkinprocess (zip pending lockeddown)
openfiles <- if havelsof
then S.fromList . map fst3 . filter openwrite <$>
findopenfiles (map keySource inprocess')
findopenfiles (map (keySource . lockedDown) inprocess')
else pure S.empty
let checked = map (check openfiles) inprocess'
@ -441,17 +437,18 @@ safeToAdd havelsof delayadd pending inprocess = do
allRight $ rights checked
else return checked
where
check openfiles change@(InProcessAddChange { keySource = ks })
| S.member (contentLocation ks) openfiles = Left change
check openfiles change@(InProcessAddChange { lockedDown = ld })
| S.member (contentLocation (keySource ld)) openfiles = Left change
check _ change = Right change
mkinprocess (c, Just ks) = Just InProcessAddChange
mkinprocess (c, Just ld) = Just InProcessAddChange
{ changeTime = changeTime c
, keySource = ks
, lockedDown = ld
}
mkinprocess (_, Nothing) = Nothing
canceladd (InProcessAddChange { keySource = ks }) = do
canceladd (InProcessAddChange { lockedDown = ld }) = do
let ks = keySource ld
warning $ keyFilename ks
++ " still has writers, not adding"
-- remove the hard link

13
Assistant/Types/Changes.hs
View file

@ -10,6 +10,7 @@ module Assistant.Types.Changes where
import Types.KeySource
import Types.Key
import Utility.TList
import Annex.Ingest
import Control.Concurrent.STM
import Data.Time.Clock
@ -38,7 +39,7 @@ data Change
}
| InProcessAddChange
{ changeTime ::UTCTime
, keySource :: KeySource
, lockedDown :: LockedDown
}
deriving (Show)
@ -53,7 +54,7 @@ changeInfoKey _ = Nothing
changeFile :: Change -> FilePath
changeFile (Change _ f _) = f
changeFile (PendingAddChange _ f) = f
changeFile (InProcessAddChange _ ks) = keyFilename ks
changeFile (InProcessAddChange _ ld) = keyFilename $ keySource ld
isPendingAddChange :: Change -> Bool
isPendingAddChange (PendingAddChange {}) = True
@ -64,14 +65,14 @@ isInProcessAddChange (InProcessAddChange {}) = True
isInProcessAddChange _ = False
retryChange :: Change -> Change
retryChange (InProcessAddChange time ks) =
PendingAddChange time (keyFilename ks)
retryChange c@(InProcessAddChange time _) =
PendingAddChange time $ changeFile c
retryChange c = c
finishedChange :: Change -> Key -> Change
finishedChange c@(InProcessAddChange { keySource = ks }) k = Change
finishedChange c@(InProcessAddChange {}) k = Change
{ changeTime = changeTime c
, _changeFile = keyFilename ks
, _changeFile = changeFile c
, changeInfo = AddKeyChange k
}
finishedChange c _ = c

4
Command/Add.hs
View file

@ -113,7 +113,9 @@ start file = ifAnnexed file addpresent add
next $ next $ cleanup file key Nothing =<< inAnnex key
perform :: FilePath -> CommandPerform
perform file = lockDown file >>= ingest >>= go
perform file = do
lockingfile <- not <$> isDirect
lockDown lockingfile file >>= ingest >>= go
where
go (Just key, cache) = next $ cleanup file key cache True
go (Nothing, _) = stop