git-annex 8.20200226 → 8.20200309

raw patch · 69 files changed

+679/−383 lines, 69 files

Files

• Annex.hs +23/−15
• Annex/AdjustedBranch.hs +6/−5
• Annex/AutoMerge.hs +2/−2
• Annex/ChangedRefs.hs +3/−2
• Annex/Content.hs +1/−2
• Annex/Content/PointerFile.hs +2/−2
• Annex/Fixup.hs +15/−22
• Annex/Ingest.hs +1/−1
• Annex/Init.hs +7/−0
• Annex/Perms.hs +26/−15
• Annex/ReplaceFile.hs +33/−9
• Annex/SpecialRemote/Config.hs +6/−2
• Annex/Ssh.hs +9/−4
• Annex/UUID.hs +1/−3
• Annex/WorkTree.hs +1/−1
• Assistant.hs +1/−0
• Assistant/Threads/Merger.hs +3/−2
• Assistant/Threads/TransferWatcher.hs +2/−1
• Assistant/Threads/Watcher.hs +1/−1
• Assistant/WebApp/Configurators/Edit.hs +4/−3
• CHANGELOG +34/−0
• CmdLine/GitAnnex/Options.hs +3/−2
• CmdLine/Option.hs +2/−2
• Command/AddUrl.hs +8/−7
• Command/Config.hs +10/−4
• Command/Expire.hs +3/−2
• Command/Fix.hs +9/−10
• Command/FromKey.hs +2/−1
• Command/Fsck.hs +2/−2
• Command/FuzzTest.hs +5/−4
• Command/Import.hs +3/−2
• Command/Init.hs +4/−3
• Command/Lock.hs +1/−1
• Command/ReKey.hs +1/−1
• Command/Smudge.hs +1/−1
• Command/Unlock.hs +1/−4
• Command/Upgrade.hs +21/−6
• Command/Whereis.hs +12/−1
• Config.hs +8/−39
• Config/GitConfig.hs +3/−2
• Config/Smudge.hs +2/−1
• Database/Init.hs +4/−3
• Git/LsFiles.hs +46/−18
• Git/Repair.hs +3/−2
• Logs/File.hs +1/−1
• Remote/Directory.hs +9/−9
• Remote/Directory/LegacyChunked.hs +5/−5
• Remote/External.hs +25/−14
• Remote/GCrypt.hs +4/−3
• Remote/GitLFS.hs +1/−1
• Remote/Helper/Hooks.hs +1/−1
• Remote/Rsync.hs +2/−1
• Test.hs +7/−4
• Types/GitConfig.hs +104/−65
• Types/Remote.hs +3/−0
• Types/RemoteConfig.hs +3/−2
• Upgrade.hs +32/−6
• Upgrade/V1.hs +2/−1
• Upgrade/V5.hs +0/−2
• Upgrade/V5/Direct.hs +0/−2
• Upgrade/V7.hs +1/−1
• Utility/Daemon.hs +0/−1
• Utility/Directory.hs +77/−1
• Utility/Hash.hs +34/−34
• Utility/HumanTime.hs +3/−2
• Utility/Path.hs +13/−4
• doc/git-annex-upgrade.mdwn +8/−1
• git-annex.cabal +1/−1
• stack.yaml +8/−11

