wip v6 support for assistant

Files are not yet added to v6 repos in unlocked mode.

Annex/Content/Direct.hs

@@ -21,7 +21,6 @@ module Annex.Content.Direct (
 	addInodeCache,
 	writeInodeCache,
 	compareInodeCaches,
-	compareInodeCachesWith,
 	sameInodeCache,
 	elemInodeCaches,
 	sameFileStatus,
@@ -172,9 +171,6 @@ sameFileStatus key f status = do
 		([], Nothing) -> return True
 		_ -> return False
 
-compareInodeCachesWith :: Annex InodeComparisonType
-compareInodeCachesWith = ifM inodesChanged ( return Weakly, return Strongly )
-
 {- Copies the contentfile to the associated file, if the associated
  - file has no content. If the associated file does have content,
  - even if the content differs, it's left unchanged. -}

Annex/InodeSentinal.hs

@@ -24,6 +24,9 @@ compareInodeCaches x y
 		, return False
 		)
 
+compareInodeCachesWith :: Annex InodeComparisonType
+compareInodeCachesWith = ifM inodesChanged ( return Weakly, return Strongly )
+
 {- Checks if one of the provided old InodeCache matches the current
  - version of a file. -}
 sameInodeCache :: FilePath -> [InodeCache] -> Annex Bool

Assistant/Threads/Committer.hs

@@ -31,9 +31,11 @@ import Annex.Content
 import Annex.Link
 import Annex.CatFile
 import Annex.InodeSentinal
+import Annex.Version
 import qualified Annex
 import Utility.InodeCache
 import Annex.Content.Direct
+import qualified Database.Keys
 import qualified Command.Sync
 import qualified Git.Branch
 
@@ -228,12 +230,11 @@ commitStaged msg = do
 			return ok
 
 {- OSX needs a short delay after a file is added before locking it down,
- - when using a non-direct mode repository, as pasting a file seems to
+ - as pasting a file seems to try to set file permissions or otherwise
- - try to set file permissions or otherwise access the file after closing
+ - access the file after closing it. -}
- - it. -}
 delayaddDefault :: Annex (Maybe Seconds)
 #ifdef darwin_HOST_OS
-delayaddDefault = ifM isDirect
+delayaddDefault = ifM (isDirect || versionSupportsUnlockedPointers)
 	( return Nothing
 	, return $ Just $ Seconds 1
 	)
@@ -250,12 +251,11 @@ delayaddDefault = return Nothing
  - for write by some other process, and faster checking with git-ls-files
  - that the files are not already checked into git.
  -
- - When a file is added, Inotify will notice the new symlink. So this waits
+ - When a file is added in locked mode, Inotify will notice the new symlink.
- - for additional Changes to arrive, so that the symlink has hopefully been
+ - So this waits for additional Changes to arrive, so that the symlink has
- - staged before returning, and will be committed immediately.
+ - hopefully been staged before returning, and will be committed immediately.
- -
+ - (OTOH, for kqueue, eventsCoalesce, so instead the symlink is directly
- - OTOH, for kqueue, eventsCoalesce, so instead the symlink is directly
+ - created and staged.)
- - created and staged.
  -
  - Returns a list of all changes that are ready to be committed.
  - Any pending adds that are not ready yet are put back into the ChangeChan,
@@ -265,7 +265,8 @@ handleAdds :: Bool -> Maybe Seconds -> [Change] -> Assistant [Change]
 handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do
 	let (pending, inprocess) = partition isPendingAddChange incomplete
 	direct <- liftAnnex isDirect
