git-annex 6.20161012 → 6.20161027

raw patch · 21 files changed

+197/−85 lines, 21 files

Files

• Annex/Ingest.hs +3/−4
• Annex/Init.hs +2/−2
• Annex/Locations.hs +5/−0
• Annex/Ssh.hs +39/−9
• Annex/WorkTree.hs +51/−1
• CHANGELOG +23/−0
• Command/Get.hs +1/−1
• Command/ImportFeed.hs +1/−1
• Command/Lock.hs +19/−21
• Command/Move.hs +2/−2
• Command/SendKey.hs +1/−0
• Command/Unlock.hs +1/−1
• Database/Keys.hs +1/−34
• Database/Keys/SQL.hs +12/−0
• Git/Fsck.hs +1/−1
• Remote/Git.hs +2/−2
• Test.hs +18/−0
• Upgrade/V5.hs +2/−1
• Utility/Gpg.hs +8/−1
• doc/git-annex-unannex.mdwn +4/−3
• git-annex.cabal +1/−1

@@ -244,10 +244,9 @@ 	topf <- inRepo (toTopFilePath file) 	oldkeys <- filter (/= newkey) 		<$> Database.Keys.getAssociatedKey topf-	forM_ oldkeys $ \key -> do-		obj <- calcRepo (gitAnnexLocation key)-		caches <- Database.Keys.getInodeCaches key-		unlessM (sameInodeCache obj caches) $ do+	forM_ oldkeys $ \key ->+		unlessM (isUnmodified key =<< calcRepo (gitAnnexLocation key)) $ do+			caches <- Database.Keys.getInodeCaches key 			unlinkAnnex key 			fs <- filter (/= ingestedf) 				. map (`fromTopFilePath` g)

@@ -31,6 +31,7 @@ import Annex.Difference import Annex.UUID import Annex.Link+import Annex.WorkTree import Config import Annex.Direct import Annex.AdjustedBranch@@ -39,7 +40,6 @@ import Annex.InodeSentinal import Upgrade import Annex.Perms-import qualified Database.Keys import Utility.UserInfo #ifndef mingw32_HOST_OS import Utility.FileMode@@ -90,7 +90,7 @@ 		setVersion (fromMaybe defaultVersion mversion) 	whenM versionSupportsUnlockedPointers $ do 		configureSmudgeFilter-		Database.Keys.scanAssociatedFiles+		scanUnlockedFiles 	v <- checkAdjustedClone 	case v of 		NeedUpgradeForAdjustedClone -> 

@@ -63,6 +63,7 @@ 	gitAnnexUrlFile, 	gitAnnexTmpCfgFile, 	gitAnnexSshDir,+	gitAnnexSshConfig, 	gitAnnexRemotesDir, 	gitAnnexAssistantDefaultDir, 	HashLevels(..),@@ -401,6 +402,10 @@ {- .git/annex/ssh/ is used for ssh connection caching -} gitAnnexSshDir :: Git.Repo -> FilePath gitAnnexSshDir r = addTrailingPathSeparator $ gitAnnexDir r </> "ssh"++{- .git/annex/ssh.config is used to configure ssh. -}+gitAnnexSshConfig :: Git.Repo -> FilePath+gitAnnexSshConfig r = gitAnnexDir r </> "ssh.config"  {- .git/annex/remotes/ is used for remote-specific state. -} gitAnnexRemotesDir :: Git.Repo -> FilePath

