1243af4a18
Added Maybe POSIXTime to SafeDropProof, which gets set when the proof is based on a LockedCopy. If there are several LockedCopies, it uses the closest expiry time. That is not optimal, it may be that the proof expires based on one LockedCopy but another one has not expired. But that seems unlikely to really happen, and anyway the user can just re-run a drop if it fails due to expiry. Pass the SafeDropProof to removeKey, which is responsible for checking it for expiry in situations where that could be a problem. Which really only means in Remote.Git. Made Remote.Git check expiry when dropping from a local remote. Checking expiry when dropping from a P2P remote is not yet implemented. P2P.Protocol.remove has SafeDropProof plumbed through to it for that purpose. Fixing the remaining 2 build warnings should complete this work. Note that the use of a POSIXTime here means that if the clock gets set forward while git-annex is in the middle of a drop, it may say that dropping took too long. That seems ok. Less ok is that if the clock gets turned back a sufficient amount (eg 5 minutes), proof expiry won't be noticed. It might be better to use the Monotonic clock, but that doesn't advance when a laptop is suspended, and while there is the linux Boottime clock, that is not available on other systems. Perhaps a combination of POSIXTime and the Monotonic clock could detect laptop suspension and also detect clock being turned back? There is a potential future flag day where p2pDefaultLockContentRetentionDuration is not assumed, but is probed using the P2P protocol, and peers that don't support it can no longer produce a LockedCopy. Until that happens, when git-annex is communicating with older peers there is a risk of data loss when a ssh connection closes during LOCKCONTENT.
99 lines
3 KiB
Haskell
99 lines
3 KiB
Haskell
{- Adds hooks to remotes.
|
|
-
|
|
- Copyright 2012 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
module Remote.Helper.Hooks (addHooks) where
|
|
|
|
import qualified Data.Map as M
|
|
import qualified System.FilePath.ByteString as P
|
|
|
|
import Annex.Common
|
|
import Types.Remote
|
|
import Types.CleanupActions
|
|
import qualified Annex
|
|
import Annex.LockFile
|
|
import Annex.LockPool
|
|
import Annex.Perms
|
|
|
|
{- Modifies a remote's access functions to first run the
|
|
- annex-start-command hook, and trigger annex-stop-command on shutdown.
|
|
- This way, the hooks are only run when a remote is actively being used.
|
|
-}
|
|
addHooks :: Remote -> Remote
|
|
addHooks r = addHooks' r
|
|
(remoteAnnexStartCommand $ gitconfig r)
|
|
(remoteAnnexStopCommand $ gitconfig r)
|
|
addHooks' :: Remote -> Maybe String -> Maybe String -> Remote
|
|
addHooks' r Nothing Nothing = r
|
|
addHooks' r starthook stophook = r'
|
|
where
|
|
r' = r
|
|
{ storeKey = \k af o p ->
|
|
wrapper $ storeKey r k af o p
|
|
, retrieveKeyFile = \k f d p vc ->
|
|
wrapper $ retrieveKeyFile r k f d p vc
|
|
, retrieveKeyFileCheap = case retrieveKeyFileCheap r of
|
|
Just a -> Just $ \k af f -> wrapper $ a k af f
|
|
Nothing -> Nothing
|
|
, removeKey = \proof k ->
|
|
wrapper $ removeKey r proof k
|
|
, checkPresent = wrapper . checkPresent r
|
|
}
|
|
where
|
|
wrapper = runHooks r' starthook stophook
|
|
|
|
runHooks :: Remote -> Maybe String -> Maybe String -> Annex a -> Annex a
|
|
runHooks r starthook stophook a = do
|
|
dir <- fromRepo gitAnnexRemotesDir
|
|
let lck = dir P.</> remoteid <> ".lck"
|
|
whenM (notElem lck . M.keys <$> getLockCache) $ do
|
|
createAnnexDirectory dir
|
|
firstrun lck
|
|
a
|
|
where
|
|
remoteid = fromUUID (uuid r)
|
|
run Nothing = noop
|
|
run (Just command) = void $ liftIO $
|
|
boolSystem "sh" [Param "-c", Param command]
|
|
firstrun lck = do
|
|
-- Take a shared lock; This indicates that git-annex
|
|
-- is using the remote, and prevents other instances
|
|
-- of it from running the stophook. If another
|
|
-- instance is shutting down right now, this
|
|
-- will block waiting for its exclusive lock to clear.
|
|
lockFileCached lck
|
|
|
|
-- The starthook is run even if some other git-annex
|
|
-- is already running, and ran it before.
|
|
-- It would be difficult to use locking to ensure
|
|
-- it's only run once, and it's also possible for
|
|
-- git-annex to be interrupted before it can run the
|
|
-- stophook, in which case the starthook
|
|
-- would be run again by the next git-annex.
|
|
-- So, requiring idempotency is the right approach.
|
|
run starthook
|
|
|
|
Annex.addCleanupAction (StopHook $ uuid r) $ runstop lck
|
|
runstop lck = do
|
|
-- Drop any shared lock we have, and take an
|
|
-- exclusive lock, without blocking. If the lock
|
|
-- succeeds, we're the only process using this remote,
|
|
-- so can stop it.
|
|
unlockFile lck
|
|
#ifndef mingw32_HOST_OS
|
|
mode <- annexFileMode
|
|
v <- tryLockExclusive (Just mode) lck
|
|
#else
|
|
v <- liftIO $ lockExclusive lck
|
|
#endif
|
|
case v of
|
|
Nothing -> noop
|
|
Just lockhandle -> do
|
|
run stophook
|
|
liftIO $ dropLock lockhandle
|