@@ -1,6 +1,6 @@ {- git-annex monad  -- - Copyright 2010-2018 Joey Hess <id@joeyh.name>+ - Copyright 2010-2020 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -28,7 +28,7 @@ 	fromRepo, 	calcRepo, 	getGitConfig,-	changeGitConfig,+	overrideGitConfig, 	changeGitRepo, 	adjustGitRepo, 	getRemoteGitConfig,@@ -104,6 +104,7 @@ 	{ repo :: Git.Repo 	, repoadjustment :: (Git.Repo -> IO Git.Repo) 	, gitconfig :: GitConfig+	, gitconfigadjustment :: (GitConfig -> GitConfig) 	, gitremotes :: Maybe [Git.Repo] 	, backend :: Maybe (BackendA Annex) 	, remotes :: [Types.Remote.RemoteA Annex]@@ -161,6 +162,7 @@ 		{ repo = r 		, repoadjustment = return 		, gitconfig = c+		, gitconfigadjustment = id 		, gitremotes = Nothing 		, backend = Nothing 		, remotes = []@@ -314,19 +316,13 @@ getGitConfig :: Annex GitConfig getGitConfig = getState gitconfig -{- Modifies a GitConfig setting. -}-changeGitConfig :: (GitConfig -> GitConfig) -> Annex ()-changeGitConfig a = changeState $ \s -> s { gitconfig = a (gitconfig s) }--{- Changing the git Repo data also involves re-extracting its GitConfig. -}-changeGitRepo :: Git.Repo -> Annex ()-changeGitRepo r = do-	adjuster <- getState repoadjustment-	r' <- liftIO $ adjuster r-	changeState $ \s -> s-		{ repo = r'-		, gitconfig = extractGitConfig FromGitConfig r'-		}+{- Overrides a GitConfig setting. The modification persists across+ - reloads of the repo's config. -}+overrideGitConfig :: (GitConfig -> GitConfig) -> Annex ()+overrideGitConfig f = changeState $ \s -> s+	{ gitconfigadjustment = gitconfigadjustment s . f+	, gitconfig = f (gitconfig s)+	}  {- Adds an adjustment to the Repo data. Adjustments persist across reloads  - of the repo's config. -}@@ -334,6 +330,18 @@ adjustGitRepo a = do 	changeState $ \s -> s { repoadjustment = \r -> repoadjustment s r >>= a } 	changeGitRepo =<< gitRepo++{- Changing the git Repo data also involves re-extracting its GitConfig. -}+changeGitRepo :: Git.Repo -> Annex ()+changeGitRepo r = do+	repoadjuster <- getState repoadjustment+	gitconfigadjuster <- getState gitconfigadjustment+	r' <- liftIO $ repoadjuster r+	changeState $ \s -> s+		{ repo = r'+		, gitconfig = gitconfigadjuster $+			extractGitConfig FromGitConfig r'+		}  {- Gets the RemoteGitConfig from a remote, given the Git.Repo for that  - remote. -}

@@ -57,6 +57,7 @@ import Annex.GitOverlay import Utility.Tmp.Dir import Utility.CopyFile+import Utility.Directory import qualified Database.Keys import Config @@ -375,10 +376,10 @@ 	 - index file is currently locked.) 	 -} 	changestomerge (Just updatedorig) = withOtherTmp $ \othertmpdir -> do-		tmpwt <- fromRepo gitAnnexMergeDir 		git_dir <- fromRawFilePath <$> fromRepo Git.localGitDir+		tmpwt <- fromRepo gitAnnexMergeDir 		withTmpDirIn othertmpdir "git" $ \tmpgit -> withWorkTreeRelated tmpgit $-			withemptydir tmpwt $ withWorkTree tmpwt $ do+			withemptydir git_dir tmpwt $ withWorkTree tmpwt $ do 				liftIO $ writeFile (tmpgit </> "HEAD") (fromRef updatedorig) 				-- Copy in refs and packed-refs, to work 				-- around bug in git 2.13.0, which@@ -390,7 +391,7 @@ 					whenM (doesFileExist src) $ do 						dest <- relPathDirToFile git_dir src 						let dest' = tmpgit </> dest-						createDirectoryIfMissing True (takeDirectory dest')+						createDirectoryUnder git_dir (takeDirectory dest') 						void $ createLinkOrCopy src dest' 				-- This reset makes git merge not care 				-- that the work tree is empty; otherwise@@ -411,12 +412,12 @@ 					else return $ return False 	changestomerge Nothing = return $ return False 	-	withemptydir d a = bracketIO setup cleanup (const a)+	withemptydir git_dir d a = bracketIO setup cleanup (const a) 	  where 		setup = do 			whenM (doesDirectoryExist d) $ 				removeDirectoryRecursive d-			createDirectoryIfMissing True d+			createDirectoryUnder git_dir d 		cleanup _ = removeDirectoryRecursive d  	{- A merge commit has been made between the basisbranch and 

@@ -208,7 +208,7 @@ 		stageSymlink dest' =<< hashSymlink l  	replacewithsymlink dest link = withworktree dest $ \f ->-		replaceFile f $ makeGitLink link . toRawFilePath+		replaceWorkTreeFile f $ makeGitLink link . toRawFilePath  	makepointer key dest destmode = do 		unless inoverlay $ @@ -256,7 +256,7 @@ 				, case selectwant' (LsFiles.unmergedSha u) of 					Nothing -> noop 					Just sha -> withworktree item $ \f -> -						replaceFile f $ \tmp -> do+						replaceWorkTreeFile f $ \tmp -> do 							c <- catObject sha 							liftIO $ L.writeFile tmp c 				)

@@ -76,8 +76,9 @@ 	chan <- liftIO $ newTBMChanIO 100 	 	g <- gitRepo-	let refdir = fromRawFilePath (Git.localGitDir g) </> "refs"-	liftIO $ createDirectoryIfMissing True refdir+	let gittop = fromRawFilePath (Git.localGitDir g)+	let refdir = gittop </> "refs"+	liftIO $ createDirectoryUnder gittop refdir  	let notifyhook = Just $ notifyHook chan 	let hooks = mkWatchHooks

@@ -879,8 +879,7 @@ 		liftIO $ writeFile obj "" 		setAnnexFilePerm obj 	let tmpdir = gitAnnexTmpWorkDir obj-	liftIO $ createDirectoryIfMissing True tmpdir-	setAnnexDirPerm tmpdir+	createAnnexDirectory tmpdir 	res <- action tmpdir 	case res of 		Just _ -> liftIO $ removeDirectoryRecursive tmpdir

@@ -39,7 +39,7 @@ 		let f' = fromRawFilePath f 		destmode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus f' 		liftIO $ nukeFile f'-		(ic, populated) <- replaceFile f' $ \tmp -> do+		(ic, populated) <- replaceWorkTreeFile f' $ \tmp -> do 			let tmp' = toRawFilePath tmp 			ok <- linkOrCopy k (fromRawFilePath obj) tmp destmode >>= \case 				Just _ -> thawContent tmp >> return True@@ -62,7 +62,7 @@ 	let mode = fmap fileMode st 	secureErase file' 	liftIO $ nukeFile file'-	ic <- replaceFile file' $ \tmp -> do+	ic <- replaceWorkTreeFile file' $ \tmp -> do 		liftIO $ writePointerFile (toRawFilePath tmp) key mode #if ! defined(mingw32_HOST_OS) 		-- Don't advance mtime; this avoids unncessary re-smudging

@@ -1,6 +1,6 @@ {- git-annex repository fixups  -- - Copyright 2013-2019 Joey Hess <id@joeyh.name>+ - Copyright 2013-2020 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -12,8 +12,6 @@ import Git.Types import Git.Config import Types.GitConfig-import Config.Files-import qualified Git import Utility.Path import Utility.SafeCommand import Utility.Directory@@ -83,27 +81,24 @@  - also converted to a symlink so links to .git/annex will work.   -   - When the filesystem doesn't support symlinks, we cannot make .git- - into a symlink. But we don't need too, since the repo will use direct- - mode.+ - into a symlink. But we don't need too, since the repo will use adjusted+ - unlocked branches.  -- - Before making any changes, check if there's a .noannex file- - in the repo. If that file will prevent git-annex from being used,- - there's no need to fix up the repository.+ - Don't do any of this if the repo has not been initialized for git-annex+ - use yet.  -} fixupUnusualRepos :: Repo -> GitConfig -> IO Repo fixupUnusualRepos r@(Repo { location = l@(Local { worktree = Just w, gitdir = d }) }) c-	| needsSubmoduleFixup r = ifM notnoannex-		( do-			when (coreSymlinks c) $-				(replacedotgit >> unsetcoreworktree)-					`catchNonAsync` \_e -> hPutStrLn stderr-						"warning: unable to convert submodule to form that will work with git-annex"-			return $ r'-				{ config = M.delete "core.worktree" (config r)-				}-		, return r-		)-	| otherwise = ifM (needsGitLinkFixup r <&&> notnoannex)+	| isNothing (annexVersion c) = return r+	| needsSubmoduleFixup r = do+		when (coreSymlinks c) $+			(replacedotgit >> unsetcoreworktree)+				`catchNonAsync` \_e -> hPutStrLn stderr+					"warning: unable to convert submodule to form that will work with git-annex"+		return $ r'+			{ config = M.delete "core.worktree" (config r)+			}+	| otherwise = ifM (needsGitLinkFixup r) 		( do 			when (coreSymlinks c) $ 				(replacedotgit >> worktreefixup)@@ -144,8 +139,6 @@ 	r' 		| coreSymlinks c = r { location = l { gitdir = dotgit } } 		| otherwise = r--	notnoannex = isNothing <$> noAnnexFileContent (fmap fromRawFilePath (Git.repoWorkTree r)) fixupUnusualRepos r _ = return r  needsSubmoduleFixup :: Repo -> Bool

@@ -274,7 +274,7 @@ makeLink :: FilePath -> Key -> Maybe InodeCache -> Annex String makeLink file key mcache = flip catchNonAsync (restoreFile file key) $ do 	l <- calcRepo $ gitAnnexLink file key-	replaceFile file $ makeAnnexLink l . toRawFilePath+	replaceWorkTreeFile file $ makeAnnexLink l . toRawFilePath  	-- touch symlink to have same time as the original file, 	-- as provided in the InodeCache

@@ -34,6 +34,7 @@ import Annex.Difference import Annex.UUID import Annex.WorkTree+import Annex.Fixup import Config import Config.Files import Config.Smudge@@ -129,6 +130,7 @@ 				) 	propigateSecureHashesOnly 	createInodeSentinalFile False+	fixupUnusualReposAfterInit  uninitialize :: Annex () uninitialize = do@@ -280,3 +282,8 @@ propigateSecureHashesOnly = 	maybe noop (setConfig "annex.securehashesonly" . fromConfigValue) 		=<< getGlobalConfig "annex.securehashesonly"++fixupUnusualReposAfterInit :: Annex ()+fixupUnusualReposAfterInit = do+	gc <- Annex.getGitConfig+	void $ inRepo $ \r -> fixupUnusualRepos r gc

@@ -1,6 +1,6 @@ {- git-annex file permissions  -- - Copyright 2012 Joey Hess <id@joeyh.name>+ - Copyright 2012-2020 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -11,6 +11,7 @@ 	setAnnexDirPerm, 	annexFileMode, 	createAnnexDirectory,+	createWorkTreeDirectory, 	noUmask, 	freezeContent, 	isContentWritePermOk,@@ -25,6 +26,7 @@  import Annex.Common import Utility.FileMode+import Git import Git.ConfigTypes import qualified Annex import Config@@ -65,22 +67,31 @@ 	go _ = stdFileMode 	sharedmode = combineModes groupSharedModes -{- Creates a directory inside the gitAnnexDir, including any parent- - directories. Makes directories with appropriate permissions. -}+{- Creates a directory inside the gitAnnexDir, creating any parent+ - directories up to and including the gitAnnexDir.+ - Makes directories with appropriate permissions. -} createAnnexDirectory :: FilePath -> Annex ()-createAnnexDirectory dir = walk dir [] =<< top+createAnnexDirectory dir = do+	top <- parentDir . fromRawFilePath <$> fromRepo gitAnnexDir+	createDirectoryUnder' top dir createdir   where-	top = parentDir . fromRawFilePath <$> fromRepo gitAnnexDir-	walk d below stop-		| d `equalFilePath` stop = done-		| otherwise = ifM (liftIO $ doesDirectoryExist d)-			( done-			, walk (parentDir d) (d:below) stop-			)-	  where-		done = forM_ below $ \p -> do-			liftIO $ createDirectoryIfMissing True p-			setAnnexDirPerm p+	createdir p = do+		liftIO $ createDirectory p+		setAnnexDirPerm p++{- Create a directory in the git work tree, creating any parent+ - directories up to the top of the work tree.+ -+ - Uses default permissions.+ -}+createWorkTreeDirectory :: FilePath -> Annex ()+createWorkTreeDirectory dir = do+	fromRepo repoWorkTree >>= liftIO . \case+		Just wt -> createDirectoryUnder (fromRawFilePath wt) dir+		-- Should never happen, but let whatever tries to write+		-- to the directory be what throws an exception, as that+		-- will be clearer than an exception from here.+		Nothing -> noop  {- Normally, blocks writing to an annexed file, and modifies file  - permissions to allow reading it.

@@ -1,21 +1,42 @@ {- git-annex file replacing  -- - Copyright 2013-2015 Joey Hess <id@joeyh.name>+ - Copyright 2013-2020 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE CPP #-} -module Annex.ReplaceFile where+module Annex.ReplaceFile (+	replaceGitAnnexDirFile,+	replaceGitDirFile,+	replaceWorkTreeFile,+	replaceFile,+) where  import Annex.Common import Annex.Tmp+import Annex.Perms+import Git import Utility.Tmp.Dir #ifndef mingw32_HOST_OS import Utility.Path.Max #endif +{- replaceFile on a file located inside the gitAnnexDir. -}+replaceGitAnnexDirFile :: FilePath -> (FilePath -> Annex a) -> Annex a+replaceGitAnnexDirFile = replaceFile createAnnexDirectory++{- replaceFile on a file located inside the .git directory. -}+replaceGitDirFile :: FilePath -> (FilePath -> Annex a) -> Annex a+replaceGitDirFile = replaceFile $ \dir -> do+	top <- fromRawFilePath <$> fromRepo localGitDir+	liftIO $ createDirectoryUnder top dir++{- replaceFile on a worktree file. -}+replaceWorkTreeFile :: FilePath -> (FilePath -> Annex a) -> Annex a+replaceWorkTreeFile = replaceFile createWorkTreeDirectory+ {- Replaces a possibly already existing file with a new version,   - atomically, by running an action.  - @@ -27,9 +48,12 @@  - will be deleted, and the existing file will be preserved.  -  - Throws an IO exception when it was unable to replace the file.+ -+ - The createdirectory action is only run when moving the file into place+ - fails, and can create any parent directory structure needed.  -}-replaceFile :: FilePath -> (FilePath -> Annex a) -> Annex a-replaceFile file action = withOtherTmp $ \othertmpdir -> do+replaceFile :: (FilePath -> Annex ()) -> FilePath -> (FilePath -> Annex a) -> Annex a+replaceFile createdirectory file action = withOtherTmp $ \othertmpdir -> do #ifndef mingw32_HOST_OS 	-- Use part of the filename as the template for the temp 	-- directory. This does not need to be unique, but it@@ -44,13 +68,13 @@ 	withTmpDirIn othertmpdir basetmp $ \tmpdir -> do 		let tmpfile = tmpdir </> basetmp 		r <- action tmpfile-		liftIO $ replaceFileFrom tmpfile file+		replaceFileFrom tmpfile file createdirectory 		return r -replaceFileFrom :: FilePath -> FilePath -> IO ()-replaceFileFrom src dest = go `catchIO` fallback+replaceFileFrom :: FilePath -> FilePath -> (FilePath -> Annex ()) -> Annex ()+replaceFileFrom src dest createdirectory = go `catchIO` fallback   where-	go = moveFile src dest+	go = liftIO $ moveFile src dest 	fallback _ = do-		createDirectoryIfMissing True $ parentDir dest+		createdirectory (parentDir dest) 		go

@@ -16,7 +16,7 @@ import Types.UUID import Types.ProposedAccepted import Types.RemoteConfig-import Config+import Types.GitConfig import qualified Git.Config  import qualified Data.Map as M@@ -234,8 +234,12 @@ 	p Nothing _c = Right Nothing  yesNoParser :: RemoteConfigField -> Bool -> FieldDesc -> RemoteConfigFieldParser-yesNoParser f v fd = genParser yesNo f v fd+yesNoParser f v fd = genParser yesno f v fd 	(Just (ValueDesc "yes or no"))+  where+	yesno "yes" = Just True+	yesno "no" = Just False+	yesno _ = Nothing  trueFalseParser :: RemoteConfigField -> Bool -> FieldDesc -> RemoteConfigFieldParser trueFalseParser f v fd = genParser Git.Config.isTrueFalse f v fd

@@ -154,8 +154,11 @@ sshSocketDirEnv :: String sshSocketDirEnv = "GIT_ANNEX_SSH_SOCKET_DIR" -{- ssh connection caching creates sockets, so will not work on a- - crippled filesystem. -}+{- Returns the directory where ssh connection caching sockets can be+ - stored.+ - + - The directory will be created if it does not exist.+ -} sshCacheDir :: Annex (Maybe FilePath) sshCacheDir = eitherToMaybe <$> sshCacheDir' @@ -169,7 +172,10 @@ 				Just tmpdir ->  					liftIO $ catchMsgIO $ 						usetmpdir tmpdir-			, Right <$> fromRepo gitAnnexSshDir +			, do+				d <- fromRepo gitAnnexSshDir+				createAnnexDirectory d+				return (Right d) 			) 		, return (Left "annex.sshcaching is not set to true") 		)@@ -221,7 +227,6 @@ 	-- Cleanup at shutdown. 	Annex.addCleanup SshCachingCleanup sshCleanup 	-	liftIO $ createDirectoryIfMissing True $ parentDir socketfile 	let socketlock = socket2lock socketfile  	Annex.getState Annex.concurrency >>= \case

@@ -102,9 +102,7 @@ 	storeUUID =<< liftIO genUUID  storeUUID :: UUID -> Annex ()-storeUUID u = do-	Annex.changeGitConfig $ \c -> c { annexUUID = u }-	storeUUIDIn configkeyUUID u+storeUUID = storeUUIDIn configkeyUUID  storeUUIDIn :: ConfigKey -> UUID -> Annex () storeUUIDIn configfield = setConfig configfield . fromUUID

@@ -100,7 +100,7 @@ 				Just k' | k' == k -> do 					destmode <- liftIO $ catchMaybeIO $ 						fileMode <$> R.getFileStatus f-					ic <- replaceFile (fromRawFilePath f) $ \tmp -> do+					ic <- replaceWorkTreeFile (fromRawFilePath f) $ \tmp -> do 						let tmp' = toRawFilePath tmp 						linkFromAnnex k tmp destmode >>= \case 							LinkAnnexOk -> 

@@ -75,6 +75,7 @@ 	pidfile <- fromRepo gitAnnexPidFile 	logfile <- fromRepo gitAnnexLogFile 	liftIO $ debugM desc $ "logging to " ++ logfile+	createAnnexDirectory (parentDir pidfile) #ifndef mingw32_HOST_OS 	createAnnexDirectory (parentDir logfile) 	logfd <- liftIO $ handleToFd =<< openLog logfile

@@ -26,8 +26,9 @@ mergeThread :: NamedThread mergeThread = namedThread "Merger" $ do 	g <- liftAnnex gitRepo-	let dir = fromRawFilePath (Git.localGitDir g) </> "refs"-	liftIO $ createDirectoryIfMissing True dir+	let gitd = fromRawFilePath (Git.localGitDir g)+	let dir = gitd </> "refs"+	liftIO $ createDirectoryUnder gitd dir 	let hook a = Just <$> asIO2 (runHandler a) 	changehook <- hook onChange 	errhook <- hook onErr

@@ -15,6 +15,7 @@ import Utility.DirWatcher import Utility.DirWatcher.Types import qualified Remote+import Annex.Perms  import Control.Concurrent import qualified Data.Map as M@@ -24,7 +25,7 @@ transferWatcherThread :: NamedThread transferWatcherThread = namedThread "TransferWatcher" $ do 	dir <- liftAnnex $ gitAnnexTransferDir <$> gitRepo-	liftIO $ createDirectoryIfMissing True dir+	liftAnnex $ createAnnexDirectory dir 	let hook a = Just <$> asIO2 (runHandler a) 	addhook <- hook onAdd 	delhook <- hook onDel

@@ -300,7 +300,7 @@ 		if linktarget == Just link 			then ensurestaged (Just link) =<< getDaemonStatus 			else do-				liftAnnex $ replaceFile file $+				liftAnnex $ replaceWorkTreeFile file $ 					makeAnnexLink link . toRawFilePath 				addLink file link (Just key) 	-- other symlink, not git-annex

@@ -41,6 +41,7 @@ import Types.Crypto import Utility.Gpg import Annex.UUID+import Annex.Perms import Assistant.Ssh import Config import Config.GitConfig@@ -246,9 +247,9 @@ 	repoconfig <- M.lookup (Remote.uuid r) <$> readRemoteLog 	case repoGroup cfg of 		RepoGroupStandard gr -> case associatedDirectory repoconfig gr of-			Just d -> inRepo $ \g ->-				createDirectoryIfMissing True $-					fromRawFilePath (Git.repoPath g) </> d+			Just d -> do+				top <- fromRawFilePath <$> fromRepo Git.repoPath+				createWorkTreeDirectory (top </> d) 			Nothing -> noop 		_ -> noop 

@@ -1,3 +1,36 @@+git-annex (8.20200309) upstream; urgency=medium++  * Fix bug that caused unlocked annexed dotfiles to be added to git by the+    smudge filter when annex.dotfiles was not set.+  * Upgrade other repos than the current one by running git-annex upgrade+    inside them, which avoids problems with upgrade code making assumptions+    that the cwd will be inside the repo being upgraded. In particular,+    this fixes a problem where upgrading a v7 repo to v8 caused an ugly+    git error message.+  * Fix upgrade failure when a file has been deleted from the working tree.+  * Fix regression 1 month ago that prevented external special remotes from+    using GETCONFIG to query values like "name".+  * Improve behavior when a directory git-annex is writing to gets+    unmounted. Previously it could in some cases re-create the mount point+    and directory tree, and even write object contents to the wrong disk.+  * Don't ignore --debug when it is followed by -c.+  * whereis: If a remote fails to report on urls where a key+    is located, display a warning, rather than giving up and not displaying+    any information.+  * When external special remotes fail but neglect to provide an error+    message, say what request failed, which is better than displaying an+    empty error message to the user.+  * git-annex config: Only allow configs be set that are ones git-annex+    actually supports reading from repo-global config, to avoid confusion.+  * Avoid converting .git file in a worktree or submodule to a symlink+    when the repository is not a git-annex repository.+  * Linux standalone: Use md5sum to shorten paths in .cache/git-annex/locales+  * Fix build with ghc 8.8 (MonadFail)+    Thanks, Peter Simons+  * stack.yaml: Updated to lts-14.27.++ -- Joey Hess <id@joeyh.name>  Mon, 09 Mar 2020 17:04:08 -0400+ git-annex (8.20200226) upstream; urgency=medium    * New v8 repository version.@@ -42,6 +75,7 @@     on those remotes without encrypting it.     If your remotes are affected, you will want to make sure to delete     any content that git-annex has stored on them that is not encrypted!+  * initremote: Fix regression in parsing the exporttree= parameter.   * info: Fix display of the encryption value.     (Some debugging junk had crept in.)   * Bugfix to getting content from an export remote with -J, when the

@@ -9,6 +9,7 @@  module CmdLine.GitAnnex.Options where +import Control.Monad.Fail as Fail (MonadFail(..)) import Options.Applicative import qualified Data.Map as M @@ -215,8 +216,8 @@ 	<> help "operate on all versions of all files" 	) -parseKey :: Monad m => String -> m Key-parseKey = maybe (fail "invalid key") return . deserializeKey+parseKey :: MonadFail m => String -> m Key+parseKey = maybe (Fail.fail "invalid key") return . deserializeKey  -- Options to match properties of annexed files. annexedMatchingOptions :: [GlobalOption]

@@ -59,5 +59,5 @@ 	setforce v = Annex.changeState $ \s -> s { Annex.force = v } 	setfast v = Annex.changeState $ \s -> s { Annex.fast = v } 	setforcebackend v = Annex.changeState $ \s -> s { Annex.forcebackend = Just v }-	setdebug = Annex.changeGitConfig $ \c -> c { annexDebug = True }-	unsetdebug = Annex.changeGitConfig $ \c -> c { annexDebug = False }+	setdebug = Annex.overrideGitConfig $ \c -> c { annexDebug = True }+	unsetdebug = Annex.overrideGitConfig $ \c -> c { annexDebug = False }

@@ -20,6 +20,7 @@ import Annex.Content import Annex.Ingest import Annex.CheckIgnore+import Annex.Perms import Annex.UUID import Annex.YoutubeDl import Logs.Web@@ -168,7 +169,7 @@ downloadRemoteFile :: AddUnlockedMatcher -> Remote -> DownloadOptions -> URLString -> FilePath -> Maybe Integer -> Annex (Maybe Key) downloadRemoteFile addunlockedmatcher r o uri file sz = checkCanAdd file $ do 	let urlkey = Backend.URL.fromUrl uri sz-	liftIO $ createDirectoryIfMissing True (parentDir file)+	createWorkTreeDirectory (parentDir file) 	ifM (Annex.getState Annex.fast <||> pure (relaxedOption o)) 		( do 			addWorkTree addunlockedmatcher (Remote.uuid r) loguri file urlkey Nothing@@ -271,7 +272,7 @@ 		) 	normalfinish tmp = checkCanAdd file $ do 		showDestinationFile file-		liftIO $ createDirectoryIfMissing True (parentDir file)+		createWorkTreeDirectory (parentDir file) 		finishDownloadWith addunlockedmatcher tmp webUUID url file 	tryyoutubedl tmp 		-- Ask youtube-dl what filename it will download@@ -357,7 +358,7 @@ 		tmp <- fromRepo $ gitAnnexTmpObjectLocation dummykey 		ok <- Transfer.notifyTransfer Transfer.Download url $ 			Transfer.download u dummykey afile Transfer.stdRetry $ \p -> do-				liftIO $ createDirectoryIfMissing True (parentDir tmp)+				createAnnexDirectory (parentDir tmp) 				downloader tmp p 		if ok 			then return (Just tmp)@@ -389,9 +390,9 @@ 	Nothing -> go 	Just tmp -> do 		-- Move to final location for large file check.-		pruneTmpWorkDirBefore tmp $ \_ -> liftIO $ do-			createDirectoryIfMissing True (takeDirectory file)-			renameFile tmp file+		pruneTmpWorkDirBefore tmp $ \_ -> do+			createWorkTreeDirectory (takeDirectory file)+			liftIO $ renameFile tmp file 		largematcher <- largeFilesMatcher 		large <- checkFileMatcher largematcher file 		if large@@ -438,7 +439,7 @@ nodownloadWeb' :: AddUnlockedMatcher -> URLString -> Key -> FilePath -> Annex (Maybe Key) nodownloadWeb' addunlockedmatcher url key file = checkCanAdd file $ do 	showDestinationFile file-	liftIO $ createDirectoryIfMissing True (parentDir file)+	createWorkTreeDirectory (parentDir file) 	addWorkTree addunlockedmatcher webUUID url file key Nothing 	return (Just key) 

@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2017 Joey Hess <id@joeyh.name>+ - Copyright 2017-2020 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -12,6 +12,7 @@ import Command import Logs.Config import Config+import Types.GitConfig (globalConfigs) import Git.Types (ConfigKey(..), fromConfigValue)  import qualified Data.ByteString.Char8 as S8@@ -53,24 +54,29 @@ 		)  seek :: Action -> CommandSeek-seek (SetConfig ck@(ConfigKey name) val) = commandAction $+seek (SetConfig ck@(ConfigKey name) val) = checkIsGlobalConfig ck $ commandAction $ 	startingUsualMessages (decodeBS' name) (ActionItemOther (Just (fromConfigValue val))) $ do 		setGlobalConfig ck val 		when (needLocalUpdate ck) $ 			setConfig ck (fromConfigValue val) 		next $ return True-seek (UnsetConfig ck@(ConfigKey name)) = commandAction $+seek (UnsetConfig ck@(ConfigKey name)) = checkIsGlobalConfig ck $ commandAction $ 	startingUsualMessages (decodeBS' name) (ActionItemOther (Just "unset")) $do 		unsetGlobalConfig ck 		when (needLocalUpdate ck) $ 			unsetConfig ck 		next $ return True-seek (GetConfig ck) = commandAction $+seek (GetConfig ck) = checkIsGlobalConfig ck $ commandAction $ 	startingCustomOutput (ActionItemOther Nothing) $ do 		getGlobalConfig ck >>= \case 			Nothing -> return () 			Just (ConfigValue v) -> liftIO $ S8.putStrLn v 		next $ return True++checkIsGlobalConfig :: ConfigKey -> Annex a -> Annex a+checkIsGlobalConfig ck@(ConfigKey name) a+	| elem ck globalConfigs = a+	| otherwise = giveup $ decodeBS name ++ " is not a configuration setting that can be stored in the git-annex branch"  needLocalUpdate :: ConfigKey -> Bool needLocalUpdate (ConfigKey "annex.securehashesonly") = True

@@ -17,6 +17,7 @@ import qualified Remote import Utility.HumanTime +import Control.Monad.Fail as Fail (MonadFail(..)) import Data.Time.Clock.POSIX import qualified Data.Map as M @@ -105,9 +106,9 @@ 		Nothing -> giveup $ "bad expire time: " ++ s 		Just d -> Just (now - durationToPOSIXTime d) -parseActivity :: Monad m => String -> m Activity+parseActivity :: MonadFail m => String -> m Activity parseActivity s = case readish s of-	Nothing -> fail $ "Unknown activity. Choose from: " ++ +	Nothing -> Fail.fail $ "Unknown activity. Choose from: " ++  		unwords (map show [minBound..maxBound :: Activity]) 	Just v -> return v 

@@ -67,7 +67,7 @@  breakHardLink :: RawFilePath -> Key -> RawFilePath -> CommandPerform breakHardLink file key obj = do-	replaceFile (fromRawFilePath file) $ \tmp -> do+	replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do 		mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file 		let obj' = fromRawFilePath obj 		unlessM (checkedCopyFile key obj' tmp mode) $@@ -79,7 +79,7 @@  makeHardLink :: RawFilePath -> Key -> CommandPerform makeHardLink file key = do-	replaceFile (fromRawFilePath file) $ \tmp -> do+	replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do 		mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file 		linkFromAnnex key tmp mode >>= \case 			LinkAnnexFailed -> error "unable to make hard link"@@ -88,17 +88,16 @@  fixSymlink :: FilePath -> FilePath -> CommandPerform fixSymlink file link = do-	liftIO $ do #if ! defined(mingw32_HOST_OS)-		-- preserve mtime of symlink-		mtime <- catchMaybeIO $ modificationTimeHiRes-			<$> getSymbolicLinkStatus file+	-- preserve mtime of symlink+	mtime <- liftIO $ catchMaybeIO $ modificationTimeHiRes+		<$> getSymbolicLinkStatus file #endif-		createDirectoryIfMissing True (parentDir file)-		removeFile file-		createSymbolicLink link file+	createWorkTreeDirectory (parentDir file)+	liftIO $ removeFile file+	liftIO $ createSymbolicLink link file #if ! defined(mingw32_HOST_OS)-		maybe noop (\t -> touch file t False) mtime+	liftIO $ maybe noop (\t -> touch file t False) mtime #endif 	next $ cleanupSymlink file 

@@ -13,6 +13,7 @@ import qualified Annex.Queue import Annex.Content import Annex.WorkTree+import Annex.Perms import qualified Annex import qualified Backend.URL @@ -85,7 +86,7 @@ 		( hasothercontent 		, do 			link <- calcRepo $ gitAnnexLink file key-			liftIO $ createDirectoryIfMissing True (parentDir file)+			createWorkTreeDirectory (parentDir file) 			liftIO $ createSymbolicLink link file 			Annex.Queue.addCommand "add" [Param "--"] [file] 			next $ return True

@@ -219,7 +219,7 @@ 	go want have 		| want /= fromRawFilePath (fromInternalGitPath have) = do 			showNote "fixing link"-			liftIO $ createDirectoryIfMissing True (parentDir (fromRawFilePath file))+			createWorkTreeDirectory (parentDir (fromRawFilePath file)) 			liftIO $ removeFile (fromRawFilePath file) 			addAnnexLink want file 		| otherwise = noop@@ -332,7 +332,7 @@ 	case mk of 		Just k | k == key -> whenM (inAnnex key) $ do 			showNote "fixing worktree content"-			replaceFile (fromRawFilePath file) $ \tmp -> do+			replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do 				mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file 				ifM (annexThin <$> Annex.getGitConfig) 					( void $ linkFromAnnex key tmp mode

@@ -13,6 +13,7 @@ import qualified Annex import qualified Git.Config import Config+import Annex.Perms import Utility.ThreadScheduler import Utility.DiskFree import Git.Types (fromConfigKey)@@ -172,10 +173,10 @@ 		]  runFuzzAction :: FuzzAction -> Annex ()-runFuzzAction (FuzzAdd (FuzzFile f)) = liftIO $ do-	createDirectoryIfMissing True $ parentDir f-	n <- getStdRandom random :: IO Int-	writeFile f $ show n ++ "\n"+runFuzzAction (FuzzAdd (FuzzFile f)) = do+	createWorkTreeDirectory (parentDir f)+	n <- liftIO (getStdRandom random :: IO Int)+	liftIO $ writeFile f $ show n ++ "\n" runFuzzAction (FuzzDelete (FuzzFile f)) = liftIO $ nukeFile f runFuzzAction (FuzzMove (FuzzFile src) (FuzzFile dest)) = liftIO $ 	rename src dest

@@ -25,6 +25,7 @@ import Annex.Ingest import Annex.InodeSentinal import Annex.Import+import Annex.Perms import Annex.RemoteTrackingBranch import Utility.InodeCache import Logs.Location@@ -176,12 +177,12 @@ 	importfilechecked ld k = do 		-- Move or copy the src file to the dest file. 		-- The dest file is what will be ingested.-		liftIO $ createDirectoryIfMissing True (parentDir destfile)+		createWorkTreeDirectory (parentDir destfile) 		liftIO $ if mode == Duplicate || mode == SkipDuplicates 			then void $ copyFileExternal CopyAllMetaData srcfile destfile 			else moveFile srcfile destfile 		-- Get the inode cache of the dest file. It should be-		-- weakly the same as the origianlly locked down file's+		-- weakly the same as the originally locked down file's 		-- inode cache. (Since the file may have been copied, 		-- its inodes may not be the same.) 		newcache <- withTSDelta $ liftIO . genInodeCache destfile'

@@ -13,6 +13,7 @@ import Types.RepoVersion import qualified Annex.SpecialRemote +import Control.Monad.Fail as Fail (MonadFail(..)) import qualified Data.Map as M 	 cmd :: Command@@ -33,14 +34,14 @@ 		<> help "Override default annex.version" 		)) -parseRepoVersion :: Monad m => String -> m RepoVersion+parseRepoVersion :: MonadFail m => String -> m RepoVersion parseRepoVersion s = case RepoVersion <$> readish s of-	Nothing -> fail $ "version parse error"+	Nothing -> Fail.fail $ "version parse error" 	Just v 		| v `elem` supportedVersions -> return v 		| otherwise -> case M.lookup v autoUpgradeableVersions of 			Just v' -> return v'-			Nothing -> fail $ s ++ " is not a currently supported repository version"+			Nothing -> Fail.fail $ s ++ " is not a currently supported repository version"  seek :: InitOptions -> CommandSeek seek = commandAction . start

