Special remotes now all rollback storage of keys that get modified during the transfer, which can happen in direct mode.

8 files changed, 45 insertions, 27 deletions

diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index 56253f5b8..2976ff086 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -121,16 +121,17 @@ bupSplitParams r buprepo k src = do
 		(os ++ [Param "-n", Param (bupRef k)] ++ src)
 
 store :: Remote -> BupRepo -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
-store r buprepo k _f _p = sendAnnex k $ \src -> do
+store r buprepo k _f _p = sendAnnex k (rollback k buprepo) $ \src -> do
 	params <- bupSplitParams r buprepo k [File src]
 	liftIO $ boolSystem "bup" params
 
 storeEncrypted :: Remote -> BupRepo -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
-storeEncrypted r buprepo (cipher, enck) k _p = sendAnnex k $ \src -> do
-	params <- bupSplitParams r buprepo enck []
-	liftIO $ catchBoolIO $
-		encrypt cipher (feedFile src) $ \h ->
-			pipeBup params (Just h) Nothing
+storeEncrypted r buprepo (cipher, enck) k _p =
+	sendAnnex k (rollback enck buprepo) $ \src -> do
+		params <- bupSplitParams r buprepo enck []
+		liftIO $ catchBoolIO $
+			encrypt cipher (feedFile src) $ \h ->
+				pipeBup params (Just h) Nothing
 
 retrieve :: BupRepo -> Key -> AssociatedFile -> FilePath -> Annex Bool
 retrieve buprepo k _f d = do
@@ -157,6 +158,20 @@ remove _ = do
 	warning "content cannot be removed from bup remote"
 	return False
 
+{- Cannot revert having stored a key in bup, but at least the data for the
+ - key will be used for deltaing data of other keys stored later.
+ -
+ - We can, however, remove the git branch that bup created for the key.
+ -}
+rollback :: Key -> BupRepo -> Annex ()
+rollback k bupr = go =<< liftIO (bup2GitRemote bupr)
+  where
+	go r
+		| Git.repoIsUrl r = void $ onBupRemote r boolSystem "git" params
+		| otherwise = void $ liftIO $ catchMaybeIO $
+			boolSystem "git" $ Git.Command.gitCommandLine params r
+	params = [ Params "branch -D", Param (bupRef k) ]
+
 {- Bup does not provide a way to tell if a given dataset is present
  - in a bup repository. One way it to check if the git repository has
  - a branch matching the name (as created by bup split -n).
diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index 1273c2d64..922742099 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -111,7 +111,7 @@ withStoredFiles :: ChunkSize -> FilePath -> Key -> ([FilePath] -> IO Bool) -> IO
 withStoredFiles = withCheckedFiles doesFileExist
 
 store :: FilePath -> ChunkSize -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
-store d chunksize k _f p = sendAnnex k $ \src ->
+store d chunksize k _f p = sendAnnex k (void $ remove d k) $ \src ->
 	metered (Just p) k $ \meterupdate -> 
 		storeHelper d chunksize k $ \dests ->
 			case chunksize of
@@ -125,7 +125,7 @@ store d chunksize k _f p = sendAnnex k $ \src ->
 						=<< L.readFile src
 
 storeEncrypted :: FilePath -> ChunkSize -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
-storeEncrypted d chunksize (cipher, enck) k p = sendAnnex k $ \src -> 
+storeEncrypted d chunksize (cipher, enck) k p = sendAnnex k (void $ remove d enck) $ \src -> 
 	metered (Just p) k $ \meterupdate ->
 		storeHelper d chunksize enck $ \dests ->
 			encrypt cipher (feedFile src) $ readBytes $ \b ->
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 9b0617652..a5718e328 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -268,7 +268,7 @@ copyFromRemote r key file dest
 		-- run copy from perspective of remote
 		liftIO $ onLocal (repo r) $ do
 			ensureInitialized
-			Annex.Content.sendAnnex key $ \object ->
+			Annex.Content.sendAnnex key noop $ \object ->
 				upload u key file noRetry $
 					rsyncOrCopyFile params object dest
 	| Git.repoIsSsh (repo r) = feedprogressback $ \feeder -> 
@@ -333,11 +333,11 @@ copyToRemote r key file p
 	| not $ Git.repoIsUrl (repo r) =
 		guardUsable (repo r) False $ commitOnCleanup r $ copylocal
 	| Git.repoIsSsh (repo r) = commitOnCleanup r $
-		Annex.Content.sendAnnex key $ \object ->
+		Annex.Content.sendAnnex key noop $ \object ->
 			rsyncHelper (Just p) =<< rsyncParamsRemote r False key object file
 	| otherwise = error "copying to non-ssh repo not supported"
   where
-	copylocal = Annex.Content.sendAnnex key $ \object -> do
+	copylocal = Annex.Content.sendAnnex key noop $ \object -> do
 		let params = rsyncParams r
 		u <- getUUID
 		-- run copy from perspective of remote
diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs
index 37fcb0c9f..173e366d2 100644
--- a/Remote/Glacier.hs
+++ b/Remote/Glacier.hs
@@ -85,12 +85,12 @@ store r k _f m
 	| keySize k == Just 0 = do
 		warning "Cannot store empty files in Glacier."
 		return False
-	| otherwise = sendAnnex k $ \src ->
+	| otherwise = sendAnnex k (void $ remove r k) $ \src ->
 		metered (Just m) k $ \meterupdate ->
 			storeHelper r k $ streamMeteredFile src meterupdate
 
 storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
-storeEncrypted r (cipher, enck) k m = sendAnnex k $ \src -> do
+storeEncrypted r (cipher, enck) k m = sendAnnex k (void $ remove r enck) $ \src -> do
 	metered (Just m) k $ \meterupdate ->
 		storeHelper r enck $ \h ->
 			encrypt cipher (feedFile src)
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index 1b8c91d09..8b0231203 100644
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -103,12 +103,12 @@ runHook hooktype hook k f a = maybe (return False) run =<< lookupHook hooktype h
 			)
 
 store :: String -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
