From ee0c34c8f2f94775b39ef10ed580cab47d2f929c Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Mon, 7 Dec 2015 15:22:01 -0400
Subject: support pointer files

Backend.lookupFile is changed to always fall back to catKey when
operating on a file that's not a symlink.

catKey is changed to understand pointer files, as well as annex symlinks.

Before, catKey needed a file mode witness, to be sure it was looking at a
symlink. That was complicated stuff. Now, it doesn't actually care if a
file in git is a symlink or not; in either case asking git for the content
of the file will get the pointer to the key.

This does mean that git-annex will treat a link
foo -> WORM--bar as a git-annex file, and also treats
a regular file containing annex/objects/WORM--bar as a git-annex file.

Calling catKey could make git-annex commands need to do more work than
before. This would especially be the case if a repo contained many regular
files, and only a few annexed files, as now git-annex will need to ask
git about the contents of the regular files.
---
 CmdLine/Seek.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'CmdLine/Seek.hs')

diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs
index 8d253e47d..0b6cc1e78 100644
--- a/CmdLine/Seek.hs
+++ b/CmdLine/Seek.hs
@@ -80,7 +80,7 @@ withFilesInRefs a = mapM_ go
 		l <- inRepo $ LsTree.lsTree (Git.Ref r)
 		forM_ l $ \i -> do
 			let f = getTopFilePath $ LsTree.file i
-			v <- catKey (Git.Ref $ LsTree.sha i) (LsTree.mode i)
+			v <- catKey (Git.Ref $ LsTree.sha i)
 			case v of
 				Nothing -> noop
 				Just k -> whenM (matcher $ MatchingKey k) $
-- 
cgit v1.2.3


From 855c0dd645f53da3ad10320605ef4e5e6276305b Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Wed, 9 Dec 2015 15:18:25 -0400
Subject: avoid pre-commit hook messing up new-style unlocked files in v6 repo

---
 Annex/Version.hs              |  6 ++++++
 CmdLine/Seek.hs               |  2 +-
 Command/PreCommit.hs          | 15 +++++++++++----
 doc/git-annex-pre-commit.mdwn |  8 ++++++--
 4 files changed, 24 insertions(+), 7 deletions(-)

(limited to 'CmdLine/Seek.hs')

diff --git a/Annex/Version.hs b/Annex/Version.hs
index f9b24d9c4..4c2a990fa 100644
--- a/Annex/Version.hs
+++ b/Annex/Version.hs
@@ -43,6 +43,12 @@ versionSupportsDirectMode = go <$> getVersion
 	go (Just "6") = False
 	go _ = True
 
+versionSupportsUnlockedPointers :: Annex Bool
+versionSupportsUnlockedPointers = go <$> getVersion
+  where
+	go (Just "6") = True
+	go _ = False
+
 setVersion :: Version -> Annex ()
 setVersion = setConfig versionField
 
diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs
index 0b6cc1e78..48545ce04 100644
--- a/CmdLine/Seek.hs
+++ b/CmdLine/Seek.hs
@@ -115,7 +115,7 @@ withPairs a params = seekActions $ return $ map a $ pairs [] params
 	pairs c (x:y:xs) = pairs ((x,y):c) xs
 	pairs _ _ = error "expected pairs"
 
-withFilesToBeCommitted :: (String -> CommandStart) -> CmdParams -> CommandSeek
+withFilesToBeCommitted :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek
 withFilesToBeCommitted a params = seekActions $ prepFiltered a $
 	seekHelper LsFiles.stagedNotDeleted params
 
diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs
index 2d62b51f3..b6f52d01c 100644
--- a/Command/PreCommit.hs
+++ b/Command/PreCommit.hs
@@ -16,7 +16,9 @@ import qualified Command.Add
 import qualified Command.Fix
 import Annex.Direct
 import Annex.Hook
+import Annex.Link
 import Annex.View
+import Annex.Version
 import Annex.View.ViewedFile
 import Annex.LockFile
 import Logs.View
@@ -49,9 +51,14 @@ seek ps = lockPreCommitHook $ ifM isDirect
 				void $ liftIO cleanup
 			, do
 				-- fix symlinks to files being committed