@@ -74,7 +74,7 @@ 		mfc <- withTSDelta (liftIO . genInodeCache file) 		unlessM (sameInodeCache obj (maybeToList mfc)) $ do 			let obj' = fromRawFilePath obj-			modifyContent obj' $ replaceFile obj' $ \tmp -> do+			modifyContent obj' $ replaceGitAnnexDirFile obj' $ \tmp -> do 				unlessM (checkedCopyFile key obj' tmp Nothing) $ 					giveup "unable to lock file" 			Database.Keys.storeInodeCaches key [obj]

@@ -93,7 +93,7 @@ 			st <- liftIO $ R.getFileStatus file 			when (linkCount st > 1) $ do 				freezeContent oldobj-				replaceFile (fromRawFilePath file) $ \tmp -> do+				replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do 					unlessM (checkedCopyFile oldkey oldobj tmp Nothing) $ 						error "can't lock old key" 					thawContent tmp

@@ -176,7 +176,7 @@ 	checkmatcher d 		| dotfile file = ifM (getGitConfigVal annexDotFiles) 			( go-			, return False+			, d 			) 		| otherwise = go 	  where

@@ -29,9 +29,6 @@ seek :: CmdParams -> CommandSeek seek ps = withFilesInGit (commandAction . whenAnnexed start) =<< workTreeItems ps -{- Before v6, the unlock subcommand replaces the symlink with a copy of- - the file's content. In v6 and above, it converts the file from a symlink- - to a pointer. -} start :: RawFilePath -> Key -> CommandStart start file key = ifM (isJust <$> isAnnexLink file) 	( starting "unlock" (mkActionItem (key, AssociatedFile (Just file))) $@@ -42,7 +39,7 @@ perform :: RawFilePath -> Key -> CommandPerform perform dest key = do 	destmode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus dest-	replaceFile (fromRawFilePath dest) $ \tmp ->+	replaceWorkTreeFile (fromRawFilePath dest) $ \tmp -> 		ifM (inAnnex key) 			( do 				r <- linkFromAnnex key tmp destmode

@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2011 Joey Hess <id@joeyh.name>+ - Copyright 2011-2020 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -20,13 +20,28 @@ 	noDaemonRunning $ 	-- ^ avoid upgrading repo out from under daemon 	command "upgrade" SectionMaintenance "upgrade repository"-		paramNothing (withParams seek)+		paramNothing (seek <$$> optParser) -seek :: CmdParams -> CommandSeek-seek = withNothing (commandAction start)+data UpgradeOptions = UpgradeOptions+	{ autoOnly :: Bool+	} -start :: CommandStart-start = starting "upgrade" (ActionItemOther Nothing) $ do+optParser :: CmdParamsDesc -> Parser UpgradeOptions+optParser _ = UpgradeOptions+	<$> switch+		( long "autoonly"+		<> help "only do automatic upgrades"+		)++seek :: UpgradeOptions -> CommandSeek+seek o = commandAction (start o)++start :: UpgradeOptions -> CommandStart+start (UpgradeOptions { autoOnly = True }) = do+	starting "upgrade" (ActionItemOther Nothing) $ do+	getVersion >>= maybe noop checkUpgrade+	next $ return True+start _ = starting "upgrade" (ActionItemOther Nothing) $ do 	whenM (isNothing <$> getVersion) $ do 		initialize Nothing Nothing 	r <- upgrade False latestVersion

@@ -92,7 +92,18 @@ 		<$> askremote 		<*> claimedurls   where-	askremote = maybe (pure []) (flip id key) (whereisKey remote)+	askremote = case whereisKey remote of+		Nothing -> pure []+		Just w -> tryNonAsync (w key) >>= \case+			Right l -> pure l+			Left e -> do+				warning $ unwords+					[ "unable to query remote"+					, name remote+					, "for urls:"+					, show e+					]+				return [] 	claimedurls = do 		us <- map fst  			. filter (\(_, d) -> d == OtherDownloader)

@@ -5,10 +5,14 @@  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} -module Config where+module Config (+	module Config,+	annexConfig,+	remoteAnnexConfig,+	remoteConfig,+) where  import Annex.Common import qualified Git@@ -18,13 +22,9 @@ import Config.Cost import Config.DynamicConfig import Types.Availability+import Types.GitConfig import Git.Types-import qualified Types.Remote as Remote -import qualified Data.ByteString as S--type UnqualifiedConfigKey = S.ByteString- {- Looks up a setting in git config. This is not as efficient as using the  - GitConfig type. -} getConfig :: ConfigKey -> ConfigValue -> Annex ConfigValue@@ -50,31 +50,6 @@ unsetConfig :: ConfigKey -> Annex () unsetConfig key = void $ inRepo $ Git.Config.unset key -class RemoteNameable r where-	getRemoteName :: r -> RemoteName--instance RemoteNameable Git.Repo where-	getRemoteName r = fromMaybe "" (Git.remoteName r)--instance RemoteNameable RemoteName where-	 getRemoteName = id--instance RemoteNameable Remote where-	getRemoteName = Remote.name--{- A per-remote config setting in git config. -}-remoteConfig :: RemoteNameable r => r -> UnqualifiedConfigKey -> ConfigKey-remoteConfig r key = ConfigKey $-	"remote." <> encodeBS' (getRemoteName r) <> "." <> key--{- A per-remote config annex setting in git config. -}-remoteAnnexConfig :: RemoteNameable r => r -> UnqualifiedConfigKey -> ConfigKey-remoteAnnexConfig r key = remoteConfig r ("annex-" <> key)--{- A global annex setting in git config. -}-annexConfig :: UnqualifiedConfigKey -> ConfigKey-annexConfig key = ConfigKey ("annex." <> key)- {- Calculates cost for a remote. Either the specific default, or as configured   - by remote.<name>.annex-cost, or if remote.<name>.annex-cost-command  - is set and prints a number, that is used. -}@@ -106,11 +81,5 @@ crippledFileSystem = annexCrippledFileSystem <$> Annex.getGitConfig  setCrippledFileSystem :: Bool -> Annex ()-setCrippledFileSystem b = do+setCrippledFileSystem b = 	setConfig (annexConfig "crippledfilesystem") (Git.Config.boolConfig b)-	Annex.changeGitConfig $ \c -> c { annexCrippledFileSystem = b }--yesNo :: String -> Maybe Bool-yesNo "yes" = Just True-yesNo "no" = Just False-yesNo _ = Nothing

