init: Fix a reversion that broke initialization on systems that need to use pid locking

This brings back .git/annex/misctmp, but only for init. If an init
is interrupted while probing using that temp directory, the files it left
will get deleted 1 week later by a subsequent git-annex run.
This commit is contained in:
Joey Hess 2019-09-10 13:37:07 -04:00
parent 07de0e7e9d
commit 94c75d2bd9
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
7 changed files with 42 additions and 13 deletions

View file

@ -7,9 +7,8 @@
module Annex.Tmp where
import Common
import Annex
import Annex.Locations
import Annex.Common
import qualified Annex
import Annex.LockFile
import Annex.Perms
import Types.CleanupActions
@ -24,13 +23,30 @@ import Data.Time.Clock.POSIX
-- any time.
withOtherTmp :: (FilePath -> Annex a) -> Annex a
withOtherTmp a = do
addCleanup OtherTmpCleanup cleanupOtherTmp
Annex.addCleanup OtherTmpCleanup cleanupOtherTmp
tmpdir <- fromRepo gitAnnexTmpOtherDir
tmplck <- fromRepo gitAnnexTmpOtherLock
withSharedLock (const tmplck) $ do
void $ createAnnexDirectory tmpdir
a tmpdir
-- | This uses an alternate temp directory. The action should normally
-- clean up whatever files it writes there, but if it leaves files
-- there (perhaps due to being interrupted), the files will be eventually
-- cleaned up by another git-annex process (after they're a week old).
--
-- Unlike withOtherTmp, this does not rely on locking working.
-- Its main use is in situations where the state of lockfile is not
-- determined yet, eg during initialization.
withEventuallyCleanedOtherTmp :: (FilePath -> Annex a) -> Annex a
withEventuallyCleanedOtherTmp = bracket setup cleanup
where
setup = do
tmpdir <- fromRepo gitAnnexTmpOtherDirOld
void $ createAnnexDirectory tmpdir
return tmpdir
cleanup = liftIO . void . tryIO . removeDirectory
-- | 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.
@ -42,8 +58,6 @@ cleanupOtherTmp = do
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