10b5f79e2d
Fix behavior when importing a tree from a directory remote when the
directory does not exist. An empty tree was imported, rather than the
import failing. Merging that tree would delete every file in the
branch, if those files had been exported to the directory before.
The problem was that dirContentsRecursive returned [] when the directory
did not exist. Better for it to throw an exception. But in commit
74f0d67aa3 back in 2012, I made it never
theow exceptions, because exceptions throw inside unsafeInterleaveIO become
untrappable when the list is being traversed.
So, changed it to list the contents of the directory before entering
unsafeInterleaveIO. So exceptions are thrown for the directory. But still
not if it's unable to list the contents of a subdirectory. That's less of a
problem, because the subdirectory does exist (or if not, it got removed
after being listed, and it's ok to not include it in the list). A
subdirectory that has permissions that don't allow listing it will have its
contents omitted from the list still.
(Might be better to have it return a type that includes indications of
errors listing contents of subdirectories?)
The rest of the changes are making callers of dirContentsRecursive
use emptyWhenDoesNotExist when they relied on the behavior of it not
throwing an exception when the directory does not exist. Note that
it's possible some callers of dirContentsRecursive that used to ignore
permissions problems listing a directory will now start throwing exceptions
on them.
The fix to the directory special remote consisted of not making its
call in listImportableContentsM use emptyWhenDoesNotExist. So it will
throw an exception as desired.
Sponsored-by: Joshua Antonishen on Patreon
74 lines
2.7 KiB
Haskell
74 lines
2.7 KiB
Haskell
{- git-annex tmp files
|
|
-
|
|
- Copyright 2019 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Annex.Tmp where
|
|
|
|
import Annex.Common
|
|
import qualified Annex
|
|
import Annex.LockFile
|
|
import Annex.Perms
|
|
import Types.CleanupActions
|
|
import qualified Utility.RawFilePath as R
|
|
|
|
import Data.Time.Clock.POSIX
|
|
import System.PosixCompat.Files (modificationTime)
|
|
|
|
-- | 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 :: (RawFilePath -> Annex a) -> Annex a
|
|
withOtherTmp a = do
|
|
Annex.addCleanupAction OtherTmpCleanup cleanupOtherTmp
|
|
tmpdir <- fromRepo gitAnnexTmpOtherDir
|
|
tmplck <- fromRepo gitAnnexTmpOtherLock
|
|
withSharedLock 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 :: (RawFilePath -> Annex a) -> Annex a
|
|
withEventuallyCleanedOtherTmp = bracket setup cleanup
|
|
where
|
|
setup = do
|
|
tmpdir <- fromRepo gitAnnexTmpOtherDirOld
|
|
void $ createAnnexDirectory tmpdir
|
|
return tmpdir
|
|
cleanup = liftIO . void . tryIO . removeDirectory . fromRawFilePath
|
|
|
|
-- | 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 tmplck $ do
|
|
tmpdir <- fromRawFilePath <$> fromRepo gitAnnexTmpOtherDir
|
|
void $ liftIO $ tryIO $ removeDirectoryRecursive tmpdir
|
|
oldtmp <- fromRawFilePath <$> fromRepo gitAnnexTmpOtherDirOld
|
|
liftIO $ mapM_ cleanold
|
|
=<< emptyWhenDoesNotExist (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 <$> R.getSymbolicLinkStatus (toRawFilePath f)) >>= \case
|
|
Just mtime | realToFrac mtime <= oldenough ->
|
|
void $ tryIO $ removeWhenExistsWith R.removeLink (toRawFilePath f)
|
|
_ -> return ()
|