blob: 008b5fd826c5350717e30b6d782b18fbe3856e43 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
|
{- git-annex tmp files
-
- Copyright 2019 Joey Hess <id@joeyh.name>
-
- 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
withSharedLock (const tmplck) $ do
void $ createAnnexDirectory tmpdir
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 ()
|