-				withFilesToBeCommitted (whenAnnexed Command.Fix.start) ps
+				flip withFilesToBeCommitted ps $ \f -> 
+					maybe stop (Command.Fix.start f)
+						=<< isAnnexLink f
 				-- inject unlocked files into the annex
-				withFilesUnlockedToBeCommitted startIndirect ps
+				-- (not needed when repo version uses
+				-- unlocked pointer files)
+				unlessM versionSupportsUnlockedPointers $
+					withFilesUnlockedToBeCommitted startInjectUnlocked ps
 			)
 		runAnnexHook preCommitAnnexHook
 		-- committing changes to a view updates metadata
@@ -64,8 +71,8 @@ seek ps = lockPreCommitHook $ ifM isDirect
 	)
 	
 
-startIndirect :: FilePath -> CommandStart
-startIndirect f = next $ do
+startInjectUnlocked :: FilePath -> CommandStart
+startInjectUnlocked f = next $ do
 	unlessM (callCommandAction $ Command.Add.start f) $
 		error $ "failed to add " ++ f ++ "; canceling commit"
 	next $ return True
diff --git a/doc/git-annex-pre-commit.mdwn b/doc/git-annex-pre-commit.mdwn
index bc1e86e18..21e5aef68 100644
--- a/doc/git-annex-pre-commit.mdwn
+++ b/doc/git-annex-pre-commit.mdwn
@@ -12,10 +12,14 @@ This is meant to be called from git's pre-commit hook. `git annex init`
 automatically creates a pre-commit hook using this.
 
 Fixes up symlinks that are staged as part of a commit, to ensure they
-point to annexed content. Also handles injecting changes to unlocked
-files into the annex. When in a view, updates metadata to reflect changes
+point to annexed content.
+
+When in a view, updates metadata to reflect changes
 made to files in the view.
 
+When in a repository that has not been upgraded to annex.version 6, 
+also handles injecting changes to unlocked files into the annex. 
+
 # SEE ALSO
 
 [[git-annex]](1)
-- 
cgit v1.2.3


From 12a4ebb4758c65a51a419e42322edfe7fae8f8f9 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Fri, 11 Dec 2015 16:05:56 -0400
Subject: fsck for v6 unlocked files

This only adds 1 stat to each file fscked for locked files, so
added overhead is minimal.

For unlocked files it has to access the database to see if a file
is modified.
---
 CmdLine/Seek.hs      |  2 +-
 Command/Fsck.hs      | 99 +++++++++++++++++++++++++++++++++-------------------
 Command/Migrate.hs   |  2 +-
 doc/todo/smudge.mdwn |  1 -
 4 files changed, 66 insertions(+), 38 deletions(-)

(limited to 'CmdLine/Seek.hs')

diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs
index 48545ce04..f4ac4dfad 100644
--- a/CmdLine/Seek.hs
+++ b/CmdLine/Seek.hs
@@ -125,7 +125,7 @@ withFilesUnlocked = withFilesUnlocked' LsFiles.typeChanged
 withFilesUnlockedToBeCommitted :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek
 withFilesUnlockedToBeCommitted = withFilesUnlocked' LsFiles.typeChangedStaged
 
