diff options
| -rw-r--r-- | Assistant/Committer.hs | 65 |
1 files changed, 51 insertions, 14 deletions
diff --git a/Assistant/Committer.hs b/Assistant/Committer.hs index 1348456cc..a2b65dae5 100644 --- a/Assistant/Committer.hs +++ b/Assistant/Committer.hs @@ -11,9 +11,13 @@ import qualified Annex.Queue import qualified Git.Command import qualified Command.Add import Utility.ThreadScheduler +import qualified Utility.Lsof as Lsof +import Types.Backend import Control.Concurrent.STM import Data.Time.Clock +import Data.Tuple.Utils +import qualified Data.Set as S data ChangeType = PendingAddChange | LinkChange | RmChange | RmDirChange deriving (Show, Eq) @@ -123,26 +127,21 @@ handleAdds :: ThreadState -> ChangeChan -> [Change] -> IO () handleAdds st changechan cs | null toadd = noop | otherwise = do - added <- filter id <$> forM toadd go - unless (null added) $ - handleAdds st changechan =<< getChanges changechan + toadd' <- safeToAdd st toadd + unless (null toadd') $ do + added <- filter id <$> forM toadd' add + unless (null added) $ + handleAdds st changechan =<< getChanges changechan where toadd = map changeFile $ filter isPendingAdd cs isPendingAdd (Change { changeType = PendingAddChange }) = True isPendingAdd _ = False - go file = do - ms <- catchMaybeIO $ getSymbolicLinkStatus file - case ms of - Just s - | isRegularFile s -> catchBoolIO $ - runThreadState st $ add file - _ -> return False - - add file = do - showStart "add" file - handle file =<< Command.Add.ingest file + add keysource = catchBoolIO $ runThreadState st $ do + showStart "add" $ keyFilename keysource + handle (keyFilename keysource) + =<< Command.Add.ingest keysource handle _ Nothing = do showEndFail @@ -151,3 +150,41 @@ handleAdds st changechan cs Command.Add.link file key True showEndOk return True + +{- Checks which of a set of files can safely be added. + - Files are locked down as hard links in a temp directory, + - with their write bits disabled. But some may have already + - been opened for write, so lsof is run on the temp directory + - to check them. + -} +safeToAdd :: ThreadState -> [FilePath] -> IO [KeySource] +safeToAdd st files = do + locked <- catMaybes <$> lockdown files + runThreadState st $ do + tmpdir <- fromRepo gitAnnexTmpDir + open <- S.fromList . map fst3 . filter openwrite <$> + liftIO (Lsof.queryDir tmpdir) + catMaybes <$> forM locked (go open) + where + go open keysource + | S.member (contentLocation keysource) open = do + warning $ keyFilename keysource + ++ " still has writers, not adding" + -- remove the hard link + --_ <- liftIO $ tryIO $ + -- removeFile $ contentLocation keysource + return Nothing + | otherwise = return $ Just keysource + + lockdown = mapM $ \file -> do + ms <- catchMaybeIO $ getSymbolicLinkStatus file + case ms of + Just s + | isRegularFile s -> + catchMaybeIO $ runThreadState st $ + Command.Add.lockDown file + _ -> return Nothing + + + openwrite (_file, mode, _pid) = + mode == Lsof.OpenWriteOnly || mode == Lsof.OpenReadWrite |