diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs index d7a71d4770..ba141698d7 100644 --- a/Assistant/Threads/SanityChecker.hs +++ b/Assistant/Threads/SanityChecker.hs @@ -46,6 +46,7 @@ import Assistant.WebApp.Types #ifndef mingw32_HOST_OS import Utility.LogFile #endif +import Types.Key (keyBackendName) import Data.Time.Clock.POSIX import qualified Data.Text as T @@ -82,6 +83,10 @@ sanityCheckerStartupThread startupdelay = namedThreadUnchecked "SanityCheckerSta {- Fix up ssh remotes set up by past versions of the assistant. -} liftIO $ fixUpSshRemotes + {- Clean up old temp files. -} + liftAnnex cleanOldTmpMisc + liftAnnex cleanReallyOldTmp + {- If there's a startup delay, it's done here. -} liftIO $ maybe noop (threadDelaySeconds . Seconds . fromIntegral . durationSeconds) startupdelay @@ -258,3 +263,54 @@ checkOldUnused urlrenderer = go =<< annexExpireUnused <$> liftAnnex Annex.getGit #else 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" `isPrefixOf` keyBackendName k -> + cleanOld check f + | otherwise -> noop + +cleanOld :: (POSIXTime -> Bool) -> FilePath -> IO () +cleanOld check f = do + mtime <- realToFrac . modificationTime <$> getFileStatus f + when (check mtime) $ + nukeFile f diff --git a/debian/changelog b/debian/changelog index 449d255d07..2e6909e9f1 100644 --- a/debian/changelog +++ b/debian/changelog @@ -3,6 +3,7 @@ git-annex (5.20140422) UNRELEASED; urgency=medium * Standalone builds now check gpg signatures before upgrading. * Simplified repository description line format. The remote name, if any, is always in square brackets after the description. + * assistant: Clean up stale tmp files on startup. -- Joey Hess Wed, 23 Apr 2014 12:43:39 -0400