@@ -17,7 +17,8 @@  - repository-global defaults when the GitConfig does not yet   - have a value.  -- - Note: Be sure to add the config value to mergeGitConfig.+ - Note: Be sure to add the config to mergeGitConfig and to+ - globalConfigs.  -} getGitConfigVal :: (GitConfig -> Configurable a) -> Annex a getGitConfigVal f = getGitConfigVal' f >>= \case@@ -35,6 +36,6 @@ 		-- config makes all repository-global default 		-- values populate the GitConfig with HasGlobalConfig 		-- values, so it will only need to be done once.-		Annex.changeGitConfig (\gc -> mergeGitConfig gc globalgc)+		Annex.overrideGitConfig (\gc -> mergeGitConfig gc globalgc) 		f <$> Annex.getGitConfig 	c -> return c

@@ -33,8 +33,9 @@ 	gf <- Annex.fromRepo Git.attributes 	lfs <- readattr lf 	gfs <- readattr gf+	gittop <- fromRawFilePath . Git.localGitDir <$> gitRepo 	liftIO $ unless ("filter=annex" `isInfixOf` (lfs ++ gfs)) $ do-		createDirectoryIfMissing True (takeDirectory lf)+		createDirectoryUnder gittop (takeDirectory lf) 		writeFile lf (lfs ++ "\n" ++ unlines stdattr)   where 	readattr = liftIO . catchDefaultIO "" . readFileStrict

