diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs index f2a624987b..a06bc9cd6d 100644 --- a/Annex/AdjustedBranch.hs +++ b/Annex/AdjustedBranch.hs @@ -55,7 +55,7 @@ import Annex.CatFile import Annex.Link import Annex.AutoMerge import Annex.Content -import Annex.Perms +import Annex.Tmp import Annex.GitOverlay import Utility.Tmp.Dir import Utility.CopyFile @@ -356,12 +356,10 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm - (Doing the merge this way also lets it run even though the main - index file is currently locked.) -} - changestomerge (Just updatedorig) = do - misctmpdir <- fromRepo gitAnnexTmpMiscDir - void $ createAnnexDirectory misctmpdir + changestomerge (Just updatedorig) = withOtherTmp $ \othertmpdir -> do tmpwt <- fromRepo gitAnnexMergeDir git_dir <- fromRepo Git.localGitDir - withTmpDirIn misctmpdir "git" $ \tmpgit -> withWorkTreeRelated tmpgit $ + withTmpDirIn othertmpdir "git" $ \tmpgit -> withWorkTreeRelated tmpgit $ withemptydir tmpwt $ withWorkTree tmpwt $ do liftIO $ writeFile (tmpgit "HEAD") (fromRef updatedorig) -- Copy in refs and packed-refs, to work diff --git a/Annex/Branch.hs b/Annex/Branch.hs index ef2a5d8536..5690429964 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -41,6 +41,7 @@ import Annex.Common import Annex.BranchState import Annex.Journal import Annex.GitOverlay +import Annex.Tmp import qualified Git import qualified Git.Command import qualified Git.Ref @@ -488,9 +489,7 @@ stageJournal jl = withIndex $ do mapM_ (removeFile . (dir )) stagedfs hClose jlogh nukeFile jlogf - openjlog = do - tmpdir <- fromRepo gitAnnexTmpMiscDir - createAnnexDirectory tmpdir + openjlog = withOtherTmp $ \tmpdir -> liftIO $ openTempFile tmpdir "jlog" {- This is run after the refs have been merged into the index, diff --git a/Annex/Ingest.hs b/Annex/Ingest.hs index 012c37d200..f3f925a496 100644 --- a/Annex/Ingest.hs +++ b/Annex/Ingest.hs @@ -30,6 +30,7 @@ import Backend import Annex.Content import Annex.Content.Direct import Annex.Perms +import Annex.Tmp import Annex.Link import Annex.MetaData import Annex.CurrentBranch @@ -84,14 +85,12 @@ lockDown cfg file = either lockDown' :: LockDownConfig -> FilePath -> Annex (Either IOException LockedDown) lockDown' cfg file = ifM (pure (not (hardlinkFileTmp cfg)) <||> crippledFileSystem) ( withTSDelta $ liftIO . tryIO . nohardlink - , tryIO $ do - tmp <- fromRepo gitAnnexTmpMiscDir - createAnnexDirectory tmp + , tryIO $ withOtherTmp $ \tmp -> do when (lockingFile cfg) $ freezeContent file withTSDelta $ \delta -> liftIO $ do (tmpfile, h) <- openTempFile tmp $ - relatedTemplate $ takeFileName file + relatedTemplate $ "ingest-" ++ takeFileName file hClose h nukeFile tmpfile withhardlink delta tmpfile `catchIO` const (nohardlink delta) diff --git a/Annex/Init.hs b/Annex/Init.hs index cb3dfd1c05..59c4ffdae6 100644 --- a/Annex/Init.hs +++ b/Annex/Init.hs @@ -44,6 +44,7 @@ import Annex.Hook import Annex.InodeSentinal import Upgrade import Annex.Perms +import Annex.Tmp import Utility.UserInfo #ifndef mingw32_HOST_OS import Utility.FileMode @@ -163,9 +164,7 @@ isInitialized = maybe Annex.Branch.hasSibling (const $ return True) =<< getVersi {- A crippled filesystem is one that does not allow making symlinks, - or removing write access from files. -} probeCrippledFileSystem :: Annex Bool -probeCrippledFileSystem = do - tmp <- fromRepo gitAnnexTmpMiscDir - createAnnexDirectory tmp +probeCrippledFileSystem = withOtherTmp $ \tmp -> do (r, warnings) <- liftIO $ probeCrippledFileSystem' tmp mapM_ warning warnings return r @@ -222,17 +221,16 @@ probeLockSupport = do #ifdef mingw32_HOST_OS return True #else - tmp <- fromRepo gitAnnexTmpMiscDir - let f = tmp "lockprobe" - createAnnexDirectory tmp - mode <- annexFileMode - liftIO $ do - nukeFile f - ok <- catchBoolIO $ do - Posix.dropLock =<< Posix.lockExclusive (Just mode) f - return True - nukeFile f - return ok + withOtherTmp $ \tmp -> do + let f = tmp "lockprobe" + mode <- annexFileMode + liftIO $ do + nukeFile f + ok <- catchBoolIO $ do + Posix.dropLock =<< Posix.lockExclusive (Just mode) f + return True + nukeFile f + return ok #endif probeFifoSupport :: Annex Bool @@ -240,20 +238,19 @@ probeFifoSupport = do #ifdef mingw32_HOST_OS return False #else - tmp <- fromRepo gitAnnexTmpMiscDir - let f = tmp "gaprobe" - let f2 = tmp "gaprobe2" - createAnnexDirectory tmp - liftIO $ do - nukeFile f - nukeFile f2 - ms <- tryIO $ do - createNamedPipe f ownerReadMode - createLink f f2 - getFileStatus f - nukeFile f - nukeFile f2 - return $ either (const False) isNamedPipe ms + withOtherTmp $ \tmp -> do + let f = tmp "gaprobe" + let f2 = tmp "gaprobe2" + liftIO $ do + nukeFile f + nukeFile f2 + ms <- tryIO $ do + createNamedPipe f ownerReadMode + createLink f f2 + getFileStatus f + nukeFile f + nukeFile f2 + return $ either (const False) isNamedPipe ms #endif checkLockSupport :: Annex () diff --git a/Annex/Journal.hs b/Annex/Journal.hs index 934b1249c5..7ba72755ac 100644 --- a/Annex/Journal.hs +++ b/Annex/Journal.hs @@ -14,6 +14,7 @@ module Annex.Journal where import Annex.Common import qualified Git import Annex.Perms +import Annex.Tmp import Annex.LockFile import Utility.Directory.Stream @@ -44,10 +45,8 @@ instance Journalable Builder where - content, although possibly not the most current one. -} setJournalFile :: Journalable content => JournalLocked -> FilePath -> content -> Annex () -setJournalFile _jl file content = do - tmp <- fromRepo gitAnnexTmpMiscDir +setJournalFile _jl file content = withOtherTmp $ \tmp -> do createAnnexDirectory =<< fromRepo gitAnnexJournalDir - createAnnexDirectory tmp -- journal file is written atomically jfile <- fromRepo $ journalFile file let tmpfile = tmp takeFileName jfile diff --git a/Annex/Locations.hs b/Annex/Locations.hs index 9d6f1fe7d2..ad75271869 100644 --- a/Annex/Locations.hs +++ b/Annex/Locations.hs @@ -28,7 +28,9 @@ module Annex.Locations ( annexLocations, gitAnnexDir, gitAnnexObjectDir, - gitAnnexTmpMiscDir, + gitAnnexTmpOtherDir, + gitAnnexTmpOtherLock, + gitAnnexTmpOtherDirOld, gitAnnexTmpObjectDir, gitAnnexTmpObjectLocation, gitAnnexTmpWorkDir, @@ -246,14 +248,22 @@ gitAnnexDir r = addTrailingPathSeparator $ Git.localGitDir r annexDir gitAnnexObjectDir :: Git.Repo -> FilePath gitAnnexObjectDir r = addTrailingPathSeparator $ Git.localGitDir r objectDir -{- .git/annex/misctmp/ is used for random temp files -} -gitAnnexTmpMiscDir :: Git.Repo -> FilePath -gitAnnexTmpMiscDir r = addTrailingPathSeparator $ gitAnnexDir r "misctmp" - {- .git/annex/tmp/ is used for temp files for key's contents -} gitAnnexTmpObjectDir :: Git.Repo -> FilePath gitAnnexTmpObjectDir r = addTrailingPathSeparator $ gitAnnexDir r "tmp" +{- .git/annex/othertmp/ is used for other temp files -} +gitAnnexTmpOtherDir :: Git.Repo -> FilePath +gitAnnexTmpOtherDir r = addTrailingPathSeparator $ gitAnnexDir r "othertmp" + +{- Lock file for gitAnnexTmpOtherDir. -} +gitAnnexTmpOtherLock :: Git.Repo -> FilePath +gitAnnexTmpOtherLock r = gitAnnexDir r "othertmp.lck" + +{- Directory used by old versions of git-annex. -} +gitAnnexTmpOtherDirOld :: Git.Repo -> FilePath +gitAnnexTmpOtherDirOld r = addTrailingPathSeparator $ gitAnnexDir r "misctmp" + {- The temp file to use for a given key's content. -} gitAnnexTmpObjectLocation :: Key -> Git.Repo -> FilePath gitAnnexTmpObjectLocation key r = gitAnnexTmpObjectDir r keyFile key diff --git a/Annex/LockFile.hs b/Annex/LockFile.hs index bda1a3e8a2..66a53ebb82 100644 --- a/Annex/LockFile.hs +++ b/Annex/LockFile.hs @@ -1,6 +1,6 @@ {- git-annex lock files. - - - Copyright 2012-2015 Joey Hess + - Copyright 2012-2019 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -12,6 +12,7 @@ module Annex.LockFile ( unlockFile, getLockCache, fromLockCache, + withSharedLock, withExclusiveLock, tryExclusiveLock, ) where @@ -58,6 +59,21 @@ changeLockCache a = do m <- getLockCache changeState $ \s -> s { lockcache = a m } +{- Runs an action with a shared lock held. If an exclusive lock is held, + - blocks until it becomes free. -} +withSharedLock :: (Git.Repo -> FilePath) -> Annex a -> Annex a +withSharedLock getlockfile a = debugLocks $ do + lockfile <- fromRepo getlockfile + createAnnexDirectory $ takeDirectory lockfile + mode <- annexFileMode + bracket (lock mode lockfile) (liftIO . dropLock) (const a) + where +#ifndef mingw32_HOST_OS + lock mode = noUmask mode . lockShared (Just mode) +#else + lock _mode = liftIO . waitToLock . lockShared +#endif + {- Runs an action with an exclusive lock held. If the lock is already - held, blocks until it becomes free. -} withExclusiveLock :: (Git.Repo -> FilePath) -> Annex a -> Annex a diff --git a/Annex/ReplaceFile.hs b/Annex/ReplaceFile.hs index be12cbbb08..828f9b80ad 100644 --- a/Annex/ReplaceFile.hs +++ b/Annex/ReplaceFile.hs @@ -10,7 +10,7 @@ module Annex.ReplaceFile where import Annex.Common -import Annex.Perms +import Annex.Tmp import Utility.Tmp.Dir import Utility.Path.Max @@ -27,21 +27,19 @@ import Utility.Path.Max - Throws an IO exception when it was unable to replace the file. -} replaceFile :: FilePath -> (FilePath -> Annex a) -> Annex a -replaceFile file action = do - misctmpdir <- fromRepo gitAnnexTmpMiscDir - void $ createAnnexDirectory misctmpdir +replaceFile file action = withOtherTmp $ \othertmpdir -> do #ifndef mingw32_HOST_OS -- Use part of the filename as the template for the temp -- directory. This does not need to be unique, but it -- makes it more clear what this temp directory is for. - filemax <- liftIO $ fileNameLengthLimit misctmpdir + filemax <- liftIO $ fileNameLengthLimit othertmpdir let basetmp = take (filemax `div` 2) (takeFileName file) #else -- Windows has limits on the whole path length, so keep -- it short. let basetmp = "t" #endif - withTmpDirIn misctmpdir basetmp $ \tmpdir -> do + withTmpDirIn othertmpdir basetmp $ \tmpdir -> do let tmpfile = tmpdir basetmp r <- action tmpfile liftIO $ replaceFileFrom tmpfile file diff --git a/Annex/Tmp.hs b/Annex/Tmp.hs new file mode 100644 index 0000000000..d3a191f2dd --- /dev/null +++ b/Annex/Tmp.hs @@ -0,0 +1,56 @@ +{- git-annex tmp files + - + - Copyright 2019 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Annex.Tmp where + +import Common +import Annex +import Annex.Locations +import Annex.LockFile +import Annex.Perms +import Types.CleanupActions + +import Data.Time.Clock.POSIX + +-- | For creation of tmp files, other than for key's contents. +-- +-- The action should normally clean up whatever files it writes to the temp +-- directory that is passed to it. However, once the action is done, +-- any files left in that directory may be cleaned up by another process at +-- any time. +withOtherTmp :: (FilePath -> Annex a) -> Annex a +withOtherTmp a = do + addCleanup OtherTmpCleanup cleanupOtherTmp + tmpdir <- fromRepo gitAnnexTmpOtherDir + tmplck <- fromRepo gitAnnexTmpOtherLock + void $ createAnnexDirectory tmpdir + withSharedLock (const tmplck) (a tmpdir) + +-- | Cleans up any tmp files that were left by a previous +-- git-annex process that got interrupted or failed to clean up after +-- itself for some other reason. +-- +-- Does not do anything if withOtherTmp is running. +cleanupOtherTmp :: Annex () +cleanupOtherTmp = do + tmplck <- fromRepo gitAnnexTmpOtherLock + void $ tryIO $ tryExclusiveLock (const tmplck) $ do + tmpdir <- fromRepo gitAnnexTmpOtherDir + void $ liftIO $ tryIO $ removeDirectoryRecursive tmpdir + -- This is only to clean up cruft left by old versions of + -- git-annex; it can be removed eventually. + oldtmp <- fromRepo gitAnnexTmpOtherDirOld + liftIO $ mapM_ cleanold =<< dirContentsRecursive oldtmp + liftIO $ void $ tryIO $ removeDirectory oldtmp -- when empty + where + cleanold f = do + now <- liftIO getPOSIXTime + let oldenough = now - (60 * 60 * 24 * 7) + catchMaybeIO (modificationTime <$> getSymbolicLinkStatus f) >>= \case + Just mtime | realToFrac mtime <= oldenough -> + void $ tryIO $ nukeFile f + _ -> return () diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs index 1605ff6d0e..a3283714b4 100644 --- a/Assistant/Threads/Committer.hs +++ b/Assistant/Threads/Committer.hs @@ -29,6 +29,7 @@ import Config import Annex.Content import Annex.Ingest import Annex.Link +import Annex.Tmp import Annex.CatFile import Annex.InodeSentinal import Annex.Version @@ -487,9 +488,7 @@ safeToAdd lockdownconfig havelsof delayadd pending inprocess = do ( liftIO $ do let segments = segmentXargsUnordered $ map keyFilename keysources concat <$> forM segments (\fs -> Lsof.query $ "--" : fs) - , do - tmpdir <- fromRepo gitAnnexTmpMiscDir - liftIO $ Lsof.queryDir tmpdir + , withOtherTmp $ liftIO . Lsof.queryDir ) {- After a Change is committed, queue any necessary transfers or drops diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs index 893c700f86..fe93b2e6ef 100644 --- a/Assistant/Threads/SanityChecker.hs +++ b/Assistant/Threads/SanityChecker.hs @@ -40,8 +40,8 @@ import Git.Index import Assistant.Unused import Logs.Unused import Types.Transfer -import Types.Key import Annex.Path +import Annex.Tmp import qualified Annex #ifdef WITH_WEBAPP import Assistant.WebApp.Types @@ -53,7 +53,6 @@ import Utility.DiskFree import Data.Time.Clock.POSIX import qualified Data.Text as T -import qualified Data.ByteString as S {- This thread runs once at startup, and most other threads wait for it - to finish. (However, the webapp thread does not, to prevent the UI @@ -88,9 +87,7 @@ sanityCheckerStartupThread startupdelay = namedThreadUnchecked "SanityCheckerSta liftIO $ fixUpSshRemotes {- Clean up old temp files. -} - void $ liftAnnex $ tryNonAsync $ do - cleanOldTmpMisc - cleanReallyOldTmp + void $ liftAnnex $ tryNonAsync $ cleanupOtherTmp {- If there's a startup delay, it's done here. -} liftIO $ maybe noop (threadDelaySeconds . Seconds . fromIntegral . durationSeconds) startupdelay @@ -270,58 +267,6 @@ checkOldUnused urlrenderer = go =<< annexExpireUnused <$> liftAnnex Annex.getGit debug [show $ renderTense Past msg] #endif -{- Files may be left in misctmp by eg, an interrupted add of files - - by the assistant, which hard links files to there as part of lockdown - - checks. Delete these files if they're more than a day old. - - - - Note that this is not safe to run after the Watcher starts up, since it - - will create such files, and due to hard linking they may have old - - mtimes. So, this should only be called from the - - sanityCheckerStartupThread, which runs before the Watcher starts up. - - - - Also, if a git-annex add is being run at the same time the assistant - - starts up, its tmp files could be deleted. However, the watcher will - - come along and add everything once it starts up anyway, so at worst - - this would make the git-annex add fail unexpectedly. - -} -cleanOldTmpMisc :: Annex () -cleanOldTmpMisc = do - now <- liftIO getPOSIXTime - let oldenough = now - (60 * 60 * 24) - tmp <- fromRepo gitAnnexTmpMiscDir - liftIO $ mapM_ (cleanOld (<= oldenough)) =<< dirContentsRecursive tmp - -{- While .git/annex/tmp is now only used for storing partially transferred - - objects, older versions of git-annex used it for misctemp. Clean up any - - files that might be left from that, by looking for files whose names - - cannot be the key of an annexed object. Only delete files older than - - 1 week old. - - - - Also, some remotes such as rsync may use this temp directory for storing - - eg, encrypted objects that are being transferred. So, delete old - - objects that use a GPGHMAC backend. - -} -cleanReallyOldTmp :: Annex () -cleanReallyOldTmp = do - now <- liftIO getPOSIXTime - let oldenough = now - (60 * 60 * 24 * 7) - tmp <- fromRepo gitAnnexTmpObjectDir - liftIO $ mapM_ (cleanjunk (<= oldenough)) =<< dirContentsRecursive tmp - where - cleanjunk check f = case fileKey (takeFileName f) of - Nothing -> cleanOld check f - Just k - | "GPGHMAC" `S.isPrefixOf` formatKeyVariety (keyVariety k) -> - cleanOld check f - | otherwise -> noop - -cleanOld :: (POSIXTime -> Bool) -> FilePath -> IO () -cleanOld check f = go =<< catchMaybeIO getmtime - where - getmtime = realToFrac . modificationTime <$> getSymbolicLinkStatus f - go (Just mtime) | check mtime = nukeFile f - go _ = noop - checkRepoExists :: Assistant () checkRepoExists = do g <- liftAnnex gitRepo diff --git a/CHANGELOG b/CHANGELOG index d313f9ee31..f5c5f511d8 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -30,6 +30,11 @@ git-annex (7.20181212) UNRELEASED; urgency=medium * addunused, merge, assistant: Avoid creating work tree files in subdirectories in an edge case where the key contains "/". * testremote: Support testing readonly remotes with the --test-readonly option. + * Switch to using .git/annex/othertmp for tmp files other than partial + downloads, and make stale files left in that directory when git-annex + is interrupted be cleaned up promptly by subsequent git-annex processes. + * The .git/annex/misctmp directory is no longer used and git-annex will + delete anything lingering in there after it's 1 week old. -- Joey Hess Tue, 18 Dec 2018 12:24:52 -0400 diff --git a/Command/Proxy.hs b/Command/Proxy.hs index e881f858cb..56a19ea787 100644 --- a/Command/Proxy.hs +++ b/Command/Proxy.hs @@ -12,6 +12,7 @@ import Config import Utility.Tmp.Dir import Utility.Env import Annex.Direct +import Annex.Tmp import qualified Git import qualified Git.Sha import qualified Git.Ref @@ -32,9 +33,7 @@ seek = withWords (commandAction . start) start :: [String] -> CommandStart start [] = giveup "Did not specify command to run." start (c:ps) = liftIO . exitWith =<< ifM isDirect - ( do - tmp <- gitAnnexTmpMiscDir <$> gitRepo - withTmpDirIn tmp "proxy" go + ( withOtherTmp $ \tmp -> withTmpDirIn tmp "proxy" go , liftIO $ safeSystem c (map Param ps) ) where diff --git a/Remote/BitTorrent.hs b/Remote/BitTorrent.hs index 4c8d7d946a..7f636ed47f 100644 --- a/Remote/BitTorrent.hs +++ b/Remote/BitTorrent.hs @@ -24,6 +24,7 @@ import Utility.Metered import Utility.Tmp import Backend.URL import Annex.Perms +import Annex.Tmp import Annex.UUID import qualified Annex.Url as Url import Remote.Helper.Export @@ -165,29 +166,20 @@ torrentUrlNum u torrentUrlKey :: URLString -> Annex Key torrentUrlKey u = return $ fromUrl (fst $ torrentUrlNum u) Nothing -{- Temporary directory used to download a torrent. -} -tmpTorrentDir :: URLString -> Annex FilePath -tmpTorrentDir u = do - d <- fromRepo gitAnnexTmpMiscDir - f <- keyFile <$> torrentUrlKey u - return (d f) - {- Temporary filename to use to store the torrent file. -} tmpTorrentFile :: URLString -> Annex FilePath tmpTorrentFile u = fromRepo . gitAnnexTmpObjectLocation =<< torrentUrlKey u -{- A cleanup action is registered to delete the torrent file and its - - associated temp directory when git-annex exits. +{- A cleanup action is registered to delete the torrent file + - when git-annex exits. - - - This allows multiple actions that use the same torrent file and temp - - directory to run in a single git-annex run. + - This allows multiple actions that use the same torrent file + - directory to run in a single git-annex run, and only download the + - torrent file once. -} registerTorrentCleanup :: URLString -> Annex () -registerTorrentCleanup u = Annex.addCleanup (TorrentCleanup u) $ do +registerTorrentCleanup u = Annex.addCleanup (TorrentCleanup u) $ liftIO . nukeFile =<< tmpTorrentFile u - d <- tmpTorrentDir u - liftIO $ whenM (doesDirectoryExist d) $ - removeDirectoryRecursive d {- Downloads the torrent file. (Not its contents.) -} downloadTorrentFile :: URLString -> Annex Bool @@ -199,17 +191,16 @@ downloadTorrentFile u = do showAction "downloading torrent file" createAnnexDirectory (parentDir torrent) if isTorrentMagnetUrl u - then do - tmpdir <- tmpTorrentDir u - let metadir = tmpdir "meta" + then withOtherTmp $ \othertmp -> do + kf <- keyFile <$> torrentUrlKey u + let metadir = othertmp "torrentmeta" kf createAnnexDirectory metadir showOutput ok <- downloadMagnetLink u metadir torrent liftIO $ removeDirectoryRecursive metadir return ok - else do - misctmp <- fromRepo gitAnnexTmpMiscDir - withTmpFileIn misctmp "torrent" $ \f h -> do + else withOtherTmp $ \othertmp -> do + withTmpFileIn othertmp "torrent" $ \f h -> do liftIO $ hClose h ok <- Url.withUrlOptions $ liftIO . Url.download nullMeterUpdate u f @@ -244,16 +235,25 @@ downloadMagnetLink u metadir dest = ifM download downloadTorrentContent :: Key -> URLString -> FilePath -> Int -> MeterUpdate -> Annex Bool downloadTorrentContent k u dest filenum p = do torrent <- tmpTorrentFile u - tmpdir <- tmpTorrentDir u - createAnnexDirectory tmpdir - f <- wantedfile torrent - showOutput - ifM (download torrent tmpdir <&&> liftIO (doesFileExist (tmpdir f))) - ( do - liftIO $ renameFile (tmpdir f) dest - return True - , return False - ) + withOtherTmp $ \othertmp -> do + kf <- keyFile <$> torrentUrlKey u + let downloaddir = othertmp "torrent" kf + createAnnexDirectory downloaddir + f <- wantedfile torrent + showOutput + ifM (download torrent downloaddir <&&> liftIO (doesFileExist (downloaddir f))) + ( do + liftIO $ renameFile (downloaddir f) dest + -- The downloaddir is not removed here, + -- so if aria downloaded parts of other + -- files, and this is called again, it will + -- resume where it left off. + -- withOtherTmp registers a cleanup action + -- that will clean up leftover files when + -- git-annex terminates. + return True + , return False + ) where download torrent tmpdir = ariaProgress (keySize k) p [ Param $ "--select-file=" ++ show filenum diff --git a/Remote/Directory/LegacyChunked.hs b/Remote/Directory/LegacyChunked.hs index 095b90b483..8cefe38040 100644 --- a/Remote/Directory/LegacyChunked.hs +++ b/Remote/Directory/LegacyChunked.hs @@ -16,7 +16,7 @@ import Annex.Common import Utility.FileMode import Remote.Helper.Special import qualified Remote.Helper.Chunked.Legacy as Legacy -import Annex.Perms +import Annex.Tmp import Utility.Metered withCheckedFiles :: (FilePath -> IO Bool) -> FilePath -> (FilePath -> Key -> [FilePath]) -> Key -> ([FilePath] -> IO Bool) -> IO Bool @@ -89,10 +89,8 @@ store chunksize finalizer k b p = storeHelper finalizer k $ \dests -> - :/ This is legacy code.. -} retrieve :: (FilePath -> Key -> [FilePath]) -> FilePath -> Preparer Retriever -retrieve locations d basek a = do +retrieve locations d basek a = withOtherTmp $ \tmpdir -> do showLongNote "This remote uses the deprecated chunksize setting. So this will be quite slow." - tmpdir <- fromRepo $ gitAnnexTmpMiscDir - createAnnexDirectory tmpdir let tmp = tmpdir keyFile basek ++ ".directorylegacy.tmp" a $ Just $ byteRetriever $ \k sink -> do liftIO $ void $ withStoredFiles d locations k $ \fs -> do diff --git a/Test.hs b/Test.hs index 555166e299..8f9c460306 100644 --- a/Test.hs +++ b/Test.hs @@ -1621,7 +1621,7 @@ test_crypto = do gpgcmd = Utility.Gpg.mkGpgCmd Nothing testscheme scheme = intmpclonerepo $ whenM (Utility.Path.inPath (Utility.Gpg.unGpgCmd gpgcmd)) $ do gpgtmpdir <- annexeval $ ( "gpgtest") - <$> Annex.fromRepo Annex.Locations.gitAnnexTmpMiscDir + <$> Annex.fromRepo Annex.Locations.gitAnnexTmpOtherDir annexeval $ Annex.Perms.createAnnexDirectory gpgtmpdir Utility.Gpg.testTestHarness gpgtmpdir gpgcmd @? "test harness self-test failed" diff --git a/Types/CleanupActions.hs b/Types/CleanupActions.hs index 508579643c..22cbaf55cd 100644 --- a/Types/CleanupActions.hs +++ b/Types/CleanupActions.hs @@ -17,4 +17,5 @@ data CleanupAction | FsckCleanup | SshCachingCleanup | TorrentCleanup URLString + | OtherTmpCleanup deriving (Eq, Ord) diff --git a/doc/forum/Move_history/comment_11_46ce6990e5921238f98749af830ac5ec._comment b/doc/forum/Move_history/comment_11_46ce6990e5921238f98749af830ac5ec._comment new file mode 100644 index 0000000000..41ad394f00 --- /dev/null +++ b/doc/forum/Move_history/comment_11_46ce6990e5921238f98749af830ac5ec._comment @@ -0,0 +1,11 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 11""" + date="2019-01-17T20:01:51Z" + content=""" +There were actually a few ways git-annex could be interrupted and leave +droppings in misctmp. + +This is now dealt with, a subsequent run of git-annex will clean up +leftover files from a previous interrupted run. +"""]] diff --git a/doc/forum/misctmp_filling_up/comment_3_b6ab64f02f204fc7e8741b9c04c5349d._comment b/doc/forum/misctmp_filling_up/comment_3_b6ab64f02f204fc7e8741b9c04c5349d._comment new file mode 100644 index 0000000000..21167f9c5e --- /dev/null +++ b/doc/forum/misctmp_filling_up/comment_3_b6ab64f02f204fc7e8741b9c04c5349d._comment @@ -0,0 +1,11 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 3""" + date="2019-01-17T20:00:57Z" + content=""" +There were actually a few ways git-annex could be interrupted and leave +droppings in misctmp. + +This is now dealt with, a subsequent run of git-annex will clean up +leftover files from a previous interrupted run. +"""]] diff --git a/doc/internals.mdwn b/doc/internals.mdwn index 47a809ad63..bf7c3c48cb 100644 --- a/doc/internals.mdwn +++ b/doc/internals.mdwn @@ -33,12 +33,12 @@ that contain the key. This directory contains partially transferred objects. -### `.git/annex/misctmp/` +### `.git/annex/othertmp/` This is a temp directory for miscellaneous other temp files. While .git/annex/objects and .git/annex/tmp can be put on different -filesystems if desired, .git/annex/misctmp +filesystems if desired, .git/annex/othertmp has to be on the same filesystem as the work tree and git repository. ### `.git/annex/bad/` diff --git a/doc/todo/delete_old_misctmp_files.mdwn b/doc/todo/delete_old_misctmp_files.mdwn new file mode 100644 index 0000000000..81623e19ae --- /dev/null +++ b/doc/todo/delete_old_misctmp_files.mdwn @@ -0,0 +1,24 @@ +Files can be left in .git/annex/misctmp when git-annex is interrupted in +the middle of an operation that uses it. Especially with `git annex add` +being interrupted can leave a large file hard linked in there, which can +become a problem for the user. + +While it would be possible to hook SIGINT and clean up the files, that +wouldn't catch every way git-annex could be interrupted; ie power failure. + +The assistant has some code that deletes misctmp files there older than 1 +day. Perhaps when git-annex uses the misctmp directory it should first +perform such a cleanup pass. + +A 1 day timeout is not ideal.. Imagine a git-annex add of a really big file +where the checksum takes more than 1 day. + +Let's use a lock file. There can be a single one for the whole misctmp +directory. When it's being used, a shared lock is held. Take an exclusive +lock before cleaning it. + +Since old versions of git-annex could still be in use and using the misctmp +directory, let's rename the directory that new versions of git-annex +use to .git/annex/othertmp. + +[[done]] --[[Joey]] diff --git a/git-annex.cabal b/git-annex.cabal index 839b469b5c..ff2db6e39c 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -645,6 +645,7 @@ Executable git-annex Annex.SpecialRemote Annex.Ssh Annex.TaggedPush + Annex.Tmp Annex.Transfer Annex.UpdateInstead Annex.UUID