-{- Unlocked files have changed type from a symlink to a regular file.
+{- Unlocked files before v6 have changed type from a symlink to a regular file.
  -
  - Furthermore, unlocked files used to be a git-annex symlink,
  - not some other sort of symlink.
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index 1531d2ab7..74e83670c 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -34,6 +34,7 @@ import Utility.HumanTime
 import Utility.CopyFile
 import Git.FilePath
 import Utility.PID
+import qualified Database.Keys
 
 #ifdef WITH_DATABASE
 import qualified Database.Fsck as FsckDb
@@ -118,16 +119,18 @@ start from inc file key = do
 	go = runFsck inc file key
 
 perform :: Key -> FilePath -> Backend -> NumCopies -> Annex Bool
-perform key file backend numcopies = check
-	-- order matters
-	[ fixLink key file
-	, verifyLocationLog key file
-	, verifyDirectMapping key file
-	, verifyDirectMode key file
-	, checkKeySize key
-	, checkBackend backend key (Just file)
-	, checkKeyNumCopies key (Just file) numcopies
-	]
+perform key file backend numcopies = do
+	keystatus <- getKeyStatus key
+	check
+		-- order matters
+		[ fixLink key file
+		, verifyLocationLog key keystatus file
+		, verifyDirectMapping key file
+		, verifyDirectMode key file
+		, checkKeySize key keystatus
+		, checkBackend backend key keystatus (Just file)
+		, checkKeyNumCopies key (Just file) numcopies
+		]
 
 {- To fsck a remote, the content is retrieved to a tmp file,
  - and checked locally. -}
@@ -183,19 +186,19 @@ startKey inc key numcopies =
 			performKey key backend numcopies
 
 performKey :: Key -> Backend -> NumCopies -> Annex Bool
-performKey key backend numcopies = check
-	[ verifyLocationLog key (key2file key)
-	, checkKeySize key
-	, checkBackend backend key Nothing
-	, checkKeyNumCopies key Nothing numcopies
-	]
+performKey key backend numcopies = do
+	keystatus <- getKeyStatus key
+	check
+		[ verifyLocationLog key keystatus (key2file key)
+		, checkKeySize key keystatus
+		, checkBackend backend key keystatus Nothing
+		, checkKeyNumCopies key Nothing numcopies
+		]
 
 check :: [Annex Bool] -> Annex Bool
 check cs = and <$> sequence cs
 
-{- Checks that the file's link points correctly to the content.
- -
- - In direct mode, there is only a link when the content is not present.
+{- Checks that symlinks points correctly to the annexed content.
  -}
 fixLink :: Key -> FilePath -> Annex Bool
 fixLink key file = do
@@ -214,19 +217,23 @@ fixLink key file = do
 
 {- Checks that the location log reflects the current status of the key,
  - in this repository only. -}
-verifyLocationLog :: Key -> String -> Annex Bool
-verifyLocationLog key desc = do
-	present <- inAnnex key
+verifyLocationLog :: Key -> KeyStatus -> String -> Annex Bool
+verifyLocationLog key keystatus desc = do
+	obj <- calcRepo $ gitAnnexLocation key
+	present <- if isKeyUnlocked keystatus
+		then liftIO (doesFileExist obj)
+		else inAnnex key
 	direct <- isDirect
 	u <- getUUID
 	
-	{- Since we're checking that a key's file is present, throw
+	{- Since we're checking that a key's object file is present, throw
 	 - in a permission fixup here too. -}
-	file <- calcRepo $ gitAnnexLocation key
-	when (present && not direct) $
-		freezeContent file
-	whenM (liftIO $ doesDirectoryExist $ parentDir file) $
-		freezeContentDir file
+	when (present && not direct) $ void $ tryIO $
+		if isKeyUnlocked keystatus
+			then thawContent obj
+			else freezeContent obj
+	whenM (liftIO $ doesDirectoryExist $ parentDir obj) $
+		freezeContentDir obj
 
 	{- In direct mode, modified files will show up as not present,
 	 - but that is expected and not something to do anything about. -}
@@ -288,10 +295,11 @@ verifyDirectMode key file = do
 {- The size of the data for a key is checked against the size encoded in
  - the key's metadata, if available.
  -
- - Not checked in direct mode, because files can be changed directly.
+ - Not checked when a file is unlocked, or in direct mode.
  -}
-checkKeySize :: Key -> Annex Bool
-checkKeySize key = ifM isDirect
+checkKeySize :: Key -> KeyStatus -> Annex Bool
+checkKeySize _ KeyUnlocked = return True
+checkKeySize key KeyLocked = ifM isDirect
 	( return True
 	, do
 		file <- calcRepo $ gitAnnexLocation key
@@ -326,18 +334,26 @@ checkKeySizeOr bad key file = case Types.Key.keySize key of
 			, msg
 			]
 
-{- Runs the backend specific check on a key's content.
+{- Runs the backend specific check on a key's content object.
+ -
+ - When a file is unlocked, it may be a hard link to the object,
+ - thus when the user modifies the file, the object will be modified and
+ - not pass the check, and we don't want to find an error in this case.
+ - So, skip the check if the key is unlocked and modified.
  -
  - In direct mode this is not done if the file has clearly been modified,
  - because modification of direct mode files is allowed. It's still done
  - if the file does not appear modified, to catch disk corruption, etc.
  -}
-checkBackend :: Backend -> Key -> Maybe FilePath -> Annex Bool
-checkBackend backend key mfile = go =<< isDirect
+checkBackend :: Backend -> Key -> KeyStatus -> Maybe FilePath -> Annex Bool
+checkBackend backend key keystatus mfile = go =<< isDirect
   where
 	go False = do
 		content <- calcRepo $ gitAnnexLocation key
-		checkBackendOr badContent backend key content
+		ifM (pure (isKeyUnlocked keystatus) <&&> (not <$> isUnmodified key content))
+			( nocheck
+			, checkBackendOr badContent backend key content
+			)
 	go True = maybe nocheck checkdirect mfile
 	checkdirect file = ifM (goodContent key file)
 		( checkBackendOr' (badContentDirect file) backend key file
@@ -582,3 +598,16 @@ withFsckDb (StartIncremental h) a = a h
 withFsckDb NonIncremental _ = noop
 withFsckDb (ScheduleIncremental _ _ i) a = withFsckDb i a
 #endif
+
+data KeyStatus = KeyLocked | KeyUnlocked
+
+isKeyUnlocked :: KeyStatus -> Bool
+isKeyUnlocked KeyUnlocked = True
+isKeyUnlocked KeyLocked = False
+
+getKeyStatus :: Key -> Annex KeyStatus
+getKeyStatus key = do
+	obj <- calcRepo $ gitAnnexLocation key
+	unlocked <- ((> 1) . linkCount <$> liftIO (getFileStatus obj))
+		<&&> (not . null <$> Database.Keys.getAssociatedFiles key)
+	return $ if unlocked then KeyUnlocked else KeyLocked
diff --git a/Command/Migrate.hs b/Command/Migrate.hs
index d1c7902d7..b8d2eea87 100644
--- a/Command/Migrate.hs
+++ b/Command/Migrate.hs
@@ -72,7 +72,7 @@ perform file oldkey oldbackend newbackend = go =<< genkey
 	go (Just (newkey, knowngoodcontent))
 		| knowngoodcontent = finish newkey
 		| otherwise = stopUnless checkcontent $ finish newkey
-	checkcontent = Command.Fsck.checkBackend oldbackend oldkey $ Just file
+	checkcontent = Command.Fsck.checkBackend oldbackend oldkey Command.Fsck.KeyLocked $ Just file
 	finish newkey = stopUnless (Command.ReKey.linkKey oldkey newkey) $
 		next $ Command.ReKey.cleanup file oldkey newkey
 	genkey = case maybe Nothing (\fm -> fm oldkey newbackend (Just file)) (fastMigrate oldbackend) of
diff --git a/doc/todo/smudge.mdwn b/doc/todo/smudge.mdwn
index ce1db34a2..5cff8672c 100644
--- a/doc/todo/smudge.mdwn
+++ b/doc/todo/smudge.mdwn
@@ -336,7 +336,6 @@ files to be unlocked, while the indirect upgrades don't touch the files.
   long-lived processes.
 * Make v6 upgrade convert direct mode repo to repo with all unlocked
   files.
-* fsck will need some fixes to handle unlocked files.
 * Make automatic merge conflict resolution work for pointer files.
   - Should probably automatically handle merge conflicts between annex
     symlinks and pointer files too. Maybe by always resulting in a pointer
-- 
cgit v1.2.3


From 4419ed21e64d5713e83503b1b9b6120ba10cd1b6 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 15 Dec 2015 14:08:07 -0400
Subject: rename stuff for v5 unlocked files to indicate it's old

---
 CmdLine/Seek.hs      | 18 +++++++++---------
 Command/Add.hs       |  2 +-
 Command/Lock.hs      |  4 ++--
 Command/PreCommit.hs |  4 ++--
 4 files changed, 14 insertions(+), 14 deletions(-)

(limited to 'CmdLine/Seek.hs')

diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs
index f4ac4dfad..e6ee6f3fe 100644
--- a/CmdLine/Seek.hs
+++ b/CmdLine/Seek.hs
@@ -119,25 +119,25 @@ withFilesToBeCommitted :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek
 withFilesToBeCommitted a params = seekActions $ prepFiltered a $
 	seekHelper LsFiles.stagedNotDeleted params
 
-withFilesUnlocked :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek
-withFilesUnlocked = withFilesUnlocked' LsFiles.typeChanged
+withFilesOldUnlocked :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek
+withFilesOldUnlocked = withFilesOldUnlocked' LsFiles.typeChanged
 
-withFilesUnlockedToBeCommitted :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek
-withFilesUnlockedToBeCommitted = withFilesUnlocked' LsFiles.typeChangedStaged
+withFilesOldUnlockedToBeCommitted :: (FilePath -> CommandStart) -> CmdParams -> CommandSeek
+withFilesOldUnlockedToBeCommitted = withFilesOldUnlocked' LsFiles.typeChangedStaged
 
 {- Unlocked files before v6 have changed type from a symlink to a regular file.
  -
  - Furthermore, unlocked files used to be a git-annex symlink,
  - not some other sort of symlink.
  -}
-withFilesUnlocked' :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> (FilePath -> CommandStart) -> CmdParams -> CommandSeek
-withFilesUnlocked' typechanged a params = seekActions $
+withFilesOldUnlocked' :: ([FilePath] -> Git.Repo -> IO ([FilePath], IO Bool)) -> (FilePath -> CommandStart) -> CmdParams -> CommandSeek
+withFilesOldUnlocked' typechanged a params = seekActions $
 	prepFiltered a unlockedfiles
   where
-	unlockedfiles = filterM isUnlocked =<< seekHelper typechanged params
+	unlockedfiles = filterM isOldUnlocked =<< seekHelper typechanged params
 
-isUnlocked :: FilePath -> Annex Bool
-isUnlocked f = liftIO (notSymlink f) <&&> 
+isOldUnlocked :: FilePath -> Annex Bool
+isOldUnlocked f = liftIO (notSymlink f) <&&> 
 	(isJust <$> catKeyFile f <||> isJust <$> catKeyFileHEAD f)
 
 {- Finds files that may be modified. -}
diff --git a/Command/Add.hs b/Command/Add.hs
index 948a0d94c..a0bcf789e 100644
--- a/Command/Add.hs
+++ b/Command/Add.hs
@@ -69,7 +69,7 @@ seek o = allowConcurrentOutput $ do
 	ifM isDirect
 		( go withFilesMaybeModified
 		, unlessM versionSupportsUnlockedPointers $
-			go withFilesUnlocked
+			go withFilesOldUnlocked
 		)
 
 {- Pass file off to git-add. -}
diff --git a/Command/Lock.hs b/Command/Lock.hs
index 3eceaefe4..16ddce942 100644
--- a/Command/Lock.hs
+++ b/Command/Lock.hs
@@ -32,8 +32,8 @@ seek :: CmdParams -> CommandSeek
 seek ps = ifM versionSupportsUnlockedPointers
 	( withFilesInGit (whenAnnexed startNew) ps
 	, do
-		withFilesUnlocked startOld ps
-		withFilesUnlockedToBeCommitted startOld ps
+		withFilesOldUnlocked startOld ps
+		withFilesOldUnlockedToBeCommitted startOld ps
 	)
 
 startNew :: FilePath -> Key -> CommandStart
diff --git a/Command/PreCommit.hs b/Command/PreCommit.hs
index b6f52d01c..71a9f86f8 100644
--- a/Command/PreCommit.hs
+++ b/Command/PreCommit.hs
@@ -46,7 +46,7 @@ seek ps = lockPreCommitHook $ ifM isDirect
 		ifM (liftIO Git.haveFalseIndex)
 			( do
 				(fs, cleanup) <- inRepo $ Git.typeChangedStaged ps
-				whenM (anyM isUnlocked fs) $
+				whenM (anyM isOldUnlocked fs) $
 					error "Cannot make a partial commit with unlocked annexed files. You should `git annex add` the files you want to commit, and then run git commit."
 				void $ liftIO cleanup
 			, do
@@ -58,7 +58,7 @@ seek ps = lockPreCommitHook $ ifM isDirect
 				-- (not needed when repo version uses
 				-- unlocked pointer files)
 				unlessM versionSupportsUnlockedPointers $
-					withFilesUnlockedToBeCommitted startInjectUnlocked ps
+					withFilesOldUnlockedToBeCommitted startInjectUnlocked ps
 			)
 		runAnnexHook preCommitAnnexHook
 		-- committing changes to a view updates metadata
-- 
cgit v1.2.3