summaryrefslogtreecommitdiff
path: root/Remote
diff options
context:
space:
mode:
Diffstat (limited to 'Remote')
-rw-r--r--Remote/BitTorrent.hs1
-rw-r--r--Remote/Bup.hs1
-rw-r--r--Remote/Ddar.hs1
-rw-r--r--Remote/Directory.hs1
-rw-r--r--Remote/External.hs1
-rw-r--r--Remote/GCrypt.hs1
-rw-r--r--Remote/Git.hs63
-rw-r--r--Remote/Glacier.hs1
-rw-r--r--Remote/Helper/Messages.hs27
-rw-r--r--Remote/Helper/Ssh.hs5
-rw-r--r--Remote/Hook.hs1
-rw-r--r--Remote/Rsync.hs1
-rw-r--r--Remote/S3.hs1
-rw-r--r--Remote/Tahoe.hs1
-rw-r--r--Remote/Web.hs1
-rw-r--r--Remote/WebDAV.hs1
16 files changed, 95 insertions, 13 deletions
diff --git a/Remote/BitTorrent.hs b/Remote/BitTorrent.hs
index f9027ba61..8349631de 100644
--- a/Remote/BitTorrent.hs
+++ b/Remote/BitTorrent.hs
@@ -58,6 +58,7 @@ gen r _ c gc =
, retrieveKeyFile = downloadKey
, retrieveKeyFileCheap = downloadKeyCheap
, removeKey = dropKey
+ , lockContent = Nothing
, checkPresent = checkKey
, checkPresentCheap = False
, whereisKey = Nothing
diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index a253b0889..d9d561b0d 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -58,6 +58,7 @@ gen r u c gc = do
, retrieveKeyFile = retreiveKeyFileDummy
, retrieveKeyFileCheap = retrieveCheap buprepo
, removeKey = removeKeyDummy
+ , lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = bupLocal buprepo
, whereisKey = Nothing
diff --git a/Remote/Ddar.hs b/Remote/Ddar.hs
index b616093a3..d485d3793 100644
--- a/Remote/Ddar.hs
+++ b/Remote/Ddar.hs
@@ -57,6 +57,7 @@ gen r u c gc = do
, retrieveKeyFile = retreiveKeyFileDummy
, retrieveKeyFileCheap = retrieveCheap
, removeKey = removeKeyDummy
+ , lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = ddarLocal ddarrepo
, whereisKey = Nothing
diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index ab4137d75..987c3079f 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -55,6 +55,7 @@ gen r u c gc = do
, retrieveKeyFile = retreiveKeyFileDummy
, retrieveKeyFileCheap = retrieveCheap dir chunkconfig
, removeKey = removeKeyDummy
+ , lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = True
, whereisKey = Nothing
diff --git a/Remote/External.hs b/Remote/External.hs
index 9f8bd4ccf..68237b939 100644
--- a/Remote/External.hs
+++ b/Remote/External.hs
@@ -81,6 +81,7 @@ gen r u c gc
, retrieveKeyFile = retreiveKeyFileDummy
, retrieveKeyFileCheap = \_ _ _ -> return False
, removeKey = removeKeyDummy
+ , lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = False
, whereisKey = towhereis
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index 3a63642c8..c720e55b2 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -111,6 +111,7 @@ gen' r u c gc = do
, retrieveKeyFile = retreiveKeyFileDummy
, retrieveKeyFileCheap = \_ _ _ -> return False
, removeKey = removeKeyDummy
+ , lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = repoCheap r
, whereisKey = Nothing
diff --git a/Remote/Git.hs b/Remote/Git.hs
index f7a0b4a39..c80a0d1c6 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -53,9 +53,11 @@ import Annex.Path
import Creds
import Annex.CatFile
import Messages.Progress
+import Types.NumCopies
import Control.Concurrent
import Control.Concurrent.MSampleVar
+import Control.Concurrent.Async
import qualified Data.Map as M
import Network.URI
@@ -142,6 +144,7 @@ gen r u c gc
, retrieveKeyFile = copyFromRemote new
, retrieveKeyFileCheap = copyFromRemoteCheap new
, removeKey = dropKey new
+ , lockContent = Just (lockKey new)
, checkPresent = inAnnex new
, checkPresentCheap = repoCheap r
, whereisKey = Nothing
@@ -350,7 +353,7 @@ dropKey r key
commitOnCleanup r $ onLocal r $ do
ensureInitialized
whenM (Annex.Content.inAnnex key) $ do
- Annex.Content.lockContent key
+ Annex.Content.lockContentForRemoval key
Annex.Content.removeAnnex
logStatus key InfoMissing
Annex.Content.saveState True
@@ -358,6 +361,64 @@ dropKey r key
| Git.repoIsHttp (repo r) = error "dropping from http remote not supported"
| otherwise = commitOnCleanup r $ Ssh.dropKey (repo r) key
+lockKey :: Remote -> Key -> (VerifiedCopy -> Annex r) -> Annex r
+lockKey r key callback
+ | not $ Git.repoIsUrl (repo r) =
+ guardUsable (repo r) failedlock $ do
+ inorigrepo <- Annex.makeRunner
+ -- Lock content from perspective of remote,
+ -- and then run the callback in the original
+ -- annex monad, not the remote's.
+ onLocal r $
+ Annex.Content.lockContentShared key $ \vc ->
+ ifM (Annex.Content.inAnnex key)
+ ( liftIO $ inorigrepo $ callback vc
+ , failedlock
+ )
+ | Git.repoIsSsh (repo r) = do
+ showLocking r
+ Just (cmd, params) <- Ssh.git_annex_shell (repo r) "lockcontent"
+ [Param $ key2file key] []
+ (Just hin, Just hout, Nothing, p) <- liftIO $
+ withFile devNull WriteMode $ \nullh ->
+ createProcess $
+ (proc cmd (toCommand params))
+ { std_in = CreatePipe
+ , std_out = CreatePipe
+ , std_err = UseHandle nullh
+ }
+ -- Wait for either the process to exit, or for it to
+ -- indicate the content is locked.
+ v <- liftIO $ race
+ (waitForProcess p)
+ (hGetLine hout)
+ let signaldone = void $ tryNonAsync $ liftIO $ do
+ hPutStrLn hout ""
+ hFlush hout
+ hClose hin
+ hClose hout
+ void $ waitForProcess p
+ let checkexited = not . isJust <$> getProcessExitCode p
+ case v of
+ Left _exited -> do
+ showNote "lockcontent failed"
+ liftIO $ do
+ hClose hin
+ hClose hout
+ failedlock
+ Right l
+ | l == Ssh.contentLockedMarker -> bracket_
+ noop
+ signaldone
+ (withVerifiedCopy LockedCopy r checkexited callback)
+ | otherwise -> do
+ showNote "lockcontent failed"
+ signaldone
+ failedlock
+ | otherwise = failedlock
+ where
+ failedlock = error "can't lock content"
+
{- Tries to copy a key's content from a remote's annex to a file. -}
copyFromRemote :: Remote -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)
copyFromRemote r key file dest p = parallelMetered (Just p) key file $
diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs
index e69903634..8529b6341 100644
--- a/Remote/Glacier.hs
+++ b/Remote/Glacier.hs
@@ -55,6 +55,7 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost
, retrieveKeyFile = retreiveKeyFileDummy
, retrieveKeyFileCheap = retrieveCheap this
, removeKey = removeKeyDummy
+ , lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = False
, whereisKey = Nothing
diff --git a/Remote/Helper/Messages.hs b/Remote/Helper/Messages.hs
index 377f2d231..6e72758fb 100644
--- a/Remote/Helper/Messages.hs
+++ b/Remote/Helper/Messages.hs
@@ -13,20 +13,23 @@ import Common.Annex
import qualified Git
import qualified Types.Remote as Remote
-class Checkable a where
- descCheckable :: a -> String
+class Describable a where
+ describe :: a -> String
-instance Checkable Git.Repo where
- descCheckable = Git.repoDescribe
+instance Describable Git.Repo where
+ describe = Git.repoDescribe
-instance Checkable (Remote.RemoteA a) where
- descCheckable = Remote.name
+instance Describable (Remote.RemoteA a) where
+ describe = Remote.name
-instance Checkable String where
- descCheckable = id
+instance Describable String where
+ describe = id
-showChecking :: Checkable a => a -> Annex ()
-showChecking v = showAction $ "checking " ++ descCheckable v
+showChecking :: Describable a => a -> Annex ()
+showChecking v = showAction $ "checking " ++ describe v
-cantCheck :: Checkable a => a -> e
-cantCheck v = error $ "unable to check " ++ descCheckable v
+cantCheck :: Describable a => a -> e
+cantCheck v = error $ "unable to check " ++ describe v
+
+showLocking :: Describable a => a -> Annex ()
+showLocking v = showAction $ "locking " ++ describe v
diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs
index 162c34f4e..0442ce839 100644
--- a/Remote/Helper/Ssh.hs
+++ b/Remote/Helper/Ssh.hs
@@ -173,3 +173,8 @@ rsyncParams r direction = do
| direction == Download = remoteAnnexRsyncDownloadOptions gc
| otherwise = remoteAnnexRsyncUploadOptions gc
gc = gitconfig r
+
+-- Used by git-annex-shell lockcontent to indicate the content is
+-- successfully locked.
+contentLockedMarker :: String
+contentLockedMarker = "OK"
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index 98eeeb031..5d3c0af5c 100644
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -49,6 +49,7 @@ gen r u c gc = do
, retrieveKeyFile = retreiveKeyFileDummy
, retrieveKeyFileCheap = retrieveCheap hooktype
, removeKey = removeKeyDummy
+ , lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = False
, whereisKey = Nothing
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index 829a2661a..fd6c25c15 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -70,6 +70,7 @@ gen r u c gc = do
, retrieveKeyFile = retreiveKeyFileDummy
, retrieveKeyFileCheap = retrieveCheap o
, removeKey = removeKeyDummy
+ , lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = False
, whereisKey = Nothing
diff --git a/Remote/S3.hs b/Remote/S3.hs
index c8a34f2e7..d381e0b72 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -81,6 +81,7 @@ gen r u c gc = do
, retrieveKeyFile = retreiveKeyFileDummy
, retrieveKeyFileCheap = retrieveCheap
, removeKey = removeKeyDummy
+ , lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = False
, whereisKey = Just (getWebUrls info)
diff --git a/Remote/Tahoe.hs b/Remote/Tahoe.hs
index c04cdae58..2ced67e30 100644
--- a/Remote/Tahoe.hs
+++ b/Remote/Tahoe.hs
@@ -72,6 +72,7 @@ gen r u c gc = do
, retrieveKeyFile = retrieve u hdl
, retrieveKeyFileCheap = \_ _ _ -> return False
, removeKey = remove
+ , lockContent = Nothing
, checkPresent = checkKey u hdl
, checkPresentCheap = False
, whereisKey = Nothing
diff --git a/Remote/Web.hs b/Remote/Web.hs
index ae0281064..257eba2e1 100644
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@@ -52,6 +52,7 @@ gen r _ c gc =
, retrieveKeyFile = downloadKey
, retrieveKeyFileCheap = downloadKeyCheap
, removeKey = dropKey
+ , lockContent = Nothing
, checkPresent = checkKey
, checkPresentCheap = False
, whereisKey = Nothing
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index 730093a3b..7f4173d03 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -60,6 +60,7 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
, retrieveKeyFile = retreiveKeyFileDummy
, retrieveKeyFileCheap = retrieveCheap
, removeKey = removeKeyDummy
+ , lockContent = Nothing
, checkPresent = checkPresentDummy
, checkPresentCheap = False
, whereisKey = Nothing
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-07 19:52:59 +0000