@@ -1,6 +1,6 @@ {- Persistent sqlite database initialization  -- - Copyright 2015-2018 Joey Hess <id@joeyh.name>+ - Copyright 2015-2020 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -29,9 +29,10 @@ 	let dbdir = takeDirectory db 	let tmpdbdir = dbdir ++ ".tmp" 	let tmpdb = tmpdbdir </> "db"-	let tdb = T.pack tmpdb	+	let tdb = T.pack tmpdb+	top <- parentDir . fromRawFilePath <$> fromRepo gitAnnexDir 	liftIO $ do-		createDirectoryIfMissing True tmpdbdir+		createDirectoryUnder top tmpdbdir 		runSqliteInfo (enableWAL tdb) migration 	setAnnexDirPerm tmpdbdir 	-- Work around sqlite bug that prevents it from honoring

@@ -40,12 +40,36 @@ import qualified Data.Map as M import qualified Data.ByteString.Lazy as L -{- Scans for files that are checked into git's index at the specified locations. -}+{- It's only safe to use git ls-files on the current repo, not on a remote.+ -+ - Git has some strange behavior when git ls-files is used with repos+ - that are not the one that the cwd is in:+ - git --git-dir=../foo/.git --worktree=../foo ../foo fails saying + - "../foo is outside repository".+ - That does not happen when an absolute path is provided.+ -+ - Also, the files output by ls-files are relative to the cwd. + - Unless it's run on remote. Then it's relative to the top of the remote+ - repo.+ -+ - So, best to avoid that class of problems.+ -}+safeForLsFiles :: Repo -> Bool+safeForLsFiles r = isNothing (remoteName r)++guardSafeForLsFiles :: Repo -> IO a -> IO a+guardSafeForLsFiles r a+	| safeForLsFiles r = a+	| otherwise = error $ "git ls-files is unsafe to run on repository " ++ repoDescribe r++{- Lists files that are checked into git's index at the specified paths.+ - With no paths, all files are listed.+ -} inRepo :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool) inRepo = inRepo' []   inRepo' :: [CommandParam] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)-inRepo' ps l repo = pipeNullSplit' params repo+inRepo' ps l repo = guardSafeForLsFiles repo $ pipeNullSplit' params repo   where 	params =  		Param "ls-files" :@@ -64,7 +88,8 @@ notInRepo = notInRepo' []  notInRepo' :: [CommandParam] -> Bool -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)-notInRepo' ps include_ignored l repo = pipeNullSplit' params repo+notInRepo' ps include_ignored l repo = guardSafeForLsFiles repo $+	pipeNullSplit' params repo   where 	params = concat 		[ [ Param "ls-files", Param "--others"]@@ -85,18 +110,20 @@ {- Finds all files in the specified locations, whether checked into git or  - not. -} allFiles :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)-allFiles l = pipeNullSplit' $-	Param "ls-files" :-	Param "--cached" :-	Param "--others" :-	Param "-z" :-	Param "--" :-	map (File . fromRawFilePath) l+allFiles l repo = guardSafeForLsFiles repo $ pipeNullSplit' params repo+  where+	params =+		Param "ls-files" :+		Param "--cached" :+		Param "--others" :+		Param "-z" :+		Param "--" :+		map (File . fromRawFilePath) l  {- Returns a list of files in the specified locations that have been  - deleted. -} deleted :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)-deleted l repo = pipeNullSplit' params repo+deleted l repo = guardSafeForLsFiles repo $ pipeNullSplit' params repo   where 	params = 		Param "ls-files" :@@ -108,7 +135,7 @@ {- Returns a list of files in the specified locations that have been  - modified. -} modified :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)-modified l repo = pipeNullSplit' params repo+modified l repo = guardSafeForLsFiles repo $ pipeNullSplit' params repo   where 	params =  		Param "ls-files" :@@ -120,7 +147,7 @@ {- Files that have been modified or are not checked into git (and are not  - ignored). -} modifiedOthers :: [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)-modifiedOthers l repo = pipeNullSplit' params repo+modifiedOthers l repo = guardSafeForLsFiles repo $ pipeNullSplit' params repo   where 	params =  		Param "ls-files" :@@ -141,7 +168,8 @@ stagedNotDeleted = staged' [Param "--diff-filter=ACMRT"]  staged' :: [CommandParam] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)-staged' ps l repo = pipeNullSplit' (prefix ++ ps ++ suffix) repo+staged' ps l repo = guardSafeForLsFiles repo $+	pipeNullSplit' (prefix ++ ps ++ suffix) repo   where 	prefix = [Param "diff", Param "--cached", Param "--name-only", Param "-z"] 	suffix = Param "--" : map (File . fromRawFilePath) l@@ -160,7 +188,7 @@ {- Gets details about staged files, including the Sha of their staged  - contents. -} stagedDetails' :: [CommandParam] -> [RawFilePath] -> Repo -> IO ([StagedDetails], IO Bool)-stagedDetails' ps l repo = do+stagedDetails' ps l repo = guardSafeForLsFiles repo $ do 	(ls, cleanup) <- pipeNullSplit params repo 	return (map parseStagedDetails ls, cleanup)   where@@ -188,7 +216,7 @@ typeChanged = typeChanged' []  typeChanged' :: [CommandParam] -> [RawFilePath] -> Repo -> IO ([RawFilePath], IO Bool)-typeChanged' ps l repo = do+typeChanged' ps l repo = guardSafeForLsFiles repo $ do 	(fs, cleanup) <- pipeNullSplit (prefix ++ ps ++ suffix) repo 	-- git diff returns filenames relative to the top of the git repo; 	-- convert to filenames relative to the cwd, like git ls-files.@@ -228,7 +256,7 @@  - If a line is omitted, that side removed the file.  -} unmerged :: [RawFilePath] -> Repo -> IO ([Unmerged], IO Bool)-unmerged l repo = do+unmerged l repo = guardSafeForLsFiles repo $ do 	(fs, cleanup) <- pipeNullSplit params repo 	return (reduceUnmerged [] $ catMaybes $ map (parseUnmerged . decodeBL') fs, cleanup)   where@@ -292,7 +320,7 @@  - point in the future. If the output is not as expected, will use Nothing.  -} inodeCaches :: [RawFilePath] -> Repo -> IO ([(FilePath, Maybe InodeCache)], IO Bool)-inodeCaches locs repo = do+inodeCaches locs repo = guardSafeForLsFiles repo $ do 	(ls, cleanup) <- pipeNullSplit params repo 	return (parse Nothing (map decodeBL ls), cleanup)   where

@@ -245,8 +245,9 @@ 		nukeFile f   where 	makeref (sha, ref) = do-		let dest = fromRawFilePath (localGitDir r) </> fromRef ref-		createDirectoryIfMissing True (parentDir dest)+		let gitd = fromRawFilePath (localGitDir r)+		let dest = gitd </> fromRef ref+		createDirectoryUnder gitd (parentDir dest) 		unlessM (doesFileExist dest) $ 			writeFile dest (fromRef sha) 

@@ -29,7 +29,7 @@ withLogHandle :: FilePath -> (Handle -> Annex a) -> Annex a withLogHandle f a = do 	createAnnexDirectory (parentDir f)-	replaceFile f $ \tmp ->+	replaceGitAnnexDirFile f $ \tmp -> 		bracket (setup tmp) cleanup a   where 	setup tmp = do

@@ -170,13 +170,13 @@  store :: FilePath -> ChunkConfig -> Key -> L.ByteString -> MeterUpdate -> Annex Bool store d chunkconfig k b p = liftIO $ do-	void $ tryIO $ createDirectoryIfMissing True tmpdir+	void $ tryIO $ createDirectoryUnder d tmpdir 	case chunkconfig of-		LegacyChunks chunksize -> Legacy.store chunksize finalizeStoreGeneric k b p tmpdir destdir+		LegacyChunks chunksize -> Legacy.store d chunksize (finalizeStoreGeneric d) k b p tmpdir destdir 		_ -> do 			let tmpf = tmpdir </> kf 			meteredWriteFile p tmpf b-			finalizeStoreGeneric tmpdir destdir+			finalizeStoreGeneric d tmpdir destdir 			return True   where 	tmpdir = addTrailingPathSeparator $ d </> "tmp" </> kf@@ -187,11 +187,11 @@  - in the dest directory, moves it into place. Anything already existing  - in the dest directory will be deleted. File permissions will be locked  - down. -}-finalizeStoreGeneric :: FilePath -> FilePath -> IO ()-finalizeStoreGeneric tmp dest = do+finalizeStoreGeneric :: FilePath -> FilePath -> FilePath -> IO ()+finalizeStoreGeneric d tmp dest = do 	void $ tryIO $ allowWrite dest -- may already exist 	void $ tryIO $ removeDirectoryRecursive dest -- or not exist-	createDirectoryIfMissing True (parentDir dest)+	createDirectoryUnder d (parentDir dest) 	renameDirectory tmp dest 	-- may fail on some filesystems 	void $ tryIO $ do@@ -267,7 +267,7 @@  storeExportM :: FilePath -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool storeExportM d src _k loc p = liftIO $ catchBoolIO $ do-	createDirectoryIfMissing True (takeDirectory dest)+	createDirectoryUnder d (takeDirectory dest) 	-- Write via temp file so that checkPresentGeneric will not 	-- see it until it's fully stored. 	viaTmp (\tmp () -> withMeteredFile src p (L.writeFile tmp)) dest ()@@ -298,7 +298,7 @@ renameExportM d _k oldloc newloc = liftIO $ Just <$> go   where 	go = catchBoolIO $ do-		createDirectoryIfMissing True (takeDirectory dest)+		createDirectoryUnder d (takeDirectory dest) 		renameFile src dest 		removeExportLocation d oldloc 		return True@@ -413,7 +413,7 @@ 	catchIO go (return . Left . show)   where 	go = do-		liftIO $ createDirectoryIfMissing True destdir+		liftIO $ createDirectoryUnder dir destdir 		withTmpFileIn destdir template $ \tmpf tmph -> do 			liftIO $ withMeteredFile src p (L.hPut tmph) 			liftIO $ hFlush tmph

@@ -70,9 +70,9 @@ 				feed bytes' (sz - s) ls h 			else return (l:ls) -storeHelper :: (FilePath -> FilePath -> IO ()) -> Key -> ([FilePath] -> IO [FilePath]) -> FilePath -> FilePath -> IO Bool-storeHelper finalizer key storer tmpdir destdir = do-	void $ liftIO $ tryIO $ createDirectoryIfMissing True tmpdir+storeHelper :: FilePath -> (FilePath -> FilePath -> IO ()) -> Key -> ([FilePath] -> IO [FilePath]) -> FilePath -> FilePath -> IO Bool+storeHelper repotop finalizer key storer tmpdir destdir = do+	void $ liftIO $ tryIO $ createDirectoryUnder repotop tmpdir 	Legacy.storeChunks key tmpdir destdir storer recorder finalizer   where 	recorder f s = do@@ -80,8 +80,8 @@ 		writeFile f s 		void $ tryIO $ preventWrite f -store :: ChunkSize -> (FilePath -> FilePath -> IO ()) -> Key -> L.ByteString -> MeterUpdate -> FilePath -> FilePath -> IO Bool-store chunksize finalizer k b p = storeHelper finalizer k $ \dests ->+store :: FilePath -> ChunkSize -> (FilePath -> FilePath -> IO ()) -> Key -> L.ByteString -> MeterUpdate -> FilePath -> FilePath -> IO Bool+store repotop chunksize finalizer k b p = storeHelper repotop finalizer k $ \dests -> 	storeLegacyChunked p chunksize dests b  {- Need to get a single ByteString containing every chunk.

@@ -183,7 +183,8 @@ 				=<< strictRemoteConfigParser external 			handleRequest external INITREMOTE Nothing $ \resp -> case resp of 				INITREMOTE_SUCCESS -> result ()-				INITREMOTE_FAILURE errmsg -> Just $ giveup errmsg+				INITREMOTE_FAILURE errmsg -> Just $ giveup $+					respErrorMessage "INITREMOTE" errmsg 				_ -> Nothing 			-- Any config changes the external made before 			-- responding to INITREMOTE need to be applied to@@ -218,7 +219,7 @@ 			TRANSFER_SUCCESS Upload k' | k == k' -> result True 			TRANSFER_FAILURE Upload k' errmsg | k == k' -> 				Just $ do-					warning errmsg+					warning $ respErrorMessage "TRANSFER" errmsg 					return (Result False) 			_ -> Nothing @@ -229,7 +230,8 @@ 			TRANSFER_SUCCESS Download k' 				| k == k' -> result () 			TRANSFER_FAILURE Download k' errmsg-				| k == k' -> Just $ giveup errmsg+				| k == k' -> Just $ giveup $+					respErrorMessage "TRANSFER" errmsg 			_ -> Nothing  removeKeyM :: External -> Remover@@ -240,7 +242,7 @@ 				| k == k' -> result True 			REMOVE_FAILURE k' errmsg 				| k == k' -> Just $ do-					warning errmsg+					warning $ respErrorMessage "REMOVE" errmsg 					return (Result False) 			_ -> Nothing @@ -254,7 +256,8 @@ 			CHECKPRESENT_FAILURE k' 				| k' == k -> result $ Right False 			CHECKPRESENT_UNKNOWN k' errmsg-				| k' == k -> result $ Left errmsg+				| k' == k -> result $ Left $+					respErrorMessage "CHECKPRESENT" errmsg 			_ -> Nothing  whereisKeyM :: External -> Key -> Annex [String]@@ -270,7 +273,7 @@ 		TRANSFER_SUCCESS Upload k' | k == k' -> result True 		TRANSFER_FAILURE Upload k' errmsg | k == k' -> 			Just $ do-				warning errmsg+				warning $ respErrorMessage "TRANSFER" errmsg 				return (Result False) 		UNSUPPORTED_REQUEST -> Just $ do 			warning "TRANSFEREXPORT not implemented by external special remote"@@ -286,7 +289,7 @@ 			| k == k' -> result True 		TRANSFER_FAILURE Download k' errmsg 			| k == k' -> Just $ do-				warning errmsg+				warning $ respErrorMessage "TRANSFER" errmsg 				return (Result False) 		UNSUPPORTED_REQUEST -> Just $ do 			warning "TRANSFEREXPORT not implemented by external special remote"@@ -304,7 +307,8 @@ 		CHECKPRESENT_FAILURE k' 			| k' == k -> result $ Right False 		CHECKPRESENT_UNKNOWN k' errmsg-			| k' == k -> result $ Left errmsg+			| k' == k -> result $ Left $+				respErrorMessage "CHECKPRESENT" errmsg 		UNSUPPORTED_REQUEST -> result $ 			Left "CHECKPRESENTEXPORT not implemented by external special remote" 		_ -> Nothing@@ -316,7 +320,7 @@ 			| k == k' -> result True 		REMOVE_FAILURE k' errmsg 			| k == k' -> Just $ do-				warning errmsg+				warning $ respErrorMessage "REMOVE" errmsg 				return (Result False) 		UNSUPPORTED_REQUEST -> Just $ do 			warning "REMOVEEXPORT not implemented by external special remote"@@ -420,9 +424,9 @@ 			modifyTVar' (externalConfigChanges st) $ \f -> 				f . M.insert (Accepted setting) (Accepted value) 	handleRemoteRequest (GETCONFIG setting) = do-		value <- fromMaybe ""+		value <- maybe "" fromProposedAccepted 			. (M.lookup (Accepted setting))-			. getRemoteConfigPassedThrough+			. unparsedRemoteConfig 			<$> liftIO (atomically $ readTVar $ externalConfig st) 		send $ VALUE value 	handleRemoteRequest (SETCREDS setting login password) = case (externalUUID external, externalGitConfig external) of@@ -684,13 +688,19 @@ 						setprepared Prepared 						return (Result ()) 					PREPARE_FAILURE errmsg -> Just $ do-						setprepared $ FailedPrepare errmsg-						giveup errmsg+						let errmsg' = respErrorMessage "PREPARE" errmsg+						setprepared $ FailedPrepare errmsg'+						giveup errmsg' 					_ -> Nothing   where 	setprepared status = liftIO $ atomically $ void $ 		swapTVar (externalPrepared st) status +respErrorMessage :: String -> String -> String+respErrorMessage req err+	| null err = req ++ " failed with no reason given"+	| otherwise = err+ {- Caches the cost in the git config to avoid needing to start up an  - external special remote every time time just to ask it what its  - cost is. -}@@ -743,7 +753,8 @@ 		CHECKURL_CONTENTS sz f -> result $ UrlContents sz $ 			if null f then Nothing else Just $ mkSafeFilePath f 		CHECKURL_MULTI l -> result $ UrlMulti $ map mkmulti l-		CHECKURL_FAILURE errmsg -> Just $ giveup errmsg+		CHECKURL_FAILURE errmsg -> Just $ giveup $+			respErrorMessage "CHECKURL" errmsg 		UNSUPPORTED_REQUEST -> giveup "CHECKURL not implemented by external special remote" 		_ -> Nothing   where

@@ -49,6 +49,7 @@ import Utility.Metered import Annex.UUID import Annex.Ssh+import Annex.Perms import qualified Remote.Rsync import qualified Remote.Directory import Utility.Rsync@@ -283,7 +284,7 @@ 	 - which is needed for direct rsync of objects to work. 	 -} 	rsyncsetup = Remote.Rsync.withRsyncScratchDir $ \tmp -> do-		liftIO $ createDirectoryIfMissing True $ tmp </> objectDir+		createAnnexDirectory (tmp </> objectDir) 		dummycfg <- liftIO dummyRemoteGitConfig 		(rsynctransport, rsyncurl, _) <- rsyncTransport r dummycfg 		let tmpconfig = tmp </> "config"@@ -368,11 +369,11 @@ 	| not $ Git.repoIsUrl repo =  		byteStorer $ \k b p -> guardUsable repo (return False) $ liftIO $ do 			let tmpdir = Git.repoLocation repo </> "tmp" </> fromRawFilePath (keyFile k)-			void $ tryIO $ createDirectoryIfMissing True tmpdir+			void $ tryIO $ createDirectoryUnder (Git.repoLocation repo) tmpdir 			let tmpf = tmpdir </> fromRawFilePath (keyFile k) 			meteredWriteFile p tmpf b 			let destdir = parentDir $ gCryptLocation repo k-			Remote.Directory.finalizeStoreGeneric tmpdir destdir+			Remote.Directory.finalizeStoreGeneric (Git.repoLocation repo) tmpdir destdir 			return True 	| Git.repoIsSsh repo = if accessShell r 		then fileStorer $ \k f p -> do

@@ -167,7 +167,7 @@ 	-- (so it's also usable by git as a non-special remote), 	-- and set remote.name.annex-git-lfs = true 	gitConfigSpecialRemote u c' [("git-lfs", "true")]-	setConfig (remoteConfig (getRemoteName c) "url") url+	setConfig (remoteConfig c "url") url 	return (c', u)   where 	url = maybe (giveup "Specify url=") fromProposedAccepted 

@@ -48,7 +48,7 @@ 	dir <- fromRepo gitAnnexRemotesDir 	let lck = dir </> remoteid ++ ".lck" 	whenM (notElem lck . M.keys <$> getLockCache) $ do-		liftIO $ createDirectoryIfMissing True dir+		createAnnexDirectory dir 		firstrun lck 	a   where

@@ -27,6 +27,7 @@ import Annex.Content import Annex.UUID import Annex.Ssh+import Annex.Perms import Remote.Helper.Special import Remote.Helper.Messages import Remote.Helper.ExportImport@@ -218,7 +219,7 @@ storeGeneric :: RsyncOpts -> MeterUpdate -> FilePath -> (FilePath -> Annex Bool) -> Annex Bool storeGeneric o meterupdate basedest populatedest = withRsyncScratchDir $ \tmp -> do 	let dest = tmp </> basedest-	liftIO $ createDirectoryIfMissing True $ parentDir dest+	createAnnexDirectory (parentDir dest) 	ok <- populatedest dest 	ps <- sendParams 	if ok

@@ -161,7 +161,7 @@ 		| otherwise = Nothing  properties :: TestTree-properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck"+properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck" $ 	[ testProperty "prop_encode_decode_roundtrip" Git.Filename.prop_encode_decode_roundtrip 	, testProperty "prop_encode_c_decode_c_roundtrip" Utility.Format.prop_encode_c_decode_c_roundtrip 	, testProperty "prop_isomorphic_key_encode" Key.prop_isomorphic_key_encode@@ -185,8 +185,6 @@ 	, testProperty "prop_parse_build_contentidentifier_log" Logs.ContentIdentifier.prop_parse_build_contentidentifier_log 	, testProperty "prop_read_show_TrustLevel" Types.TrustLevel.prop_read_show_TrustLevel 	, testProperty "prop_parse_build_TrustLevelLog" Logs.Trust.prop_parse_build_TrustLevelLog-	, testProperty "prop_hashes_stable" Utility.Hash.prop_hashes_stable-	, testProperty "prop_mac_stable" Utility.Hash.prop_mac_stable 	, testProperty "prop_schedule_roundtrips" Utility.Scheduled.QuickCheck.prop_schedule_roundtrips 	, testProperty "prop_past_sane" Utility.Scheduled.prop_past_sane 	, testProperty "prop_duration_roundtrips" Utility.HumanTime.prop_duration_roundtrips@@ -198,7 +196,12 @@ 	, testProperty "prop_viewedFile_rountrips" Annex.View.ViewedFile.prop_viewedFile_roundtrips 	, testProperty "prop_b64_roundtrips" Utility.Base64.prop_b64_roundtrips 	, testProperty "prop_standardGroups_parse" Logs.PreferredContent.prop_standardGroups_parse-	]+	] ++ map (uncurry testProperty) combos+  where+	combos = concat+		[ Utility.Hash.props_hashes_stable+		, Utility.Hash.props_macs_stable+		]  {- These tests set up the test environment, but also test some basic parts  - of git-annex. They are always run before the unitTests. -}

@@ -1,10 +1,11 @@ {- git-annex configuration  -- - Copyright 2012-2019 Joey Hess <id@joeyh.name>+ - Copyright 2012-2020 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-}  module Types.GitConfig ( @@ -13,9 +14,14 @@ 	GitConfig(..), 	extractGitConfig, 	mergeGitConfig,+	globalConfigs, 	RemoteGitConfig(..), 	extractRemoteGitConfig, 	dummyRemoteGitConfig,+	annexConfig,+	RemoteNameable(..),+	remoteAnnexConfig,+	remoteConfig, ) where  import Common@@ -43,6 +49,7 @@  import Control.Concurrent.STM import qualified Data.Set as S+import qualified Data.ByteString as B  -- | A configurable value, that may not be fully determined yet because -- the global git config has not yet been loaded.@@ -125,84 +132,86 @@  extractGitConfig :: ConfigSource -> Git.Repo -> GitConfig extractGitConfig configsource r = GitConfig-	{ annexVersion = RepoVersion <$> getmayberead (annex "version")-	, annexUUID = maybe NoUUID toUUID $ getmaybe (annex "uuid")-	, annexNumCopies = NumCopies <$> getmayberead (annex "numcopies")+	{ annexVersion = RepoVersion <$> getmayberead (annexConfig "version")+	, annexUUID = maybe NoUUID toUUID $ getmaybe (annexConfig "uuid")+	, annexNumCopies = NumCopies <$> getmayberead (annexConfig "numcopies") 	, annexDiskReserve = fromMaybe onemegabyte $-		readSize dataUnits =<< getmaybe (annex "diskreserve")-	, annexDirect = getbool (annex "direct") False+		readSize dataUnits =<< getmaybe (annexConfig "diskreserve")+	, annexDirect = getbool (annexConfig "direct") False 	, annexBackend = maybe 		-- annex.backends is the old name of the option, still used 		-- when annex.backend is not set.-		(headMaybe $ getwords (annex "backends"))+		(headMaybe $ getwords (annexConfig "backends")) 		Just-		(getmaybe (annex "backend"))-	, annexQueueSize = getmayberead (annex "queuesize")-	, annexBloomCapacity = getmayberead (annex "bloomcapacity")-	, annexBloomAccuracy = getmayberead (annex "bloomaccuracy")-	, annexSshCaching = getmaybebool (annex "sshcaching")-	, annexAlwaysCommit = getbool (annex "alwayscommit") True-	, annexCommitMessage = getmaybe (annex "commitmessage")-	, annexMergeAnnexBranches = getbool (annex "merge-annex-branches") True-	, annexDelayAdd = getmayberead (annex "delayadd")-	, annexHttpHeaders = getlist (annex "http-headers")-	, annexHttpHeadersCommand = getmaybe (annex "http-headers-command")+		(getmaybe (annexConfig "backend"))+	, annexQueueSize = getmayberead (annexConfig "queuesize")+	, annexBloomCapacity = getmayberead (annexConfig "bloomcapacity")+	, annexBloomAccuracy = getmayberead (annexConfig "bloomaccuracy")+	, annexSshCaching = getmaybebool (annexConfig "sshcaching")+	, annexAlwaysCommit = getbool (annexConfig "alwayscommit") True+	, annexCommitMessage = getmaybe (annexConfig "commitmessage")+	, annexMergeAnnexBranches = getbool (annexConfig "merge-annex-branches") True+	, annexDelayAdd = getmayberead (annexConfig "delayadd")+	, annexHttpHeaders = getlist (annexConfig "http-headers")+	, annexHttpHeadersCommand = getmaybe (annexConfig "http-headers-command") 	, annexAutoCommit = configurable True $ -		getmaybebool (annex "autocommit")+		getmaybebool (annexConfig "autocommit") 	, annexResolveMerge = configurable True $ -		getmaybebool (annex "resolvemerge")+		getmaybebool (annexConfig "resolvemerge") 	, annexSyncContent = configurable False $ -		getmaybebool (annex "synccontent")+		getmaybebool (annexConfig "synccontent") 	, annexSyncOnlyAnnex = configurable False $ -		getmaybebool (annex "synconlyannex")-	, annexDebug = getbool (annex "debug") False-	, annexWebOptions = getwords (annex "web-options")-	, annexYoutubeDlOptions = getwords (annex "youtube-dl-options")-	, annexAriaTorrentOptions = getwords (annex "aria-torrent-options")-	, annexCrippledFileSystem = getbool (annex "crippledfilesystem") False+		getmaybebool (annexConfig "synconlyannex")+	, annexDebug = getbool (annexConfig "debug") False+	, annexWebOptions = getwords (annexConfig "web-options")+	, annexYoutubeDlOptions = getwords (annexConfig "youtube-dl-options")+	, annexAriaTorrentOptions = getwords (annexConfig "aria-torrent-options")+	, annexCrippledFileSystem = getbool (annexConfig "crippledfilesystem") False 	, annexLargeFiles = configurable Nothing $-		fmap Just $ getmaybe (annex "largefiles")-	, annexDotFiles = configurable False $ getmaybebool (annex "dotfiles")-	, annexGitAddToAnnex = getbool (annex "gitaddtoannex") True-	, annexAddSmallFiles = getbool (annex "addsmallfiles") True-	, annexFsckNudge = getbool (annex "fscknudge") True-	, annexAutoUpgrade = toAutoUpgrade $ getmaybe (annex "autoupgrade")+		fmap Just $ getmaybe (annexConfig "largefiles")+	, annexDotFiles = configurable False $+		getmaybebool (annexConfig "dotfiles")+	, annexGitAddToAnnex = getbool (annexConfig "gitaddtoannex") True+	, annexAddSmallFiles = getbool (annexConfig "addsmallfiles") True+	, annexFsckNudge = getbool (annexConfig "fscknudge") True+	, annexAutoUpgrade = toAutoUpgrade $+		getmaybe (annexConfig "autoupgrade") 	, annexExpireUnused = maybe Nothing Just . parseDuration-		<$> getmaybe (annex "expireunused")-	, annexSecureEraseCommand = getmaybe (annex "secure-erase-command")-	, annexGenMetaData = getbool (annex "genmetadata") False-	, annexListen = getmaybe (annex "listen")-	, annexStartupScan = getbool (annex "startupscan") True-	, annexHardLink = getbool (annex "hardlink") False-	, annexThin = getbool (annex "thin") False+		<$> getmaybe (annexConfig "expireunused")+	, annexSecureEraseCommand = getmaybe (annexConfig "secure-erase-command")+	, annexGenMetaData = getbool (annexConfig "genmetadata") False+	, annexListen = getmaybe (annexConfig "listen")+	, annexStartupScan = getbool (annexConfig "startupscan") True+	, annexHardLink = getbool (annexConfig "hardlink") False+	, annexThin = getbool (annexConfig "thin") False 	, annexDifferences = getDifferences r 	, annexUsedRefSpec = either (const Nothing) Just . parseRefSpec -		=<< getmaybe (annex "used-refspec")-	, annexVerify = getbool (annex "verify") True-	, annexPidLock = getbool (annex "pidlock") False+		=<< getmaybe (annexConfig "used-refspec")+	, annexVerify = getbool (annexConfig "verify") True+	, annexPidLock = getbool (annexConfig "pidlock") False 	, annexPidLockTimeout = Seconds $ fromMaybe 300 $-		getmayberead (annex "pidlocktimeout")+		getmayberead (annexConfig "pidlocktimeout") 	, annexAddUnlocked = configurable Nothing $-		fmap Just $ getmaybe (annex "addunlocked")-	, annexSecureHashesOnly = getbool (annex "securehashesonly") False-	, annexRetry = getmayberead (annex "retry")+		fmap Just $ getmaybe (annexConfig "addunlocked")+	, annexSecureHashesOnly = getbool (annexConfig "securehashesonly") False+	, annexRetry = getmayberead (annexConfig "retry") 	, annexRetryDelay = Seconds-		<$> getmayberead (annex "retrydelay")+		<$> getmayberead (annexConfig "retrydelay") 	, annexAllowedUrlSchemes = S.fromList $ map mkScheme $ 		maybe ["http", "https", "ftp"] words $-			getmaybe (annex "security.allowed-url-schemes")+			getmaybe (annexConfig "security.allowed-url-schemes") 	, annexAllowedIPAddresses = fromMaybe "" $-		getmaybe (annex "security.allowed-ip-addresses")+		getmaybe (annexConfig "security.allowed-ip-addresses") 			<|>-		getmaybe (annex "security.allowed-http-addresses") -- old name+		getmaybe (annexConfig "security.allowed-http-addresses") -- old name 	, annexAllowUnverifiedDownloads = (== Just "ACKTHPPT") $-		getmaybe (annex "security.allow-unverified-downloads")-	, annexMaxExtensionLength = getmayberead (annex "maxextensionlength")+		getmaybe (annexConfig "security.allow-unverified-downloads")+	, annexMaxExtensionLength = getmayberead (annexConfig "maxextensionlength") 	, annexJobs = fromMaybe NonConcurrent $ -		parseConcurrency =<< getmaybe (annex "jobs")-	, annexCacheCreds = getbool (annex "cachecreds") True-	, annexAutoUpgradeRepository = getbool (annex "autoupgraderepository") True-	, annexCommitMode = if getbool (annex "allowsign") False+		parseConcurrency =<< getmaybe (annexConfig "jobs")+	, annexCacheCreds = getbool (annexConfig "cachecreds") True+	, annexAutoUpgradeRepository = getbool (annexConfig "autoupgraderepository") True+	, annexCommitMode = if getbool (annexConfig "allowsign") False 		then ManualCommit 		else AutomaticCommit 	, coreSymlinks = getbool "core.symlinks" True@@ -225,8 +234,6 @@ 		FromGitConfig -> HasGitConfig v 		FromGlobalConfig -> HasGlobalConfig v -	annex k = ConfigKey $ "annex." <> k-			 	onemegabyte = 1000000  {- Merge a GitConfig that comes from git-config with one containing@@ -249,6 +256,18 @@ 			_ -> HasGitConfig d 		HasGlobalConfig v -> HasGlobalConfig v +{- Configs that can be set repository-global. -}+globalConfigs :: [ConfigKey]+globalConfigs =+	[ annexConfig "autocommit"+	, annexConfig "synccontent"+	, annexConfig "synconlyannex"+	, annexConfig "resolvemerge"+	, annexConfig "largefiles"+	, annexConfig "dotfiles"+	, annexConfig "addunlocked"+	]+ {- Per-remote git-annex settings. Each setting corresponds to a git-config  - key such as <remote>.annex-foo, or if that is not set, a default from  - annex.foo.@@ -366,14 +385,10 @@ 	getmaybebool k = Git.Config.isTrueFalse' =<< getmaybe' k 	getmayberead k = readish =<< getmaybe k 	getmaybe = fmap fromConfigValue . getmaybe'-	getmaybe' k = mplus (Git.Config.getMaybe (key k) r)-		(Git.Config.getMaybe (remotekey k) r)+	getmaybe' k = mplus (Git.Config.getMaybe (annexConfig k) r)+		(Git.Config.getMaybe (remoteAnnexConfig remotename k) r) 	getoptions k = fromMaybe [] $ words <$> getmaybe k -	key k = ConfigKey $ "annex." <> k-	remotekey k = ConfigKey $-		"remote." <> encodeBS' remotename <> ".annex-" <> k- notempty :: Maybe String -> Maybe String	 notempty Nothing = Nothing notempty (Just "") = Nothing@@ -382,3 +397,27 @@ dummyRemoteGitConfig :: IO RemoteGitConfig dummyRemoteGitConfig = atomically $  	extractRemoteGitConfig Git.Construct.fromUnknown "dummy"++type UnqualifiedConfigKey = B.ByteString++{- A global annex setting in git config. -}+annexConfig :: UnqualifiedConfigKey -> ConfigKey+annexConfig key = ConfigKey ("annex." <> key)++class RemoteNameable r where+	getRemoteName :: r -> RemoteName++instance RemoteNameable Git.Repo where+	getRemoteName r = fromMaybe "" (Git.remoteName r)++instance RemoteNameable RemoteName where+	 getRemoteName = id++{- A per-remote annex setting in git config. -}+remoteAnnexConfig :: RemoteNameable r => r -> UnqualifiedConfigKey -> ConfigKey+remoteAnnexConfig r key = remoteConfig r ("annex-" <> key)++{- A per-remote setting in git config. -}+remoteConfig :: RemoteNameable r => r -> UnqualifiedConfigKey -> ConfigKey+remoteConfig r key = ConfigKey $+	"remote." <> encodeBS' (getRemoteName r) <> "." <> key

@@ -153,6 +153,9 @@ 	, remoteStateHandle :: RemoteStateHandle 	} +instance RemoteNameable (RemoteA a) where+	getRemoteName = name+ instance Show (RemoteA a) where 	show remote = "Remote { name =\"" ++ name remote ++ "\" }" 

@@ -23,8 +23,9 @@  {- Before being used a RemoteConfig has to be parsed. -} data ParsedRemoteConfig = ParsedRemoteConfig-	(M.Map RemoteConfigField RemoteConfigValue)-	RemoteConfig+	{ parsedRemoteConfigMap :: M.Map RemoteConfigField RemoteConfigValue+	, unparsedRemoteConfig :: RemoteConfig+	}  {- Remotes can have configuration values of many types, so use Typeable  - to let them all be stored in here. -}

@@ -1,6 +1,6 @@ {- git-annex upgrade support  -- - Copyright 2010-2019 Joey Hess <id@joeyh.name>+ - Copyright 2010-2020 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -12,6 +12,8 @@ import Annex.Common import qualified Annex import qualified Git+import Config+import Config.Files import Annex.Version import Types.RepoVersion #ifndef mingw32_HOST_OS@@ -61,18 +63,26 @@ upgrade :: Bool -> RepoVersion -> Annex Bool upgrade automatic destversion = do 	upgraded <- go =<< getVersion-	when upgraded $-		setVersion destversion+	when upgraded+		postupgrade 	return upgraded   where 	go (Just v) 		| v >= destversion = return True-		| otherwise = ifM (up v)-			( go (Just (RepoVersion (fromRepoVersion v + 1)))-			, return False+		| otherwise = ifM upgradingRemote+			( upgraderemote+			, ifM (up v)+				( go (Just (RepoVersion (fromRepoVersion v + 1)))+				, return False+				) 			) 	go _ = return True +	postupgrade = ifM upgradingRemote+		( reloadConfig+		, setVersion destversion+		)+ #ifndef mingw32_HOST_OS 	up (RepoVersion 0) = Upgrade.V0.upgrade 	up (RepoVersion 1) = Upgrade.V1.upgrade@@ -87,3 +97,19 @@ 	up (RepoVersion 6) = Upgrade.V6.upgrade automatic 	up (RepoVersion 7) = Upgrade.V7.upgrade automatic 	up _ = return True++	-- Upgrade local remotes by running git-annex upgrade in them.+	-- This avoids complicating the upgrade code by needing to handle+	-- upgrading a git repo other than the current repo.+	upgraderemote = do+		rp <- fromRawFilePath <$> fromRepo Git.repoPath+		cmd <- liftIO readProgramFile+		liftIO $ boolSystem' cmd+			[ Param "upgrade"+			, Param "--quiet"+			, Param "--autoonly"+			]+			(\p -> p { cwd = Just rp })++upgradingRemote :: Annex Bool+upgradingRemote = isJust <$> fromRepo Git.remoteName

@@ -17,6 +17,7 @@ import Annex.Common import Annex.Content import Annex.Link+import Annex.Perms import Types.Key import Logs.Presence import qualified Annex.Queue@@ -115,7 +116,7 @@ 		dest <- fromRepo $ logFile2 k 		dir <- fromRepo Upgrade.V2.gitStateDir 		let f = dir </> l-		liftIO $ createDirectoryIfMissing True (parentDir dest)+		createWorkTreeDirectory (parentDir dest) 		-- could just git mv, but this way deals with 		-- log files that are not checked into git, 		-- as well as merging with already upgraded

@@ -10,7 +10,6 @@ module Upgrade.V5 where  import Annex.Common-import qualified Annex import Config import Config.Smudge import Annex.InodeSentinal@@ -84,7 +83,6 @@ 	 - space, with less preservation of old versions of files 	 - as does annex.thin. -} 	setConfig (annexConfig "thin") (boolConfig True)-	Annex.changeGitConfig $ \c -> c { annexThin = True } 	Direct.setIndirect 	cur <- fromMaybe (error "Somehow no branch is checked out") 		<$> inRepo Git.Branch.current

@@ -19,7 +19,6 @@ ) where  import Annex.Common-import qualified Annex import qualified Git import qualified Git.Config import qualified Git.Ref@@ -35,7 +34,6 @@ 	setbare 	switchHEADBack 	setConfig (annexConfig "direct") val-	Annex.changeGitConfig $ \c -> c { annexDirect = False }   where 	val = Git.Config.boolConfig False 	coreworktree = ConfigKey "core.worktree"

@@ -101,7 +101,7 @@ 	(l, cleanup) <- inRepo $ LsFiles.inodeCaches [top] 	forM_ l $ \case 		(_f, Nothing) -> giveup "Unable to parse git ls-files --debug output while upgrading git-annex sqlite databases."-		(f, Just ic) -> unlessM (liftIO $ isSymbolicLink <$> getSymbolicLinkStatus f) $ do+		(f, Just ic) -> unlessM (liftIO $ catchBoolIO $ isSymbolicLink <$> getSymbolicLinkStatus f) $ do 			catKeyFile (toRawFilePath f) >>= \case 				Nothing -> noop 				Just k -> do

@@ -90,7 +90,6 @@  - Fails if the pid file is already locked by another process. -} lockPidFile :: FilePath -> IO () lockPidFile pidfile = do-	createDirectoryIfMissing True (parentDir pidfile) #ifndef mingw32_HOST_OS 	fd <- openFd pidfile ReadWrite (Just stdFileMode) defaultFileFlags 	locked <- catchMaybeIO $ setLock fd (WriteLock, AbsoluteSeek, 0, 0)

@@ -1,11 +1,12 @@ {- directory traversal and manipulation  -- - Copyright 2011-2014 Joey Hess <id@joeyh.name>+ - Copyright 2011-2020 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -}  {-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -fno-warn-tabs #-}  module Utility.Directory (@@ -18,7 +19,9 @@ import System.FilePath import System.PosixCompat.Files import Control.Applicative+import Control.Monad.IO.Class import System.IO.Unsafe (unsafeInterleaveIO)+import System.IO.Error import Data.Maybe import Prelude @@ -28,10 +31,12 @@ #endif  import Utility.SystemDirectory+import Utility.Path import Utility.Tmp import Utility.Exception import Utility.Monad import Utility.Applicative+import Utility.PartialPrelude  dirCruft :: FilePath -> Bool dirCruft "." = True@@ -154,3 +159,74 @@ #else 	go = removeFile file #endif++{- Like createDirectoryIfMissing True, but it will only create+ - missing parent directories up to but not including the directory+ - in the first parameter.+ -+ - For example, createDirectoryUnder "/tmp/foo" "/tmp/foo/bar/baz"+ - will create /tmp/foo/bar if necessary, but if /tmp/foo does not exist,+ - it will throw an exception.+ -+ - The exception thrown is the same that createDirectory throws if the+ - parent directory does not exist.+ -+ - If the second FilePath is not under the first+ - FilePath (or the same as it), it will fail with an exception+ - even if the second FilePath's parent directory already exists.+ -+ - Either or both of the FilePaths can be relative, or absolute.+ - They will be normalized as necessary.+ -+ - Note that, the second FilePath, if relative, is relative to the current+ - working directory, not to the first FilePath.+ -}+createDirectoryUnder :: FilePath -> FilePath -> IO ()+createDirectoryUnder topdir dir =+	createDirectoryUnder' topdir dir createDirectory++createDirectoryUnder'+	:: (MonadIO m, MonadCatch m)+	=> FilePath+	-> FilePath+	-> (FilePath -> m ())+	-> m ()+createDirectoryUnder' topdir dir0 mkdir = do+	p <- liftIO $ relPathDirToFile topdir dir0+	let dirs = splitDirectories p+	-- Catch cases where the dir is not beneath the topdir.+	-- If the relative path between them starts with "..",+	-- it's not. And on Windows, if they are on different drives,+	-- the path will not be relative.+	if headMaybe dirs == Just ".." || isAbsolute p+		then liftIO $ ioError $ customerror userErrorType+			("createDirectoryFrom: not located in " ++ topdir)+		-- If dir0 is the same as the topdir, don't try to create+		-- it, but make sure it does exist.+		else if null dirs+			then liftIO $ unlessM (doesDirectoryExist topdir) $+				ioError $ customerror doesNotExistErrorType+					"createDirectoryFrom: does not exist"+			else createdirs $+				map (topdir </>) (reverse (scanl1 (</>) dirs))+  where+	customerror t s = mkIOError t s Nothing (Just dir0)++	createdirs [] = pure ()+	createdirs (dir:[]) = createdir dir (liftIO . ioError)+	createdirs (dir:dirs) = createdir dir $ \_ -> do+		createdirs dirs+		createdir dir (liftIO . ioError)++	-- This is the same method used by createDirectoryIfMissing,+	-- in particular the handling of errors that occur when the+	-- directory already exists. See its source for explanation+	-- of several subtleties.+	createdir dir notexisthandler = tryIO (mkdir dir) >>= \case+		Right () -> pure ()+		Left e+			| isDoesNotExistError e -> notexisthandler e+			| isAlreadyExistsError e || isPermissionError e ->+				liftIO $ unlessM (doesDirectoryExist dir) $+					ioError e+			| otherwise -> liftIO $ ioError e

@@ -25,10 +25,10 @@ 	blake2bp_512, 	md5, 	md5s,-	prop_hashes_stable,+	props_hashes_stable, 	Mac(..), 	calcMac,-	prop_mac_stable,+	props_macs_stable, ) where  import qualified Data.ByteString as S@@ -111,31 +111,31 @@ md5s = hash  {- Check that all the hashes continue to hash the same. -}-prop_hashes_stable :: Bool-prop_hashes_stable = all (\(hasher, result) -> hasher foo == result)-	[ (show . sha1, "0beec7b5ea3f0fdbc95d0dd47f3c5bc275da8a33")-	, (show . sha2_224, "0808f64e60d58979fcb676c96ec938270dea42445aeefcd3a4e6f8db")-	, (show . sha2_256, "2c26b46b68ffc68ff99b453c1d30413413422d706483bfa0f98a5e886266e7ae")-	, (show . sha2_384, "98c11ffdfdd540676b1a137cb1a22b2a70350c9a44171d6b1180c6be5cbb2ee3f79d532c8a1dd9ef2e8e08e752a3babb")-	, (show . sha2_512, "f7fbba6e0636f890e56fbbf3283e524c6fa3204ae298382d624741d0dc6638326e282c41be5e4254d8820772c5518a2c5a8c0c7f7eda19594a7eb539453e1ed7")-	, (show . skein256, "a04efd9a0aeed6ede40fe5ce0d9361ae7b7d88b524aa19917b9315f1ecf00d33")-	, (show . skein512, "fd8956898113510180aa4658e6c0ac85bd74fb47f4a4ba264a6b705d7a8e8526756e75aecda12cff4f1aca1a4c2830fbf57f458012a66b2b15a3dd7d251690a7")-	, (show . sha3_224, "f4f6779e153c391bbd29c95e72b0708e39d9166c7cea51d1f10ef58a")-	, (show . sha3_256, "76d3bc41c9f588f7fcd0d5bf4718f8f84b1c41b20882703100b9eb9413807c01")-	, (show . sha3_384, "665551928d13b7d84ee02734502b018d896a0fb87eed5adb4c87ba91bbd6489410e11b0fbcc06ed7d0ebad559e5d3bb5")-	, (show . sha3_512, "4bca2b137edc580fe50a88983ef860ebaca36c857b1f492839d6d7392452a63c82cbebc68e3b70a2a1480b4bb5d437a7cba6ecf9d89f9ff3ccd14cd6146ea7e7")-	, (show . blake2s_160, "52fb63154f958a5c56864597273ea759e52c6f00")-	, (show . blake2s_224, "9466668503ac415d87b8e1dfd7f348ab273ac1d5e4f774fced5fdb55")-	, (show . blake2s_256, "08d6cad88075de8f192db097573d0e829411cd91eb6ec65e8fc16c017edfdb74")-	, (show . blake2sp_224, "8492d356fbac99f046f55e114301f7596649cb590e5b083d1a19dcdb")-	, (show . blake2sp_256, "050dc5786037ea72cb9ed9d0324afcab03c97ec02e8c47368fc5dfb4cf49d8c9")-	, (show . blake2b_160, "983ceba2afea8694cc933336b27b907f90c53a88")-	, (show . blake2b_224, "853986b3fe231d795261b4fb530e1a9188db41e460ec4ca59aafef78")-	, (show . blake2b_256, "b8fe9f7f6255a6fa08f668ab632a8d081ad87983c77cd274e48ce450f0b349fd")-	, (show . blake2b_384, "e629ee880953d32c8877e479e3b4cb0a4c9d5805e2b34c675b5a5863c4ad7d64bb2a9b8257fac9d82d289b3d39eb9cc2")-	, (show . blake2b_512, "ca002330e69d3e6b84a46a56a6533fd79d51d97a3bb7cad6c2ff43b354185d6dc1e723fb3db4ae0737e120378424c714bb982d9dc5bbd7a0ab318240ddd18f8d")-	, (show . blake2bp_512, "8ca9ccee7946afcb686fe7556628b5ba1bf9a691da37ca58cd049354d99f37042c007427e5f219b9ab5063707ec6823872dee413ee014b4d02f2ebb6abb5f643")-	, (show . md5, "acbd18db4cc2f85cedef654fccc4a4d8")+props_hashes_stable :: [(String, Bool)]+props_hashes_stable = map (\(desc, hasher, result) -> (desc ++ " stable", hasher foo == result))+	[ ("sha1", show . sha1, "0beec7b5ea3f0fdbc95d0dd47f3c5bc275da8a33")+	, ("sha2_224", show . sha2_224, "0808f64e60d58979fcb676c96ec938270dea42445aeefcd3a4e6f8db")+	, ("sha2_256", show . sha2_256, "2c26b46b68ffc68ff99b453c1d30413413422d706483bfa0f98a5e886266e7ae")+	, ("sha2_384", show . sha2_384, "98c11ffdfdd540676b1a137cb1a22b2a70350c9a44171d6b1180c6be5cbb2ee3f79d532c8a1dd9ef2e8e08e752a3babb")+	, ("sha2_512", show . sha2_512, "f7fbba6e0636f890e56fbbf3283e524c6fa3204ae298382d624741d0dc6638326e282c41be5e4254d8820772c5518a2c5a8c0c7f7eda19594a7eb539453e1ed7")+	, ("skein256", show . skein256, "a04efd9a0aeed6ede40fe5ce0d9361ae7b7d88b524aa19917b9315f1ecf00d33")+	, ("skein512", show . skein512, "fd8956898113510180aa4658e6c0ac85bd74fb47f4a4ba264a6b705d7a8e8526756e75aecda12cff4f1aca1a4c2830fbf57f458012a66b2b15a3dd7d251690a7")+	, ("sha3_224", show . sha3_224, "f4f6779e153c391bbd29c95e72b0708e39d9166c7cea51d1f10ef58a")+	, ("sha3_256", show . sha3_256, "76d3bc41c9f588f7fcd0d5bf4718f8f84b1c41b20882703100b9eb9413807c01")+	, ("sha3_384", show . sha3_384, "665551928d13b7d84ee02734502b018d896a0fb87eed5adb4c87ba91bbd6489410e11b0fbcc06ed7d0ebad559e5d3bb5")+	, ("sha3_512", show . sha3_512, "4bca2b137edc580fe50a88983ef860ebaca36c857b1f492839d6d7392452a63c82cbebc68e3b70a2a1480b4bb5d437a7cba6ecf9d89f9ff3ccd14cd6146ea7e7")+	, ("blake2s_160", show . blake2s_160, "52fb63154f958a5c56864597273ea759e52c6f00")+	, ("blake2s_224", show . blake2s_224, "9466668503ac415d87b8e1dfd7f348ab273ac1d5e4f774fced5fdb55")+	, ("blake2s_256", show . blake2s_256, "08d6cad88075de8f192db097573d0e829411cd91eb6ec65e8fc16c017edfdb74")+	, ("blake2sp_224", show . blake2sp_224, "8492d356fbac99f046f55e114301f7596649cb590e5b083d1a19dcdb")+	, ("blake2sp_256", show . blake2sp_256, "050dc5786037ea72cb9ed9d0324afcab03c97ec02e8c47368fc5dfb4cf49d8c9")+	, ("blake2b_160", show . blake2b_160, "983ceba2afea8694cc933336b27b907f90c53a88")+	, ("blake2b_224", show . blake2b_224, "853986b3fe231d795261b4fb530e1a9188db41e460ec4ca59aafef78")+	, ("blake2b_256", show . blake2b_256, "b8fe9f7f6255a6fa08f668ab632a8d081ad87983c77cd274e48ce450f0b349fd")+	, ("blake2b_384", show . blake2b_384, "e629ee880953d32c8877e479e3b4cb0a4c9d5805e2b34c675b5a5863c4ad7d64bb2a9b8257fac9d82d289b3d39eb9cc2")+	, ("blake2b_512", show . blake2b_512, "ca002330e69d3e6b84a46a56a6533fd79d51d97a3bb7cad6c2ff43b354185d6dc1e723fb3db4ae0737e120378424c714bb982d9dc5bbd7a0ab318240ddd18f8d")+	, ("blake2bp_512", show . blake2bp_512, "8ca9ccee7946afcb686fe7556628b5ba1bf9a691da37ca58cd049354d99f37042c007427e5f219b9ab5063707ec6823872dee413ee014b4d02f2ebb6abb5f643")+	, ("md5", show . md5, "acbd18db4cc2f85cedef654fccc4a4d8") 	]   where 	foo = L.fromChunks [T.encodeUtf8 $ T.pack "foo"]@@ -165,13 +165,13 @@ 	hmacWitnessAlg _ = hmac  -- Check that all the MACs continue to produce the same.-prop_mac_stable :: Bool-prop_mac_stable = all (\(mac, result) -> calcMac mac key msg == result)-	[ (HmacSha1, "46b4ec586117154dacd49d664e5d63fdc88efb51")-	, (HmacSha224, "4c1f774863acb63b7f6e9daa9b5c543fa0d5eccf61e3ffc3698eacdd")-	, (HmacSha256, "f9320baf0249169e73850cd6156ded0106e2bb6ad8cab01b7bbbebe6d1065317")-	, (HmacSha384, "3d10d391bee2364df2c55cf605759373e1b5a4ca9355d8f3fe42970471eca2e422a79271a0e857a69923839015877fc6")-	, (HmacSha512, "114682914c5d017dfe59fdc804118b56a3a652a0b8870759cf9e792ed7426b08197076bf7d01640b1b0684df79e4b67e37485669e8ce98dbab60445f0db94fce")+props_macs_stable :: [(String, Bool)]+props_macs_stable = map (\(desc, mac, result) -> (desc ++ " stable", calcMac mac key msg == result))+	[ ("HmacSha1", HmacSha1, "46b4ec586117154dacd49d664e5d63fdc88efb51")+	, ("HmacSha224", HmacSha224, "4c1f774863acb63b7f6e9daa9b5c543fa0d5eccf61e3ffc3698eacdd")+	, ("HmacSha256", HmacSha256, "f9320baf0249169e73850cd6156ded0106e2bb6ad8cab01b7bbbebe6d1065317")+	, ("HmacSha384", HmacSha384, "3d10d391bee2364df2c55cf605759373e1b5a4ca9355d8f3fe42970471eca2e422a79271a0e857a69923839015877fc6")+	, ("HmacSha512", HmacSha512, "114682914c5d017dfe59fdc804118b56a3a652a0b8870759cf9e792ed7426b08197076bf7d01640b1b0684df79e4b67e37485669e8ce98dbab60445f0db94fce") 	]   where 	key = T.encodeUtf8 $ T.pack "foo"

@@ -19,6 +19,7 @@ import Utility.PartialPrelude import Utility.QuickCheck +import Control.Monad.Fail as Fail (MonadFail(..)) import qualified Data.Map as M import Data.Time.Clock import Data.Time.Clock.POSIX (POSIXTime)@@ -44,7 +45,7 @@ daysToDuration i = Duration $ i * dsecs  {- Parses a human-input time duration, of the form "5h", "1m", "5h1m", etc -}-parseDuration :: Monad m => String -> m Duration+parseDuration :: MonadFail m => String -> m Duration parseDuration = maybe parsefail (return . Duration) . go 0   where 	go n [] = return n@@ -55,7 +56,7 @@ 				u <- M.lookup c unitmap 				go (n + num * u) rest 			_ -> return $ n + num-	parsefail = fail "duration parse error; expected eg \"5m\" or \"1h5m\""+	parsefail = Fail.fail "duration parse error; expected eg \"5m\" or \"1h5m\""  fromDuration :: Duration -> String fromDuration Duration { durationSeconds = d }

@@ -41,7 +41,7 @@  import Utility.Monad import Utility.UserInfo-import Utility.Directory+import Utility.SystemDirectory import Utility.Split import Utility.FileSystemEncoding @@ -74,6 +74,8 @@  {- Makes a path absolute.  -+ - Also simplifies it using simplifyPath.+ -  - The first parameter is a base directory (ie, the cwd) to use if the path  - is not already absolute, and should itsef be absolute.  -@@ -124,12 +126,19 @@  {- Converts a filename into an absolute path.  -+ - Also simplifies it using simplifyPath.+ -  - Unlike Directory.canonicalizePath, this does not require the path  - already exists. -} absPath :: FilePath -> IO FilePath-absPath file = do-	cwd <- getCurrentDirectory-	return $ absPathFrom cwd file+absPath file+	-- Avoid unncessarily getting the current directory when the path+	-- is already absolute. absPathFrom uses simplifyPath+	-- so also used here for consistency.+	| isAbsolute file = return $ simplifyPath file+	| otherwise = do+		cwd <- getCurrentDirectory+		return $ absPathFrom cwd file  {- Constructs a relative path from the CWD to a file.  -

@@ -8,7 +8,7 @@  # DESCRIPTION -Upgrades the repository.+Upgrades the repository to the latest version.  Each git-annex repository has an annex.version in its git configuration, that indicates the repository version. When an old repository version@@ -23,6 +23,13 @@ was only used by its author. It's expected that git-annex will always support upgrading from all past repository versions -- this is necessary to allow archives to be taken offline for years and later used.++# OPTIONS++* --autoonly++  Only do whatever automatic upgrade can be done, don't necessarily+  upgrade to the latest version. This is used internally by git-annex.  # SEE ALSO 

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

@@ -15,16 +15,13 @@ packages: - '.' extra-deps:-- IfElse-0.85-- aws-0.21.1-- bloomfilter-2.0.1.0-- tasty-1.1.0.4-- tasty-rerun-1.1.13-- torrent-10000.1.1-- sandi-0.5-- http-client-0.5.14-- silently-1.2.5.1-- filepath-bytestring-1.4.2.1.1+ - IfElse-0.85+ - aws-0.21.1+ - bloomfilter-2.0.1.0+ - filepath-bytestring-1.4.2.1.6+ - sandi-0.5+ - tasty-rerun-1.1.17+ - torrent-10000.1.1 explicit-setup-deps:   git-annex: true-resolver: lts-13.29+resolver: lts-14.27