@@ -33,6 +33,7 @@ import Config import Annex.Path import Utility.Env+import Utility.Tmp import Types.CleanupActions import Git.Env #ifndef mingw32_HOST_OS@@ -49,13 +50,33 @@ 	go (Just socketfile, params) = do 		prepSocket socketfile 		ret params-	ret ps = return $ concat-		[ ps-		, map Param (remoteAnnexSshOptions gc)-		, opts-		, portParams port-		, [Param "-T"]-		]+	ret ps = do+		overideconfigfile <- fromRepo gitAnnexSshConfig+		-- We assume that the file content does not change.+		-- If it did, a more expensive test would be needed.+		liftIO $ unlessM (doesFileExist overideconfigfile) $+			viaTmp writeFile overideconfigfile $ unlines+				-- ssh expands "~"+				[ "Include ~/.ssh/config"+				-- ssh will silently skip the file+				-- if it does not exist+				, "Include /etc/ssh/ssh_config"+				-- Everything below this point is only+				-- used if there's no setting for it in+				-- the above files.+				--+				-- Make sure that ssh detects stalled+				-- connections.+				, "ServerAliveInterval 60"+				]+		return $ concat+			[ ps+			, [Param "-F", File overideconfigfile]+			, map Param (remoteAnnexSshOptions gc)+			, opts+			, portParams port+			, [Param "-T"]+			]  {- Returns a filename to use for a ssh connection caching socket, and  - parameters to enable ssh connection caching. -}@@ -136,11 +157,20 @@ 	liftIO $ createDirectoryIfMissing True $ parentDir socketfile 	lockFileCached $ socket2lock socketfile +{- Find ssh socket files.+ -+ - The check that the lock file exists makes only socket files+ - that were set up by prepSocket be found. On some NFS systems,+ - a deleted socket file may linger for a while under another filename;+ - and this check makes such files be skipped since the corresponding lock+ - file won't exist.+ -} enumSocketFiles :: Annex [FilePath]-enumSocketFiles = go =<< sshCacheDir+enumSocketFiles = liftIO . go =<< sshCacheDir   where 	go Nothing = return []-	go (Just dir) = liftIO $ filter (not . isLock)+	go (Just dir) = filterM (doesFileExist . socket2lock)+		=<< filter (not . isLock) 		<$> catchDefaultIO [] (dirContents dir)  {- Stop any unused ssh connection caching processes. -}