-store h k _f _p = sendAnnex k $ \src ->
+store h k _f _p = sendAnnex k (void $ remove h k) $ \src ->
 	runHook h "store" k (Just src) $ return True
 
 storeEncrypted :: String -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
 storeEncrypted h (cipher, enck) k _p = withTmp enck $ \tmp ->
-	sendAnnex k $ \src -> do
+	sendAnnex k (void $ remove h enck) $ \src -> do
 		liftIO $ encrypt cipher (feedFile src) $
 			readBytes $ L.writeFile tmp
 		runHook h "store" enck (Just tmp) $ return True
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index 9a38e4f1b..79d742aed 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -101,11 +101,11 @@ rsyncUrls o k = map use annexHashes
 	f = keyFile k
 
 store :: RsyncOpts -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
-store o k _f p = sendAnnex k $ rsyncSend o p k
+store o k _f p = sendAnnex k (void $ remove o k) $ rsyncSend o p k
 
 storeEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
 storeEncrypted o (cipher, enck) k p = withTmp enck $ \tmp ->
-	sendAnnex k $ \src -> do
+	sendAnnex k (void $ remove o enck) $ \src -> do
 		liftIO $ encrypt cipher (feedFile src) $
 			readBytes $ L.writeFile tmp
 		rsyncSend o p enck tmp
diff --git a/Remote/S3.hs b/Remote/S3.hs
index 7f1928608..1d24c4938 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -112,15 +112,16 @@ s3Setup u c = handlehost $ M.lookup "host" c
 			M.delete "bucket" defaults
 
 store :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
-store r k _f p = s3Action r False $ \(conn, bucket) -> sendAnnex k $ \src -> do
-	res <- storeHelper (conn, bucket) r k p src
-	s3Bool res
+store r k _f p = s3Action r False $ \(conn, bucket) -> 
+	sendAnnex k (void $ remove r k) $ \src -> do
+		res <- storeHelper (conn, bucket) r k p src
+		s3Bool res
 
 storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
 storeEncrypted r (cipher, enck) k p = s3Action r False $ \(conn, bucket) -> 
 	-- To get file size of the encrypted content, have to use a temp file.
 	-- (An alternative would be chunking to to a constant size.)
-	withTmp enck $ \tmp -> sendAnnex k $ \src -> do
+	withTmp enck $ \tmp -> sendAnnex k (void $ remove r enck) $ \src -> do
 		liftIO $ encrypt cipher (feedFile src) $
 			readBytes $ L.writeFile tmp
 		res <- storeHelper (conn, bucket) r enck p tmp
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index 21a1456bf..fe45d7df0 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -83,15 +83,17 @@ webdavSetup u c = do
 
 store :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
 store r k _f p = metered (Just p) k $ \meterupdate ->
-	davAction r False $ \(baseurl, user, pass) -> sendAnnex k $ \src ->
-		liftIO $ withMeteredFile src meterupdate $
-			storeHelper r k baseurl user pass
+	davAction r False $ \(baseurl, user, pass) -> 
+		sendAnnex k (void $ remove r k) $ \src ->
+			liftIO $ withMeteredFile src meterupdate $
+				storeHelper r k baseurl user pass
 
 storeEncrypted :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
 storeEncrypted r (cipher, enck) k p = metered (Just p) k $ \meterupdate ->
-	davAction r False $ \(baseurl, user, pass) -> sendAnnex k $ \src ->
-		liftIO $ encrypt cipher (streamMeteredFile src meterupdate) $
-			readBytes $ storeHelper r enck baseurl user pass
+	davAction r False $ \(baseurl, user, pass) ->
+		sendAnnex k (void $ remove r enck) $ \src ->
+			liftIO $ encrypt cipher (streamMeteredFile src meterupdate) $
+				readBytes $ storeHelper r enck baseurl user pass
 
 storeHelper :: Remote -> Key -> DavUrl -> DavUser -> DavPass -> L.ByteString -> IO Bool
 storeHelper r k baseurl user pass b = catchBoolIO $ do