-	(pending', cleanup) <- if direct
+	unlocked <- liftAnnex versionSupportsUnlockedPointers
+	(pending', cleanup) <- if unlocked || direct
 		then return (pending, noop)
 		else findnew pending
 	(postponed, toadd) <- partitionEithers <$> safeToAdd havelsof delayadd pending' inprocess
@@ -276,10 +277,11 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do
 
 	returnWhen (null toadd) $ do
 		added <- addaction toadd $
-			catMaybes <$> if direct
+			catMaybes <$>
-				then adddirect toadd
+				if unlocked || direct
-				else forM toadd add
+					then addunlocked direct toadd
-		if DirWatcher.eventsCoalesce || null added || direct
+					else forM toadd add
+		if DirWatcher.eventsCoalesce || null added || unlocked || direct
 			then return $ added ++ otherchanges
 			else do
 				r <- handleAdds havelsof delayadd =<< getChanges
@@ -316,15 +318,15 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do
 			maybe (failedingest change) (done change mcache $ keyFilename ks) mkey
 	add _ = return Nothing
 
-	{- In direct mode, avoid overhead of re-injesting a renamed
+	{- Avoid overhead of re-injesting a renamed unlocked file, by
-	 - file, by examining the other Changes to see if a removed
+	 - examining the other Changes to see if a removed file has the
-	 - file has the same InodeCache as the new file. If so,
+	 - same InodeCache as the new file. If so, we can just update
-	 - we can just update bookkeeping, and stage the file in git.
+	 - bookkeeping, and stage the file in git.
 	 -}
-	adddirect :: [Change] -> Assistant [Maybe Change]
+	addunlocked :: Bool -> [Change] -> Assistant [Maybe Change]
-	adddirect toadd = do
+	addunlocked isdirect toadd = do
 		ct <- liftAnnex compareInodeCachesWith
-		m <- liftAnnex $ removedKeysMap ct cs
+		m <- liftAnnex $ removedKeysMap isdirect ct cs
 		delta <- liftAnnex getTSDelta
 		if M.null m
 			then forM toadd add
@@ -335,22 +337,33 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do
 					Just cache ->
 						case M.lookup (inodeCacheToKey ct cache) m of
 							Nothing -> add c
-							Just k -> fastadd c k
+							Just k -> if isdirect
+								then fastadddirect c k
+								else fastaddunlocked c k
 
-	fastadd :: Change -> Key -> Assistant (Maybe Change)
+	fastadddirect :: Change -> Key -> Assistant (Maybe Change)
-	fastadd change key = do
+	fastadddirect change key = do
 		let source = keySource change
 		liftAnnex $ Command.Add.finishIngestDirect key source
 		done change Nothing (keyFilename source) key
+	
+	fastaddunlocked :: Change -> Key -> Assistant (Maybe Change)
+	fastaddunlocked change key = do
+		let source = keySource change
+		liftAnnex $ do
+			Database.Keys.addAssociatedFile key (keyFilename source)
+		done change Nothing (keyFilename source) key
 
-	removedKeysMap :: InodeComparisonType -> [Change] -> Annex (M.Map InodeCacheKey Key)
+	removedKeysMap :: Bool -> InodeComparisonType -> [Change] -> Annex (M.Map InodeCacheKey Key)
-	removedKeysMap ct l = do
+	removedKeysMap isdirect ct l = do
 		mks <- forM (filter isRmChange l) $ \c ->
 			catKeyFile $ changeFile c
 		M.fromList . concat <$> mapM mkpairs (catMaybes mks)
 	  where
 		mkpairs k = map (\c -> (inodeCacheToKey ct c, k)) <$>
-			recordedInodeCache k
+			if isdirect
+				then recordedInodeCache k
+				else Database.Keys.getInodeCaches k
 
 	failedingest change = do
 		refill [retryChange change]
@@ -359,12 +372,16 @@ handleAdds havelsof delayadd cs = returnWhen (null incomplete) $ do
 
 	done change mcache file key = liftAnnex $ do
 		logStatus key InfoPresent
-		link <- ifM isDirect
+		ifM versionSupportsUnlockedPointers
-			( calcRepo $ gitAnnexLink file key
+			( stagePointerFile file =<< hashPointerFile key
-			, Command.Add.link file key mcache
+			, do
+				link <- ifM isDirect
+					( calcRepo $ gitAnnexLink file key
+					, Command.Add.link file key mcache
+					)
+				whenM (pure DirWatcher.eventsCoalesce <||> isDirect) $
+					stageSymlink file =<< hashSymlink link
 			)
-		whenM (pure DirWatcher.eventsCoalesce <||> isDirect) $
-			stageSymlink file =<< hashSymlink link
 		showEndOk
 		return $ Just $ finishedChange change key
 

Assistant/Threads/Watcher.hs

@@ -1,6 +1,6 @@
 {- git-annex assistant tree watcher
  -
- - Copyright 2012-2013 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2015 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -36,10 +36,15 @@ import Annex.CheckIgnore
 import Annex.Link
 import Annex.FileMatcher
 import Types.FileMatcher
+import Annex.Content
 import Annex.ReplaceFile
+import Annex.Version
+import Annex.InodeSentinal
 import Git.Types
 import Config
 import Utility.ThreadScheduler
+import Logs.Location
+import qualified Database.Keys
 #ifndef mingw32_HOST_OS
 import qualified Utility.Lsof as Lsof
 #endif
@@ -88,10 +93,13 @@ runWatcher = do
 	startup <- asIO1 startupScan
 	matcher <- liftAnnex largeFilesMatcher
 	direct <- liftAnnex isDirect
+	unlocked <- liftAnnex versionSupportsUnlockedPointers
 	symlinkssupported <- liftAnnex $ coreSymlinks <$> Annex.getGitConfig
-	addhook <- hook $ if direct
+	addhook <- hook $ if unlocked
-		then onAddDirect symlinkssupported matcher
+		then onAddUnlocked symlinkssupported matcher
-		else onAdd matcher
+		else if direct
+			then onAddDirect symlinkssupported matcher
+			else onAdd matcher
 	delhook <- hook onDel
 	addsymlinkhook <- hook $ onAddSymlink direct
 	deldirhook <- hook onDelDir
@@ -216,15 +224,33 @@ onAdd matcher file filestatus
 shouldRestage :: DaemonStatus -> Bool
 shouldRestage ds = scanComplete ds || forceRestage ds
 
+onAddUnlocked :: Bool -> FileMatcher Annex -> Handler
+onAddUnlocked = onAddUnlocked' False contentchanged Database.Keys.addAssociatedFile samefilestatus
+  where
+	samefilestatus key file status = do
+		cache <- Database.Keys.getInodeCaches key
+		curr <- withTSDelta $ \delta -> liftIO $ toInodeCache delta file status
+		case (cache, curr) of
+			(_, Just c) -> elemInodeCaches c cache
+			([], Nothing) -> return True
+			_ -> return False
+	contentchanged oldkey file = do
+		Database.Keys.removeAssociatedFile oldkey file
+		unlessM (inAnnex oldkey) $
+			logStatus oldkey InfoMissing
+
 {- In direct mode, add events are received for both new files, and
  - modified existing files.
  -}
 onAddDirect :: Bool -> FileMatcher Annex -> Handler
-onAddDirect symlinkssupported matcher file fs = do
+onAddDirect = onAddUnlocked' True changedDirect (\k f -> void $ addAssociatedFile k f) sameFileStatus
+
+onAddUnlocked' :: Bool -> (Key -> FilePath -> Annex ()) -> (Key -> FilePath -> Annex ()) -> (Key -> FilePath -> FileStatus -> Annex Bool) -> Bool -> FileMatcher Annex -> Handler
+onAddUnlocked' isdirect contentchanged addassociatedfile samefilestatus symlinkssupported matcher file fs = do
 	v <- liftAnnex $ catKeyFile file
 	case (v, fs) of
 		(Just key, Just filestatus) ->
-			ifM (liftAnnex $ sameFileStatus key file filestatus)
+			ifM (liftAnnex $ samefilestatus key file filestatus)
 				{- It's possible to get an add event for
 				 - an existing file that is not
 				 - really modified, but it might have
@@ -237,13 +263,13 @@ onAddDirect symlinkssupported matcher file fs = do
 					, noChange
 					)
 				, guardSymlinkStandin (Just key) $ do
-					debug ["changed direct", file]
+					debug ["changed", file]
-					liftAnnex $ changedDirect key file
+					liftAnnex $ contentchanged key file
 					add matcher file
 				)
 		_ -> unlessIgnored file $
 			guardSymlinkStandin Nothing $ do
-				debug ["add direct", file]
+				debug ["add", file]
 				add matcher file
   where
 	{- On a filesystem without symlinks, we'll get changes for regular
@@ -259,9 +285,9 @@ onAddDirect symlinkssupported matcher file fs = do
 				Just lt -> do
 					case fileKey $ takeFileName lt of
 						Nothing -> noop
-						Just key -> void $ liftAnnex $
+						Just key -> liftAnnex $
-							addAssociatedFile key file
+							addassociatedfile key file
-					onAddSymlink' linktarget mk True file fs
+					onAddSymlink' linktarget mk isdirect file fs
 
 {- A symlink might be an arbitrary symlink, which is just added.
  - Or, if it is a git-annex symlink, ensure it points to the content
@@ -330,13 +356,15 @@ onDel file _ = do
 
 onDel' :: FilePath -> Annex ()
 onDel' file = do
-	whenM isDirect $ do
+	ifM versionSupportsUnlockedPointers
-		mkey <- catKeyFile file
+		( withkey $ flip Database.Keys.removeAssociatedFile file
-		case mkey of
+		, whenM isDirect $
-			Nothing -> noop
+			withkey $ \key -> void $ removeAssociatedFile key file
-			Just key -> void $ removeAssociatedFile key file
+		)
 	Annex.Queue.addUpdateIndex =<<
 		inRepo (Git.UpdateIndex.unstageFile file)
+  where
+	withkey a = maybe noop a =<< catKeyFile file
 
 {- A directory has been deleted, or moved, so tell git to remove anything
  - that was inside it from its cache. Since it could reappear at any time,

debian/changelog

@@ -4,16 +4,18 @@ git-annex (6.20151225) unstable; urgency=medium
   * The upgrade to version 6 is not done fully automatically, because
     upgrading a direct mode repository to version 6 will prevent old
     versions of git-annex from working in other clones of that repository.
+  * init: --version parameter added to control which supported repository
+    version to use.
   * smudge: New command, used for git smudge filter. 
     This will replace direct mode.
-  * init: Configure .git/info/attributes to use git-annex as a smudge
+  * init, upgrade: Configure .git/info/attributes to use git-annex as a smudge
     filter. Note that this changes the default behavior of git add in a
     newly initialized repository; it will add files to the annex.
   * unlock, lock: In v6 mode, unlocking a file changes it from a symlink to a
     pointer file, and this change can be committed to the git repository.
   * add: In v6 mode, adds modified files to the annex.
-  * init: --version parameter added to control which supported repository
+  * assistant: In v6 mode, adds files in unlocked mode, so they can
-    version to use.
+    continue to be modified. TODO
  
  -- Joey Hess <id@joeyh.name>  Tue, 08 Dec 2015 11:14:03 -0400
 

doc/todo/smudge.mdwn

@@ -323,8 +323,6 @@ files to be unlocked, while the indirect upgrades don't touch the files.
 
 * Still a few test suite failues for v6 with locked files.
 * Test suite should make pass for v6 with unlocked files.
-* assistant: In v6 mode, adds files in unlocked mode, so they can
-  continue to be modified. TODO
 * When the webapp creates a repo, it forces it into direct mode. But that
   will fail when annex.version=6. Long-term, the assistant should make v6
   repos, but short-term, the assistant should make v5 repos in direct mode.