1{- git-annex tmp files
2 -
3 - Copyright 2019 Joey Hess <id@joeyh.name>
4 -
5 - Licensed under the GNU AGPL version 3 or higher.
6 -}
7
8module Annex.Tmp where
9
10import Annex.Common
11import qualified Annex
12import Annex.LockFile
13import Annex.Perms
14import Types.CleanupActions
15import qualified Utility.RawFilePath as R
16
17import Data.Time.Clock.POSIX
18
19-- | For creation of tmp files, other than for key's contents.
20--
21-- The action should normally clean up whatever files it writes to the temp
22-- directory that is passed to it. However, once the action is done,
23-- any files left in that directory may be cleaned up by another process at
24-- any time.
25withOtherTmp :: (RawFilePath -> Annex a) -> Annex a
26withOtherTmp a = do
27	Annex.addCleanupAction OtherTmpCleanup cleanupOtherTmp
28	tmpdir <- fromRepo gitAnnexTmpOtherDir
29	tmplck <- fromRepo gitAnnexTmpOtherLock
30	withSharedLock (const tmplck) $ do
31		void $ createAnnexDirectory tmpdir
32		a tmpdir
33
34-- | This uses an alternate temp directory. The action should normally
35-- clean up whatever files it writes there, but if it leaves files
36-- there (perhaps due to being interrupted), the files will be eventually
37-- cleaned up by another git-annex process (after they're a week old).
38--
39-- Unlike withOtherTmp, this does not rely on locking working.
40-- Its main use is in situations where the state of lockfile is not
41-- determined yet, eg during initialization.
42withEventuallyCleanedOtherTmp :: (RawFilePath -> Annex a) -> Annex a
43withEventuallyCleanedOtherTmp = bracket setup cleanup
44  where
45	setup = do
46		tmpdir <- fromRepo gitAnnexTmpOtherDirOld
47		void $ createAnnexDirectory tmpdir
48		return tmpdir
49	cleanup = liftIO . void . tryIO . removeDirectory . fromRawFilePath
50
51-- | Cleans up any tmp files that were left by a previous
52-- git-annex process that got interrupted or failed to clean up after
53-- itself for some other reason.
54--
55-- Does not do anything if withOtherTmp is running.
56cleanupOtherTmp :: Annex ()
57cleanupOtherTmp = do
58	tmplck <- fromRepo gitAnnexTmpOtherLock
59	void $ tryIO $ tryExclusiveLock (const tmplck) $ do
60		tmpdir <- fromRawFilePath <$> fromRepo gitAnnexTmpOtherDir
61		void $ liftIO $ tryIO $ removeDirectoryRecursive tmpdir
62		oldtmp <- fromRawFilePath <$> fromRepo gitAnnexTmpOtherDirOld
63		liftIO $ mapM_ cleanold =<< dirContentsRecursive oldtmp
64		liftIO $ void $ tryIO $ removeDirectory oldtmp -- when empty
65  where
66	cleanold f = do
67		now <- liftIO getPOSIXTime
68		let oldenough = now - (60 * 60 * 24 * 7)
69		catchMaybeIO (modificationTime <$> getSymbolicLinkStatus f) >>= \case
70			Just mtime | realToFrac mtime <= oldenough ->
71				void $ tryIO $ removeWhenExistsWith R.removeLink (toRawFilePath f)
72			_ -> return ()
73