Merge branch 'master' into watch

Command/Add.hs

@@ -12,10 +12,12 @@ import Annex.Exception
 import Command
 import qualified Annex
 import qualified Annex.Queue
-import qualified Backend
+import Backend
 import Logs.Location
 import Annex.Content
+import Annex.Perms
 import Utility.Touch
+import Utility.FileMode
 
 def :: [Command]
 def = [command "add" paramPaths seek "add files to annex"]
@@ -44,22 +46,38 @@ start file = notBareRepo $ ifAnnexed file fixup add
 			liftIO $ removeFile file
 			next $ next $ cleanup file key =<< inAnnex key
 
+{- The file that's being added is locked down before a key is generated,
+ - to prevent it from being modified in between. It's hard linked into a
+ - temporary location, and its writable bits are removed. It could still be
+ - written to by a process that already has it open for writing. -}
 perform :: FilePath -> CommandPerform
 perform file = do
-	backend <- Backend.chooseBackend file
-	Backend.genKey file backend >>= go
+	liftIO $ preventWrite file
+	tmp <- fromRepo gitAnnexTmpDir
+	createAnnexDirectory tmp
+	pid <- liftIO getProcessID
+	let tmpfile = tmp </> "add" ++ show pid ++ "." ++ takeFileName file
+	nuke tmpfile
+	liftIO $ createLink file tmpfile
+	let source = KeySource { keyFilename = file, contentLocation = tmpfile }
+	backend <- chooseBackend file
+	genKey source backend >>= go tmpfile
 	where
-		go Nothing = stop
-		go (Just (key, _)) = do
-			handle (undo file key) $ moveAnnex key file
+		go _ Nothing = stop
+		go tmpfile (Just (key, _)) = do
+			handle (undo file key) $ moveAnnex key tmpfile
+			nuke file
 			next $ cleanup file key True
 
+nuke :: FilePath -> Annex ()
+nuke file = liftIO $ whenM (doesFileExist file) $ removeFile file
+
 {- On error, put the file back so it doesn't seem to have vanished.
  - This can be called before or after the symlink is in place. -}
 undo :: FilePath -> Key -> IOException -> Annex a
 undo file key e = do
 	whenM (inAnnex key) $ do
-		liftIO $ whenM (doesFileExist file) $ removeFile file
+		nuke file
 		handle tryharder $ fromAnnex key file
 		logStatus key InfoMissing
 	throw e

Command/AddUrl.hs

@@ -11,7 +11,7 @@ import Network.URI
 
 import Common.Annex
 import Command
-import qualified Backend
+import Backend
 import qualified Command.Add
 import qualified Annex
 import qualified Backend.URL
@@ -72,8 +72,9 @@ download url file = do
 	tmp <- fromRepo $ gitAnnexTmpLocation dummykey
 	liftIO $ createDirectoryIfMissing True (parentDir tmp)
 	stopUnless (downloadUrl [url] tmp) $ do
-		backend <- Backend.chooseBackend file
-		k <- Backend.genKey tmp backend
+		backend <- chooseBackend file
+		let source = KeySource { keyFilename = file, contentLocation = file}
+		k <- genKey source backend
 		case k of
 			Nothing -> stop
 			Just (key, _) -> do

Command/Fsck.hs

@@ -16,6 +16,7 @@ import qualified Types.Backend
 import qualified Types.Key
 import qualified Backend
 import Annex.Content
+import Annex.Perms
 import Logs.Location
 import Logs.Trust
 import Annex.UUID
@@ -83,8 +84,8 @@ performRemote key file backend numcopies remote =
 		withtmp a = do
 			pid <- liftIO getProcessID
 			t <- fromRepo gitAnnexTmpDir
+			createAnnexDirectory t
 			let tmp = t </> "fsck" ++ show pid ++ "." ++ keyFile key
-			liftIO $ createDirectoryIfMissing True t
 			let cleanup = liftIO $ catchIO (removeFile tmp) (const noop)
 			cleanup
 			cleanup `after` a tmp

Command/Migrate.hs

@@ -9,7 +9,7 @@ module Command.Migrate where
 
 import Common.Annex
 import Command
-import qualified Backend
+import Backend
 import qualified Types.Key
 import Annex.Content
 import qualified Command.ReKey
@@ -23,14 +23,14 @@ seek = [withFilesInGit $ whenAnnexed start]
 start :: FilePath -> (Key, Backend) -> CommandStart
 start file (key, oldbackend) = do
 	exists <- inAnnex key
-	newbackend <- choosebackend =<< Backend.chooseBackend file
+	newbackend <- choosebackend =<< chooseBackend file
 	if (newbackend /= oldbackend || upgradableKey key) && exists
 		then do
 			showStart "migrate" file
 			next $ perform file key newbackend
 		else stop
 	where
-		choosebackend Nothing = Prelude.head <$> Backend.orderedList
+		choosebackend Nothing = Prelude.head <$> orderedList
 		choosebackend (Just backend) = return backend
 
 {- Checks if a key is upgradable to a newer representation. -}
@@ -40,25 +40,13 @@ upgradableKey key = isNothing $ Types.Key.keySize key
 
 {- Store the old backend's key in the new backend
  - The old backend's key is not dropped from it, because there may
- - be other files still pointing at that key.
- -
- - Use the same filename as the file for the temp file name, to support
- - backends that allow the filename to influence the keys they
- - generate.
- -}
+ - be other files still pointing at that key. -}
 perform :: FilePath -> Key -> Backend -> CommandPerform
 perform file oldkey newbackend = maybe stop go =<< genkey
 	where
 		go newkey = stopUnless (Command.ReKey.linkKey oldkey newkey) $
 			next $ Command.ReKey.cleanup file oldkey newkey
 		genkey = do
-			src <- inRepo $ gitAnnexLocation oldkey
-			tmp <- fromRepo gitAnnexTmpDir
-			let tmpfile = tmp </> takeFileName file
-			cleantmp tmpfile
-			liftIO $ createLink src tmpfile
-			newkey <- liftM fst <$>
-				Backend.genKey tmpfile (Just newbackend)
-			cleantmp tmpfile
-			return newkey
-		cleantmp t = liftIO $ whenM (doesFileExist t) $ removeFile t
+			content <- inRepo $ gitAnnexLocation oldkey
+			let source = KeySource { keyFilename = file, contentLocation = content }
+			liftM fst <$> genKey source (Just newbackend)