@@ -1,6 +1,6 @@ {- git-annex worktree files  -- - Copyright 2013-2015 Joey Hess <id@joeyh.name>+ - Copyright 2013-2016 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -11,7 +11,17 @@ import Annex.Link import Annex.CatFile import Annex.Version+import Annex.Content+import Annex.ReplaceFile import Config+import Git.FilePath+import qualified Git.Ref+import qualified Git.Branch+import qualified Git.LsTree+import qualified Git.Types+import Database.Types+import qualified Database.Keys+import qualified Database.Keys.SQL  {- Looks up the key corresponding to an annexed file in the work tree,  - by examining what the file links to.@@ -41,3 +51,43 @@  ifAnnexed :: FilePath -> (Key -> Annex a) -> Annex a -> Annex a ifAnnexed file yes no = maybe no yes =<< lookupFile file++{- Find all unlocked files and update the keys database for them. + - + - This is expensive, and so normally the associated files are updated+ - incrementally when changes are noticed. So, this only needs to be done+ - when initializing/upgrading a v6 mode repository.+ -+ - Also, the content for the unlocked file may already be present as+ - an annex object. If so, make the unlocked file use that content.+ -}+scanUnlockedFiles :: Annex ()+scanUnlockedFiles = whenM (isJust <$> inRepo Git.Branch.current) $ do+	showSideAction "scanning for unlocked files"+	Database.Keys.runWriter $+		liftIO . Database.Keys.SQL.dropAllAssociatedFiles+	(l, cleanup) <- inRepo $ Git.LsTree.lsTree Git.Ref.headRef+	forM_ l $ \i -> +		when (isregfile i) $+			maybe noop (add i)+				=<< catKey (Git.LsTree.sha i)+	liftIO $ void cleanup+  where+	isregfile i = case Git.Types.toBlobType (Git.LsTree.mode i) of+		Just Git.Types.FileBlob -> True+		Just Git.Types.ExecutableBlob -> True+		_ -> False+	add i k = do+		let tf = Git.LsTree.file i+		Database.Keys.runWriter $+			liftIO . Database.Keys.SQL.addAssociatedFileFast (toIKey k) tf+		whenM (inAnnex k) $ do+			f <- fromRepo $ fromTopFilePath tf+			destmode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus f+			replaceFile f $ \tmp -> do+				r <- linkFromAnnex k tmp destmode+				case r of+					LinkAnnexOk -> return ()+					LinkAnnexNoop -> return ()+					LinkAnnexFailed -> liftIO $+						writePointerFile tmp k destmode

@@ -1,3 +1,26 @@+git-annex (6.20161027) unstable; urgency=medium++  * lock, smudge: Fix edge cases where data loss could occur in v6 mode+    when the keys database was not populated.+  * upgrade: Handle upgrade to v6 when the repository already contains+    v6 unlocked files whose content is already present.+  * Improve style of offline html build of website.+  * importfeed: Drop URL parameters from file extension.+    Thanks, James MacMahon.+  * Assistant, repair: Improved filtering out of git fsck lines about+    duplicate file entries in tree objects.+  * test: Deal with gpg-agent behavior change that broke the test suite.+  * Improve ssh socket cleanup code to skip over the cruft that+    NFS sometimes puts in a directory when a file is being deleted.+  * If a transfer fails for some reason, but some data managed to be sent,+    the transfer will be retried. (The assistant already did this.)+  * Run ssh with ServerAliveInterval 60, so that stalled transfers will+    be noticed within about 3 minutes.+    (Any setting in your ~/.ssh/config or /etc/ssh/ssh_config +    overrides this.)++ -- Joey Hess <id@joeyh.name>  Thu, 27 Oct 2016 15:21:58 -0400+ git-annex (6.20161012) unstable; urgency=medium    * Optimisations to time it takes git-annex to walk working tree and find

@@ -109,7 +109,7 @@ 			either (const False) id <$> Remote.hasKey r key 		| otherwise = return True 	docopy r witness = getViaTmp (RemoteVerify r) key $ \dest ->-		download (Remote.uuid r) key afile noRetry+		download (Remote.uuid r) key afile forwardRetry 			(\p -> do 				showAction $ "from " ++ Remote.name r 				Remote.retrieveKeyFile r key afile dest p

@@ -161,7 +161,7 @@ performDownload :: ImportFeedOptions -> Cache -> ToDownload -> Annex Bool performDownload opts cache todownload = case location todownload of 	Enclosure url -> checkknown url $-		rundownload url (takeExtension url) $ \f -> do+		rundownload url (takeWhile (/= '?') $ takeExtension url) $ \f -> do 			r <- Remote.claimingUrl url 			if Remote.uuid r == webUUID || rawOption opts 				then do

@@ -45,27 +45,27 @@ 	)   where 	go (Just key')-		| key' == key = cont True+		| key' == key = cont 		| otherwise = errorModified 	go Nothing =  		ifM (isUnmodified key file) -			( cont False+			( cont 			, ifM (Annex.getState Annex.force)-				( cont True+				( cont 				, errorModified 				) 			)-	cont = next . performNew file key+	cont = next $ performNew file key -performNew :: FilePath -> Key -> Bool -> CommandPerform-performNew file key filemodified = do+performNew :: FilePath -> Key -> CommandPerform+performNew file key = do 	lockdown =<< calcRepo (gitAnnexLocation key) 	addLink file key 		=<< withTSDelta (liftIO . genInodeCache file) 	next $ cleanupNew file key   where 	lockdown obj = do-		ifM (catchBoolIO $ sameInodeCache obj =<< Database.Keys.getInodeCaches key)+		ifM (isUnmodified key obj) 			( breakhardlink obj 			, repopulate obj 			)@@ -83,20 +83,18 @@ 			Database.Keys.storeInodeCaches key [obj]  	-- Try to repopulate obj from an unmodified associated file.-	repopulate obj-		| filemodified = modifyContent obj $ do-			g <- Annex.gitRepo-			fs <- map (`fromTopFilePath` g)-				<$> Database.Keys.getAssociatedFiles key-			mfile <- firstM (isUnmodified key) fs-			liftIO $ nukeFile obj-			case mfile of-				Just unmodified ->-					unlessM (checkedCopyFile key unmodified obj Nothing)-						lostcontent-				Nothing -> lostcontent-		| otherwise = modifyContent obj $ -			liftIO $ renameFile file obj+	repopulate obj = modifyContent obj $ do+		g <- Annex.gitRepo+		fs <- map (`fromTopFilePath` g)+			<$> Database.Keys.getAssociatedFiles key+		mfile <- firstM (isUnmodified key) fs+		liftIO $ nukeFile obj+		case mfile of+			Just unmodified ->+				unlessM (checkedCopyFile key unmodified obj Nothing)+					lostcontent+			Nothing -> lostcontent+ 	lostcontent = logStatus key InfoMissing  cleanupNew :: FilePath -> Key -> CommandCleanup

@@ -114,7 +114,7 @@ 		Right False -> do 			showAction $ "to " ++ Remote.name dest 			ok <- notifyTransfer Upload afile $-				upload (Remote.uuid dest) key afile noRetry $+				upload (Remote.uuid dest) key afile forwardRetry $ 					Remote.storeKey dest key afile 			if ok 				then finish $@@ -177,7 +177,7 @@ 	)   where 	go = notifyTransfer Download afile $ -		download (Remote.uuid src) key afile noRetry $ \p -> do+		download (Remote.uuid src) key afile forwardRetry $ \p -> do 			showAction $ "from " ++ Remote.name src 			getViaTmp (RemoteVerify src) key $ \t -> 				Remote.retrieveKeyFile src key afile t p

@@ -48,6 +48,7 @@ 	liftIO $ debugM "fieldTransfer" "transfer start" 	afile <- Fields.getField Fields.associatedFile 	ok <- maybe (a $ const noop)+		-- Using noRetry here because we're the sender. 		(\u -> runner (Transfer direction (toUUID u) key) afile noRetry a) 		=<< Fields.getField Fields.remoteUUID 	liftIO $ debugM "fieldTransfer" "transfer done"

@@ -56,7 +56,7 @@ 				case r of 					LinkAnnexOk -> return () 					LinkAnnexNoop -> return ()-					_ -> error "unlock failed"+					LinkAnnexFailed -> error "unlock failed" 			, liftIO $ writePointerFile tmp key destmode 			) 	next $ cleanupNew dest key destmode

@@ -14,11 +14,11 @@ 	getAssociatedFiles, 	getAssociatedKey, 	removeAssociatedFile,-	scanAssociatedFiles, 	storeInodeCaches, 	addInodeCaches, 	getInodeCaches, 	removeInodeCaches,+	runWriter, ) where  import qualified Database.Keys.SQL as SQL@@ -33,15 +33,8 @@ import Annex.LockFile import Utility.InodeCache import Annex.InodeSentinal-import qualified Git.Types-import qualified Git.LsTree-import qualified Git.Branch-import Git.Ref import Git.FilePath-import Annex.CatFile -import Database.Esqueleto hiding (Key)- {- Runs an action that reads from the database.  -  - If the database doesn't already exist, it's not created; mempty is@@ -167,32 +160,6 @@  removeAssociatedFile :: Key -> TopFilePath -> Annex () removeAssociatedFile k = runWriterIO . SQL.removeAssociatedFile (toIKey k)--{- Find all unlocked associated files. This is expensive, and so normally- - the associated files are updated incrementally when changes are noticed. -}-scanAssociatedFiles :: Annex ()-scanAssociatedFiles = whenM (isJust <$> inRepo Git.Branch.current) $ -	runWriter $ \h -> do-		showSideAction "scanning for unlocked files"-		dropallassociated h-		(l, cleanup) <- inRepo $ Git.LsTree.lsTree headRef-		forM_ l $ \i -> -			when (isregfile i) $-				maybe noop (add h i)-					=<< catKey (Git.LsTree.sha i)-		liftIO $ void cleanup-  where-	dropallassociated h = liftIO $ flip SQL.queueDb h $-		delete $ from $ \(_r :: SqlExpr (Entity SQL.Associated)) ->-			return ()-	isregfile i = case Git.Types.toBlobType (Git.LsTree.mode i) of-		Just Git.Types.FileBlob -> True-		Just Git.Types.ExecutableBlob -> True-		_ -> False-	add h i k = liftIO $ flip SQL.queueDb h $ -		void $ insertUnique $ SQL.Associated-			(toIKey k)-			(toSFilePath $ getTopFilePath $ Git.LsTree.file i)  {- Stats the files, and stores their InodeCaches. -} storeInodeCaches :: Key -> [FilePath] -> Annex ()

@@ -68,6 +68,18 @@   where 	af = toSFilePath (getTopFilePath f) +-- Does not remove any old association for a file, but less expensive+-- than addAssociatedFile. Calling dropAllAssociatedFiles first and then+-- this is an efficient way to update all associated files.+addAssociatedFileFast :: IKey -> TopFilePath -> WriteHandle -> IO ()+addAssociatedFileFast ik f = queueDb $ void $ insertUnique $ Associated ik af+  where+	af = toSFilePath (getTopFilePath f)++dropAllAssociatedFiles :: WriteHandle -> IO ()+dropAllAssociatedFiles = queueDb $+	delete $ from $ \(_r :: SqlExpr (Entity Associated)) -> return ()+ {- Note that the files returned were once associated with the key, but  - some of them may not be any longer. -} getAssociatedFiles :: IKey -> ReadHandle -> IO [TopFilePath]

@@ -105,7 +105,7 @@   where 	wanted l 		-- Skip lines like "error in tree <sha>: duplicateEntries: contains duplicate file entries"-		| "duplicateEntries" `isPrefixOf` l = False+		| "duplicateEntries" `isInfixOf` l = False 		| supportsNoDangling = True 		| otherwise = not ("dangling " `isPrefixOf` l) 

@@ -439,7 +439,7 @@ 				Just (object, checksuccess) -> do 					copier <- mkCopier hardlink params 					runTransfer (Transfer Download u key)-						file noRetry+						file forwardRetry 						(\p -> copier object dest (combineMeterUpdate p meterupdate) checksuccess) 	| Git.repoIsSsh (repo r) = unVerified $ feedprogressback $ \p -> do 		Ssh.rsyncHelper (Just (combineMeterUpdate meterupdate p))@@ -565,7 +565,7 @@ 				ensureInitialized 				copier <- mkCopier hardlink params 				let verify = Annex.Content.RemoteVerify r-				runTransfer (Transfer Download u key) file noRetry $ \p ->+				runTransfer (Transfer Download u key) file forwardRetry $ \p -> 					let p' = combineMeterUpdate meterupdate p 					in Annex.Content.saveState True `after` 						Annex.Content.getViaTmp verify key

@@ -212,6 +212,7 @@ 	, testCase "move" test_move 	, testCase "copy" test_copy 	, testCase "lock" test_lock+	, testCase "lock (v6 --force)" test_lock_v6_force 	, testCase "edit (no pre-commit)" test_edit 	, testCase "edit (pre-commit)" test_edit_precommit 	, testCase "partial commit" test_partial_commit@@ -612,6 +613,23 @@ 	assertEqual "content of modified file" c (changedcontent annexedfile) 	r' <- git_annex "drop" [annexedfile] 	not r' @? "drop wrongly succeeded with no known copy of modified file"++-- Regression test: lock --force when work tree file+-- was modified lost the (unmodified) annex object.+-- (Only occurred when the keys database was out of sync.)+test_lock_v6_force :: Assertion+test_lock_v6_force = intmpclonerepoInDirect $ do+	git_annex "upgrade" [] @? "upgrade failed"+	whenM (annexeval Annex.Version.versionSupportsUnlockedPointers) $ do+		git_annex "get" [annexedfile] @? "get of file failed"+		git_annex "unlock" [annexedfile] @? "unlock failed in v6 mode"+		annexeval $ do+			dbdir <- Annex.fromRepo Annex.Locations.gitAnnexKeysDb+			liftIO $ removeDirectoryRecursive dbdir+		writeFile annexedfile "test_lock_v6_force content"+		not <$> git_annex "lock" [annexedfile] @? "lock of modified file failed to fail in v6 mode"+		git_annex "lock" ["--force", annexedfile] @? "lock --force of modified file failed in v6 mode"+		annexed_present_locked annexedfile  test_edit :: Assertion test_edit = test_edit' False

@@ -15,6 +15,7 @@ import Annex.Direct import Annex.Content import Annex.CatFile+import Annex.WorkTree import qualified Database.Keys import qualified Annex.Content.Direct as Direct import qualified Git@@ -31,7 +32,7 @@ upgrade automatic = do 	unless automatic $ 		showAction "v5 to v6"-	Database.Keys.scanAssociatedFiles+	scanUnlockedFiles 	whenM isDirect $ do 		{- Direct mode makes the same tradeoff of using less disk 		 - space, with less preservation of old versions of files

@@ -352,7 +352,14 @@ 			[testSecretKey, testKey] 		return dir 		-	cleanup orig tmpdir = removeDirectoryRecursive tmpdir >> reset orig+	cleanup orig tmpdir = do+		removeDirectoryRecursive tmpdir+			-- gpg-agent may be shutting down at the same time+			-- and may delete its socket at the same time as+			-- we're trying to, causing an exception. Retrying+			-- will deal with this race.+			`catchIO` (\_ -> removeDirectoryRecursive tmpdir)+		reset orig 	reset (Just v) = setEnv var v True 	reset _ = unsetEnv var 

@@ -14,9 +14,10 @@ Note that for safety, the content of the file remains in the annex, until you use `git annex unused` and `git annex dropunused`. -This is not the command you should use if you intentionally annexed a-file and don't want its contents any more. In that case you should use-`git annex drop` instead, and you can also `git rm` the file.+This is not the command you should use if you intentionally added a+file some time ago, and don't want its contents any more. In that+case you should use `git annex drop` instead, and you can also+`git rm` the file.  # OPTIONS 

@@ -1,5 +1,5 @@ Name: git-annex-Version: 6.20161012+Version: 6.20161027 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess <id@joeyh.name>