8820091b4c
When starting up the assistant, it'll remind about the current repository, if it doesn't have checks. And when a removable drive is plugged in, it will remind if a repository on it lacks checks. Since that might be annoying, the reminders can be turned off. This commit was sponsored by Nedialko Andreev.
50 lines
1.5 KiB
Haskell
50 lines
1.5 KiB
Haskell
{- git-annex assistant fscking
|
|
-
|
|
- Copyright 2013 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Assistant.Fsck where
|
|
|
|
import Assistant.Common
|
|
import Types.ScheduledActivity
|
|
import qualified Types.Remote as Remote
|
|
import Annex.UUID
|
|
import Assistant.Alert
|
|
import Assistant.Types.UrlRenderer
|
|
import Logs.Schedule
|
|
import qualified Annex
|
|
|
|
import qualified Data.Set as S
|
|
|
|
{- Displays a nudge in the webapp if a fsck is not configured for
|
|
- the specified remote, or for the local repository. -}
|
|
fsckNudge :: UrlRenderer -> Maybe Remote -> Assistant ()
|
|
fsckNudge urlrenderer mr
|
|
| maybe True fsckableRemote mr =
|
|
whenM (liftAnnex $ annexFsckNudge <$> Annex.getGitConfig) $
|
|
unlessM (liftAnnex $ checkFscked mr) $
|
|
notFsckedNudge urlrenderer mr
|
|
| otherwise = noop
|
|
|
|
fsckableRemote :: Remote -> Bool
|
|
fsckableRemote = isJust . Remote.remoteFsck
|
|
|
|
{- Checks if the remote, or the local repository, has a fsck scheduled.
|
|
- Only looks at fscks configured to run via the local repository, not
|
|
- other repositories. -}
|
|
checkFscked :: Maybe Remote -> Annex Bool
|
|
checkFscked mr = any wanted . S.toList <$> (scheduleGet =<< getUUID)
|
|
where
|
|
wanted = case mr of
|
|
Nothing -> isSelfFsck
|
|
Just r -> flip isFsckOf (Remote.uuid r)
|
|
|
|
isSelfFsck :: ScheduledActivity -> Bool
|
|
isSelfFsck (ScheduledSelfFsck _ _) = True
|
|
isSelfFsck _ = False
|
|
|
|
isFsckOf :: ScheduledActivity -> UUID -> Bool
|
|
isFsckOf (ScheduledRemoteFsck u _ _) u' = u == u'
|
|
isFsckOf _ _ = False
|