git-annex 6.20171214 → 6.20180112

raw patch · 103 files changed

+1245/−716 lines, 103 files

Files

• Annex.hs +15/−1
• Annex/Action.hs +18/−0
• Annex/AdjustedBranch.hs +1/−1
• Annex/Branch.hs +5/−5
• Annex/Common.hs +5/−0
• Annex/Content/Direct.hs +2/−2
• Annex/Environment.hs +1/−1
• Annex/Fixup.hs +4/−8
• Annex/Journal.hs +1/−0
• Annex/MakeRepo.hs +1/−0
• Annex/Path.hs +1/−7
• Annex/ReplaceFile.hs +2/−1
• Annex/Ssh.hs +3/−2
• Annex/Transfer.hs +2/−2
• Annex/Url.hs +2/−2
• Annex/YoutubeDl.hs +23/−3
• Assistant.hs +2/−2
• Assistant/MakeRemote.hs +10/−9
• Assistant/Ssh.hs +2/−0
• Assistant/Threads/UpgradeWatcher.hs +2/−2
• Assistant/Threads/Upgrader.hs +3/−3
• Assistant/Upgrade.hs +4/−3
• Assistant/WebApp/Configurators/Edit.hs +1/−1
• Assistant/WebApp/Configurators/Pairing.hs +1/−0
• Assistant/WebApp/Configurators/Preferences.hs +2/−2
• Assistant/WebApp/Configurators/Ssh.hs +1/−0
• Assistant/WebApp/Documentation.hs +2/−2
• Assistant/WebApp/Gpg.hs +1/−1
• Assistant/WebApp/Types.hs +1/−1
• Backend/Hash.hs +6/−6
• Build/BundledPrograms.hs +11/−11
• Build/Configure.hs +7/−6
• Build/DesktopFile.hs +1/−3
• Build/TestConfig.hs +2/−3
• BuildFlags.hs +109/−0
• BuildInfo.hs +4/−103
• CHANGELOG +27/−1
• COPYRIGHT +2/−2
• CmdLine/Action.hs +9/−4
• CmdLine/GitAnnex.hs +2/−4
• CmdLine/GitAnnex/Options.hs +7/−4
• Command/AddUrl.hs +34/−17
• Command/Assistant.hs +2/−2
• Command/EnableRemote.hs +2/−2
• Command/Fsck.hs +6/−6
• Command/FuzzTest.hs +1/−1
• Command/ImportFeed.hs +2/−3
• Command/Inprogress.hs +60/−0
• Command/Map.hs +18/−15
• Command/Multicast.hs +2/−0
• Command/P2P.hs +2/−2
• Command/Proxy.hs +1/−1
• Command/Sync.hs +1/−0
• Command/Version.hs +3/−3
• Common.hs +1/−4
• Git/BuildVersion.hs +2/−2
• Git/Config.hs +2/−4
• Git/Construct.hs +2/−7
• Git/CurrentRepo.hs +1/−0
• Git/Index.hs +1/−0
• Git/LockFile.hs +1/−0
• Git/Remote.hs +9/−0
• Git/Repair.hs +4/−4
• Git/Types.hs +2/−2
• Logs/File.hs +27/−0
• Logs/FsckResults.hs +7/−10
• Logs/Schedule.hs +2/−2
• Logs/Transfer.hs +11/−6
• Logs/Unused.hs +2/−2
• Logs/View.hs +2/−2
• Remote/GCrypt.hs +1/−1
• Remote/Git.hs +69/−33
• Remote/Rsync.hs +1/−1
• RemoteDaemon/Core.hs +4/−2
• Test.hs +13/−26
• Types/GitConfig.hs +2/−0
• Types/Test.hs +0/−8
• Utility/CopyFile.hs +5/−5
• Utility/Directory.hs +1/−92
• Utility/Directory/Stream.hs +113/−0
• Utility/Env.hs +0/−24
• Utility/Env/Basic.hs +22/−0
• Utility/Env/Set.hs +41/−0
• Utility/Gpg.hs +7/−4
• Utility/LogFile.hs +1/−0
• Utility/Lsof.hs +4/−4
• Utility/Misc.hs +0/−21
• Utility/Path.hs +1/−52
• Utility/Path/Max.hs +40/−0
• Utility/Process.hs +0/−71
• Utility/Process/Transcript.hs +87/−0
• Utility/Rsync.hs +30/−0
• Utility/Su.hs +1/−0
• Utility/Tmp.hs +1/−50
• Utility/Tmp/Dir.hs +68/−0
• Utility/Url.hs +4/−4
• Utility/UserInfo.hs +1/−1
• doc/git-annex-export.mdwn +118/−0
• doc/git-annex-inprogress.mdwn +53/−0
• doc/git-annex.mdwn +18/−0
• git-annex.cabal +23/−10
• git-annex.hs +1/−1
• stack.yaml +0/−1

@@ -1,6 +1,6 @@ {- git-annex monad  -- - Copyright 2010-2013 Joey Hess <id@joeyh.name>+ - Copyright 2010-2018 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -34,12 +34,14 @@ 	getRemoteGitConfig, 	withCurrentState, 	changeDirectory,+	getGitRemotes, 	incError, ) where  import Common import qualified Git import qualified Git.Config+import qualified Git.Construct import Annex.Fixup import Git.CatFile import Git.HashObject@@ -98,6 +100,7 @@ 	{ repo :: Git.Repo 	, repoadjustment :: (Git.Repo -> IO Git.Repo) 	, gitconfig :: GitConfig+	, gitremotes :: Maybe [Git.Repo] 	, backend :: Maybe (BackendA Annex) 	, remotes :: [Types.Remote.RemoteA Annex] 	, remoteannexstate :: M.Map UUID AnnexState@@ -153,6 +156,7 @@ 		{ repo = r 		, repoadjustment = return 		, gitconfig = c+		, gitremotes = Nothing 		, backend = Nothing 		, remotes = [] 		, remoteannexstate = M.empty@@ -357,3 +361,13 @@ 	let ! c = errcounter s + 1  	    ! s' = s { errcounter = c } 	in s'++getGitRemotes :: Annex [Git.Repo]+getGitRemotes = do+	s <- getState id+	case gitremotes s of+		Just rs -> return rs+		Nothing -> do+			rs <- liftIO $ Git.Construct.fromRemotes (repo s)+			changeState $ \s' -> s' { gitremotes = Just rs }+			return rs

@@ -12,6 +12,8 @@ import qualified Data.Map as M #ifndef mingw32_HOST_OS import System.Posix.Signals+import System.Posix.Process (getAnyProcessStatus)+import Utility.Exception #endif  import Annex.Common@@ -46,3 +48,19 @@ 	checkAttrStop 	hashObjectStop 	checkIgnoreStop++{- Reaps any zombie processes that may be hanging around.+ -+ - Warning: Not thread safe. Anything that was expecting to wait+ - on a process and get back an exit status is going to be confused+ - if this reap gets there first. -}+reapZombies :: IO ()+#ifndef mingw32_HOST_OS+reapZombies =+	-- throws an exception when there are no child processes+	catchDefaultIO Nothing (getAnyProcessStatus False True)+		>>= maybe (return ()) (const reapZombies)++#else+reapZombies = return ()+#endif

@@ -50,7 +50,7 @@ import Annex.Content import Annex.Perms import Annex.GitOverlay-import Utility.Tmp+import Utility.Tmp.Dir import Utility.CopyFile import qualified Database.Keys import Config

@@ -57,14 +57,15 @@ import Annex.Perms import Logs import Logs.Transitions+import Logs.File import Logs.Trust.Pure import Logs.Difference.Pure-import Annex.ReplaceFile import qualified Annex.Queue import Annex.Branch.Transitions import qualified Annex import Annex.Hook import Utility.FileSystemEncoding+import Utility.Directory.Stream  {- Name of the branch that is used to store git-annex's information. -} name :: Git.Ref@@ -419,8 +420,7 @@ setIndexSha :: Git.Ref -> Annex () setIndexSha ref = do 	f <- fromRepo gitAnnexIndexStatus-	liftIO $ writeFile f $ fromRef ref ++ "\n"-	setAnnexFilePerm f+	writeLogFile f $ fromRef ref ++ "\n" 	runAnnexHook postUpdateAnnexHook  {- Stages the journal into the index and returns an action that will@@ -582,7 +582,7 @@ 	old <- getIgnoredRefs 	let s = S.unions [old, S.fromList rs] 	f <- fromRepo gitAnnexIgnoredRefs-	replaceFile f $ \tmp -> liftIO $ writeFile tmp $+	writeLogFile f $ 		unlines $ map fromRef $ S.elems s  getIgnoredRefs :: Annex (S.Set Git.Sha)@@ -599,7 +599,7 @@ 	-- Keep only the newest sha for each branch. 	let l = nubBy ((==) `on` snd) (new ++ old) 	f <- fromRepo gitAnnexMergedRefs-	replaceFile f $ \tmp -> liftIO $ writeFile tmp $+	writeLogFile f $ 		unlines $ map (\(s, b) -> fromRef s ++ '\t' : fromRef b) l  getMergedRefs :: Annex (S.Set Git.Sha)

@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ module Annex.Common (module X) where  import Common as X@@ -7,3 +9,6 @@ import Annex as X (gitRepo, inRepo, fromRepo, calcRepo) import Annex.Locations as X import Messages as X+#ifndef mingw32_HOST_OS+import System.Posix.IO as X hiding (createPipe)+#endif

@@ -32,8 +32,8 @@ import Annex.Common import Annex.Perms import qualified Git-import Utility.Tmp import Logs.Location+import Logs.File import Utility.InodeCache import Utility.CopyFile import Annex.ReplaceFile@@ -67,7 +67,7 @@ 	let files' = transform files 	when (files /= files') $ 		modifyContent mapping $-			liftIO $ viaTmp writeFile mapping $ unlines files'+			writeLogFile mapping $ unlines files' 	top <- fromRepo Git.repoPath 	return $ map (top </>) files' 

@@ -13,7 +13,7 @@ import Utility.UserInfo import qualified Git.Config import Config-import Utility.Env+import Utility.Env.Set  {- Checks that the system's environment allows git to function.  - Git requires a GECOS username, or suitable git configuration, or

@@ -10,7 +10,6 @@ import Git.Types import Git.Config import Types.GitConfig-import qualified Git.Construct as Construct import qualified Git.BuildVersion import Utility.Path import Utility.SafeCommand@@ -30,7 +29,7 @@ 	let r' = disableWildcardExpansion r 	r'' <- fixupSubmodule r' c 	if annexDirect c-		then fixupDirect r''+		then return (fixupDirect r'') 		else return r''  {- Disable git's built-in wildcard expansion, which is not wanted@@ -44,19 +43,16 @@ {- Direct mode repos have core.bare=true, but are not really bare.  - Fix up the Repo to be a non-bare repo, and arrange for git commands  - run by git-annex to be passed parameters that override this setting. -}-fixupDirect :: Repo -> IO Repo+fixupDirect :: Repo -> Repo fixupDirect r@(Repo { location = l@(Local { gitdir = d, worktree = Nothing }) }) = do-	let r' = r+	r 		{ location = l { worktree = Just (parentDir d) } 		, gitGlobalOpts = gitGlobalOpts r ++ 			[ Param "-c" 			, Param $ coreBare ++ "=" ++ boolConfig False 			] 		}-	-- Recalc now that the worktree is correct.-	rs' <- Construct.fromRemotes r'-	return $ r' { remotes = rs' }-fixupDirect r = return r+fixupDirect r = r  {- Submodules have their gitdir containing ".git/modules/", and  - have core.worktree set, and also have a .git file in the top

@@ -17,6 +17,7 @@ import qualified Git import Annex.Perms import Annex.LockFile+import Utility.Directory.Stream  {- Records content for a file in the branch to the journal.  -

@@ -20,6 +20,7 @@ import Types.StandardGroups import Logs.PreferredContent import qualified Annex.Branch+import Utility.Process.Transcript  {- Makes a new git repository. Or, if a git repository already  - exists, returns False. -}

@@ -5,8 +5,6 @@  - Licensed under the GNU GPL version 3 or higher.  -} -{-# LANGUAGE CPP #-}- module Annex.Path where  import Common@@ -17,7 +15,7 @@  {- A fully qualified path to the currently running git-annex program.  - - - getExecutablePath is available since ghc 7.4.2. On OSs it supports+ - getExecutablePath is used when possible. On OSs it supports  - well, it returns the complete path to the program. But, on other OSs,  - it might return just the basename. Fall back to reading the programFile,  - or searching for the command name in PATH.@@ -31,12 +29,8 @@   where 	go (Just p) = return p 	go Nothing = do-#if MIN_VERSION_base(4,6,0) 		exe <- getExecutablePath 		p <- if isAbsolute exe 			then return exe 			else readProgramFile-#else-		p <- readProgramFile-#endif 		maybe cannotFindProgram return =<< searchPath p

@@ -11,7 +11,8 @@  import Annex.Common import Annex.Perms-import Utility.Tmp+import Utility.Tmp.Dir+import Utility.Path.Max  {- Replaces a possibly already existing file with a new version,   - atomically, by running an action.

@@ -25,7 +25,7 @@  import Annex.Common import Annex.LockFile-import qualified Build.SysConfig as SysConfig+import qualified BuildInfo import qualified Annex import qualified Git import qualified Git.Url@@ -34,6 +34,7 @@ import Utility.Env import Utility.FileSystemEncoding import Utility.Hash+import Utility.Process.Transcript import Types.CleanupActions import Types.Concurrency import Git.Env@@ -138,7 +139,7 @@  - a different filesystem. -} sshCacheDir :: Annex (Maybe FilePath) sshCacheDir-	| SysConfig.sshconnectioncaching = +	| BuildInfo.sshconnectioncaching =  		ifM (fromMaybe True . annexSshCaching <$> Annex.getGitConfig) 			( ifM crippledFileSystem 				( maybe (return Nothing) usetmpdir =<< gettmpdir

@@ -96,7 +96,7 @@ 			Nothing -> return (Nothing, True) 			Just lockhandle -> ifM (checkSaneLock lck lockhandle) 				( do-					void $ liftIO $ tryIO $+					void $ tryIO $ 						writeTransferInfoFile info tfile 					return (Just lockhandle, False) 				, do@@ -111,7 +111,7 @@ 			Nothing -> return (Nothing, False) 			Just Nothing -> return (Nothing, True) 			Just (Just lockhandle) -> do-				void $ liftIO $ tryIO $+				void $ tryIO $ 					writeTransferInfoFile info tfile 				return (Just lockhandle, False) #endif

@@ -16,10 +16,10 @@ import Annex.Common import qualified Annex import Utility.Url as U-import qualified Build.SysConfig as SysConfig+import qualified BuildInfo  defaultUserAgent :: U.UserAgent-defaultUserAgent = "git-annex/" ++ SysConfig.packageversion+defaultUserAgent = "git-annex/" ++ BuildInfo.packageversion  getUserAgent :: Annex (Maybe U.UserAgent) getUserAgent = Annex.getState $ 

@@ -11,6 +11,7 @@ 	youtubeDlSupported, 	youtubeDlCheck, 	youtubeDlFileName,+	youtubeDlFileName', ) where  import Annex.Common@@ -20,9 +21,11 @@ import Utility.Url (URLString) import Utility.DiskFree import Utility.HtmlDetect+import Utility.Process.Transcript import Logs.Transfer  import Network.URI+import Control.Concurrent.Async  -- Runs youtube-dl in a work directory, to download a single media file -- from the url. Reutrns the path to the media file in the work directory.@@ -144,9 +147,18 @@ youtubeDlFileName :: URLString -> Annex (Either String FilePath) youtubeDlFileName url 	| supportedScheme url = flip catchIO (pure . Left . show) $-		htmlOnly url nomedia go+		htmlOnly url nomedia (youtubeDlFileName' url) 	| otherwise = return nomedia   where+	nomedia = Left "no media in url"++-- Does not check if the url contains htmlOnly; use when that's already+-- been verified.+youtubeDlFileName' :: URLString -> Annex (Either String FilePath)+youtubeDlFileName' url+	| supportedScheme url = flip catchIO (pure . Left . show) go+	| otherwise = return nomedia+  where 	go = do 		-- Sometimes youtube-dl will fail with an ugly backtrace 		-- (eg, http://bugs.debian.org/874321)@@ -158,8 +170,16 @@ 			, Param "--get-filename" 			, Param "--no-warnings" 			]-		(output, ok) <- liftIO $ processTranscript "youtube-dl"-			(toCommand opts) Nothing+		(Nothing, Just o, Just e, pid) <- liftIO $ createProcess+			(proc "youtube-dl" (toCommand opts))+				{ std_out = CreatePipe+				, std_err = CreatePipe+				}+		output <- liftIO $ fmap fst $ +			hGetContentsStrict o+				`concurrently`+			hGetContentsStrict e+		ok <- liftIO $ checkSuccessProcess pid 		return $ case (ok, lines output) of 			(True, (f:_)) | not (null f) -> Right f 			_ -> nomedia

@@ -48,7 +48,7 @@ import qualified Utility.Daemon import Utility.ThreadScheduler import Utility.HumanTime-import qualified Build.SysConfig as SysConfig+import qualified BuildInfo import Annex.Perms import Utility.LogFile #ifdef mingw32_HOST_OS@@ -135,7 +135,7 @@ #else 	go _webappwaiter = do #endif-		notice ["starting", desc, "version", SysConfig.packageversion]+		notice ["starting", desc, "version", BuildInfo.packageversion] 		urlrenderer <- liftIO newUrlRenderer #ifdef WITH_WEBAPP 		let webappthread = [ assist $ webAppThread d urlrenderer False cannotrun Nothing listenhost webappwaiter ]

@@ -16,6 +16,7 @@ import qualified Remote.GCrypt as GCrypt import qualified Git import qualified Git.Command+import qualified Annex import qualified Annex.SpecialRemote import Logs.UUID import Logs.Remote@@ -122,26 +123,26 @@  - Returns the name of the remote. -} makeRemote :: String -> String -> (RemoteName -> Annex ()) -> Annex RemoteName makeRemote basename location a = do-	g <- gitRepo-	if not (any samelocation $ Git.remotes g)+	rs <- Annex.getGitRemotes+	if not (any samelocation rs) 		then do-			let name = uniqueRemoteName basename 0 g+			let name = uniqueRemoteName basename 0 rs 			a name 			return name 		else return basename   where 	samelocation x = Git.repoLocation x == location -{- Generate an unused name for a remote, adding a number if- - necessary.+{- Given a list of all remotes, generate an unused name for a new+ - remote, adding a number if necessary.  -  - Ensures that the returned name is a legal git remote name. -}-uniqueRemoteName :: String -> Int -> Git.Repo -> RemoteName-uniqueRemoteName basename n r+uniqueRemoteName :: String -> Int -> [Git.Repo] -> RemoteName+uniqueRemoteName basename n rs 	| null namecollision = name-	| otherwise = uniqueRemoteName legalbasename (succ n) r+	| otherwise = uniqueRemoteName legalbasename (succ n) rs   where-	namecollision = filter samename (Git.remotes r)+	namecollision = filter samename rs 	samename x = Git.remoteName x == Just name 	name 		| n == 0 = legalbasename

@@ -9,12 +9,14 @@  import Annex.Common import Utility.Tmp+import Utility.Tmp.Dir import Utility.Shell import Utility.Rsync import Utility.FileMode import Utility.SshConfig import Git.Remote import Utility.SshHost+import Utility.Process.Transcript  import Data.Text (Text) import qualified Data.Text as T

@@ -21,7 +21,7 @@ import Assistant.DaemonStatus #ifdef WITH_WEBAPP import Assistant.WebApp.Types-import qualified Build.SysConfig+import qualified BuildInfo #endif  import Control.Concurrent.MVar@@ -103,7 +103,7 @@ 			(T.pack "Enable Automatic Upgrades") 			urlrenderer ConfigEnableAutomaticUpgradeR 		)-	void $ addAlert $ upgradeFinishedAlert button Build.SysConfig.packageversion+	void $ addAlert $ upgradeFinishedAlert button BuildInfo.packageversion #else 	noop #endif

@@ -19,7 +19,7 @@ import Assistant.Alert import Utility.NotificationBroadcaster import qualified Annex-import qualified Build.SysConfig+import qualified BuildInfo import qualified Utility.DottedVersion as DottedVersion import Types.Distribution #ifdef WITH_WEBAPP@@ -31,7 +31,7 @@  upgraderThread :: UrlRenderer -> NamedThread upgraderThread urlrenderer = namedThread "Upgrader" $-	when (isJust Build.SysConfig.upgradelocation) $ do+	when (isJust BuildInfo.upgradelocation) $ do 		{- Check for upgrade on startup, unless it was just 		 - upgraded. -} 		unlessM (liftIO checkSuccessfulUpgrade) $@@ -63,7 +63,7 @@   where 	go Nothing = debug [ "Failed to check if upgrade is available." ] 	go (Just d) = do-		let installed = DottedVersion.normalize Build.SysConfig.packageversion+		let installed = DottedVersion.normalize BuildInfo.packageversion 		let avail = DottedVersion.normalize $ distributionVersion d 		let old = DottedVersion.normalize <$> distributionUrgentUpgrade d 		if Just installed <= old

@@ -15,6 +15,7 @@ import Assistant.Alert import Assistant.DaemonStatus import Utility.Env+import Utility.Env.Set import Types.Distribution import Types.Transfer import Logs.Web@@ -31,12 +32,12 @@ import Annex.Path import Config.Files import Utility.ThreadScheduler-import Utility.Tmp+import Utility.Tmp.Dir import Utility.UserInfo import Utility.Gpg import Utility.FileMode import qualified Utility.Lsof as Lsof-import qualified Build.SysConfig+import qualified BuildInfo import qualified Utility.Url as Url import qualified Annex.Url as Url import Utility.Tuple@@ -329,7 +330,7 @@ 			)  distributionInfoUrl :: String-distributionInfoUrl = fromJust Build.SysConfig.upgradelocation ++ ".info"+distributionInfoUrl = fromJust BuildInfo.upgradelocation ++ ".info"  distributionInfoSigUrl :: String distributionInfoSigUrl = distributionInfoUrl ++ ".sig"

@@ -94,7 +94,7 @@ 		void uuidMapLoad 	when nameChanged $ do 		liftAnnex $ do-			name <- fromRepo $ uniqueRemoteName (legalName newc) 0+			name <- uniqueRemoteName (legalName newc) 0 <$> Annex.getGitRemotes 			{- git remote rename expects there to be a 			 - remote.<name>.fetch, and exits nonzero if 			 - there's not. Special remotes don't normally

@@ -34,6 +34,7 @@ import P2P.Address import Git import Config.Files+import Utility.Process.Transcript  import qualified Data.Map as M import qualified Data.Text as T

@@ -21,7 +21,7 @@ import Utility.DataUnits import Git.Config import Types.Distribution-import qualified Build.SysConfig+import qualified BuildInfo  import qualified Data.Text as T @@ -58,7 +58,7 @@ 		, ("disabled", NoAutoUpgrade) 		] 	autoUpgradeLabel-		| isJust Build.SysConfig.upgradelocation = "Auto upgrade"+		| isJust BuildInfo.upgradelocation = "Auto upgrade" 		| otherwise = "Auto restart on upgrade"  	positiveIntField = check isPositive intField

@@ -40,6 +40,7 @@ import Utility.ThreadScheduler import Utility.Env import Utility.SshHost+import Utility.Process.Transcript  import qualified Data.Text as T import qualified Data.Map as M

@@ -11,8 +11,8 @@  import Assistant.WebApp.Common import Assistant.Install (standaloneAppBase)-import Build.SysConfig (packageversion)-import BuildInfo+import BuildInfo (packageversion)+import BuildFlags  {- The full license info may be included in a file on disk that can  - be read in and displayed. -}

@@ -69,7 +69,7 @@  -} getGCryptRemoteName :: UUID -> String -> Annex RemoteName getGCryptRemoteName u repoloc = do-	tmpremote <- uniqueRemoteName "tmpgcryptremote" 0 <$> gitRepo+	tmpremote <- uniqueRemoteName "tmpgcryptremote" 0 <$> Annex.getGitRemotes 	void $ inRepo $ Git.Command.runBool 		[ Param "remote" 		, Param "add"

@@ -24,7 +24,7 @@ import Utility.Yesod import Types.Transfer import Utility.Gpg (KeyId)-import Build.SysConfig (packageversion)+import BuildInfo (packageversion) import Types.ScheduledActivity import Assistant.WebApp.RepoId import Assistant.WebApp.Pairing

@@ -18,7 +18,7 @@ import Utility.Hash import Utility.ExternalSHA -import qualified Build.SysConfig as SysConfig+import qualified BuildInfo import qualified Data.ByteString.Lazy as L import Data.Char @@ -187,11 +187,11 @@  shaHasher :: HashSize -> Integer -> Either (L.ByteString -> String) (String, L.ByteString -> String) shaHasher (HashSize hashsize) filesize-	| hashsize == 1 = use SysConfig.sha1 sha1-	| hashsize == 256 = use SysConfig.sha256 sha2_256-	| hashsize == 224 = use SysConfig.sha224 sha2_224-	| hashsize == 384 = use SysConfig.sha384 sha2_384-	| hashsize == 512 = use SysConfig.sha512 sha2_512+	| hashsize == 1 = use BuildInfo.sha1 sha1+	| hashsize == 256 = use BuildInfo.sha256 sha2_256+	| hashsize == 224 = use BuildInfo.sha224 sha2_224+	| hashsize == 384 = use BuildInfo.sha384 sha2_384+	| hashsize == 512 = use BuildInfo.sha512 sha2_512 	| otherwise = error $ "unsupported SHA size " ++ show hashsize   where 	use Nothing hasher = Left $ usehasher hasher

@@ -11,7 +11,7 @@  import Data.Maybe -import Build.SysConfig as SysConfig+import BuildInfo  {- Programs that git-annex uses, to include in the bundle.  -@@ -28,7 +28,7 @@ 	-- integrate with the system gpg-agent, etc. 	-- On Windows, gpg is bundled with git for windows. #ifndef mingw32_HOST_OS-	[ SysConfig.gpg+	[ BuildInfo.gpg #else 	[ #endif@@ -75,19 +75,19 @@ 	-- wget on OSX has been problematic, looking for certs in the wrong 	-- places. Don't ship it, use curl or the OSX's own wget if it has 	-- one.-	, ifset SysConfig.wget "wget"+	, ifset BuildInfo.wget "wget" #endif #endif-	, SysConfig.lsof-	, SysConfig.gcrypt+	, BuildInfo.lsof+	, BuildInfo.gcrypt #ifndef mingw32_HOST_OS 	-- All these utilities are included in git for Windows-	, ifset SysConfig.curl "curl"-	, SysConfig.sha1-	, SysConfig.sha256-	, SysConfig.sha512-	, SysConfig.sha224-	, SysConfig.sha384+	, ifset BuildInfo.curl "curl"+	, BuildInfo.sha1+	, BuildInfo.sha256+	, BuildInfo.sha512+	, BuildInfo.sha224+	, BuildInfo.sha384 	, Just "cp" #endif #ifdef linux_HOST_OS

@@ -1,24 +1,25 @@-{- Checks system configuration and generates SysConfig.hs. -}+{- Checks system configuration and generates SysConfig. -}  {-# OPTIONS_GHC -fno-warn-tabs #-}  module Build.Configure where -import Control.Applicative-import Control.Monad.IfElse-import Control.Monad- import Build.TestConfig import Build.Version import Utility.PartialPrelude import Utility.Process import Utility.SafeCommand import Utility.ExternalSHA-import Utility.Env+import Utility.Env.Basic import Utility.Exception import qualified Git.Version import Utility.DottedVersion import Utility.Directory++import Control.Monad.IfElse+import Control.Monad+import Control.Applicative+import Prelude  tests :: [TestCase] tests =

@@ -22,9 +22,7 @@ import Assistant.Install.Menu  import System.Environment-#ifndef mingw32_HOST_OS-import System.Posix.User-#endif+import System.PosixCompat.User import Data.Maybe import Control.Applicative import Prelude

@@ -1,4 +1,4 @@-{- Tests the system and generates Build.SysConfig.hs. -}+{- Tests the system and generates SysConfig. -}  {-# OPTIONS_GHC -fno-warn-tabs #-} @@ -42,12 +42,11 @@ 		valuetype (MaybeBoolConfig _) = "Maybe Bool"  writeSysConfig :: [Config] -> IO ()-writeSysConfig config = writeFile "Build/SysConfig.hs" body+writeSysConfig config = writeFile "Build/SysConfig" body   where 	body = unlines $ header ++ map show config ++ footer 	header = [ 		  "{- Automatically generated. -}"-		, "module Build.SysConfig where" 		, "" 		] 	footer = []

@@ -0,0 +1,109 @@+{- git-annex build flags+ -+ - Copyright 2013-2017 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++{-# LANGUAGE CPP #-}++module BuildFlags where++import Data.List+import Data.Ord+import qualified Data.CaseInsensitive as CI++buildFlags :: [String]+buildFlags = filter (not . null)+	[ ""+#ifdef WITH_ASSISTANT+	, "Assistant"+#else+#warning Building without the assistant.+#endif+#ifdef WITH_WEBAPP+	, "Webapp"+#else+#warning Building without the webapp. You probably need to install Yesod..+#endif+#ifdef WITH_PAIRING+	, "Pairing"+#else+#warning Building without local pairing.+#endif+#ifdef WITH_S3+	, "S3"+#if MIN_VERSION_aws(0,10,6)+		++ "(multipartupload)"+#endif+#if MIN_VERSION_aws(0,13,0)+		++ "(storageclasses)"+#endif+#else+#warning Building without S3.+#endif+#ifdef WITH_WEBDAV+	, "WebDAV"+#else+#warning Building without WebDAV.+#endif+#ifdef WITH_INOTIFY+	, "Inotify"+#endif+#ifdef WITH_FSEVENTS+	, "FsEvents"+#endif+#ifdef WITH_KQUEUE+	, "Kqueue"+#endif+#ifdef WITH_DBUS+	, "DBus"+#endif+#ifdef WITH_DESKTOP_NOTIFY+	, "DesktopNotify"+#endif+#ifdef WITH_CONCURRENTOUTPUT+	, "ConcurrentOutput"+#else+#warning Building without ConcurrentOutput+#endif+#ifdef WITH_TORRENTPARSER+	, "TorrentParser"+#endif+#ifdef WITH_MAGICMIME+	, "MagicMime"+#endif+	-- Always enabled now, but users may be used to seeing these flags+	-- listed.+	, "Feeds"+	, "Testsuite"+	]++-- Not a complete list, let alone a listing transitive deps, but only+-- the ones that are often interesting to know.+dependencyVersions :: [String]+dependencyVersions = map fmt $ sortBy (comparing (CI.mk . fst))+	[ ("feed", VERSION_feed)+	, ("uuid", VERSION_uuid)+	, ("bloomfilter", VERSION_bloomfilter)+	, ("http-client", VERSION_http_client)+	, ("persistent-sqlite", VERSION_persistent_sqlite)+	, ("cryptonite", VERSION_cryptonite)+#ifdef WITH_S3+	, ("aws", VERSION_aws)+#endif+#ifdef WITH_WEBDAV+	, ("DAV", VERSION_DAV)+#endif+#ifdef WITH_TORRENTPARSER+	, ("torrent", VERSION_torrent)+#endif+#ifdef WITH_WEBAPP+	, ("yesod", VERSION_yesod)+#endif +#ifdef TOOL_VERSION_ghc+	, ("ghc", TOOL_VERSION_ghc)+#endif+	]+  where+	fmt (p, v) = p ++ "-" ++ v

@@ -1,4 +1,4 @@-{- git-annex build info reporting+{- git-annex build info  -  - Copyright 2013-2017 Joey Hess <id@joeyh.name>  -@@ -9,105 +9,6 @@  module BuildInfo where -import Data.List-import Data.Ord-import qualified Data.CaseInsensitive as CI--buildFlags :: [String]-buildFlags = filter (not . null)-	[ ""-#ifdef WITH_ASSISTANT-	, "Assistant"-#else-#warning Building without the assistant.-#endif-#ifdef WITH_WEBAPP-	, "Webapp"-#else-#warning Building without the webapp. You probably need to install Yesod..-#endif-#ifdef WITH_PAIRING-	, "Pairing"-#else-#warning Building without local pairing.-#endif-#ifdef WITH_TESTSUITE-	, "Testsuite"-#else-#warning Building without the testsuite.-#endif-#ifdef WITH_S3-	, "S3"-#if MIN_VERSION_aws(0,10,6)-		++ "(multipartupload)"-#endif-#if MIN_VERSION_aws(0,13,0)-		++ "(storageclasses)"-#endif-#else-#warning Building without S3.-#endif-#ifdef WITH_WEBDAV-	, "WebDAV"-#else-#warning Building without WebDAV.-#endif-#ifdef WITH_INOTIFY-	, "Inotify"-#endif-#ifdef WITH_FSEVENTS-	, "FsEvents"-#endif-#ifdef WITH_KQUEUE-	, "Kqueue"-#endif-#ifdef WITH_DBUS-	, "DBus"-#endif-#ifdef WITH_DESKTOP_NOTIFY-	, "DesktopNotify"-#endif-#ifdef WITH_CONCURRENTOUTPUT-	, "ConcurrentOutput"-#else-#warning Building without ConcurrentOutput-#endif-#ifdef WITH_TORRENTPARSER-	, "TorrentParser"-#endif-#ifdef WITH_MAGICMIME-	, "MagicMime"-#endif-	-- Always enabled now, but users may be used to seeing these flags-	-- listed.-	, "Feeds"-	]---- Not a complete list, let alone a listing transitive deps, but only--- the ones that are often interesting to know.-dependencyVersions :: [String]-dependencyVersions = map fmt $ sortBy (comparing (CI.mk . fst))-	[ ("feed", VERSION_feed)-	, ("uuid", VERSION_uuid)-	, ("bloomfilter", VERSION_bloomfilter)-	, ("http-client", VERSION_http_client)-	, ("persistent-sqlite", VERSION_persistent_sqlite)-	, ("cryptonite", VERSION_cryptonite)-#ifdef WITH_S3-	, ("aws", VERSION_aws)-#endif-#ifdef WITH_WEBDAV-	, ("DAV", VERSION_DAV)-#endif-#ifdef WITH_TORRENTPARSER-	, ("torrent", VERSION_torrent)-#endif-#ifdef WITH_WEBAPP-	, ("yesod", VERSION_yesod)-#endif -#ifdef TOOL_VERSION_ghc-	, ("ghc", TOOL_VERSION_ghc)-#endif-	]-  where-	fmt (p, v) = p ++ "-" ++ v+-- This file is generated by the configure program with the results of its+-- probing.+#include "Build/SysConfig"

@@ -1,4 +1,30 @@-git-annex (6.20171214) unstable; urgency=medium+git-annex (6.20180112) upstream; urgency=medium++  * Added inprogress command for accessing files as they are being+    downloaded.+  * Fix bug introduced in version 6.20171018 that caused some commands+    to print out "ok" twice after processing a file.+  * addurl: When the file youtube-dl will download is already an annexed+    file, don't download it again and fail to overwrite it, instead just do+    nothing, like it used to when quvi was used.+  * addurl: Fix encoding of filename queried from youtube-dl when in+    --fast mode.+  * Fix several places where files in .git/annex/ were written with modes+    that did not take the core.sharedRepository config into account.+  * Improve startup time for commands that do not operate on remotes,+    and for tab completion, by not unnessessarily statting paths to+    remotes, which used to cause eg, spin-up of removable drives.+  * Added remote.<name>.annex-checkuuid config, which can be set to false+    to disable the default checking of the uuid of remotes that point to+    directories. This can be useful to avoid unncessary drive spin-ups and+    automounting.+  * git-annex.cabal: Add back custom-setup stanza, so cabal new-build works.+  * git-annex.cabal: Removed the testsuite build flag; test suite is always+    included.++ -- Joey Hess <id@joeyh.name>  Fri, 12 Jan 2018 15:45:48 -0400++git-annex (6.20171214) upstream; urgency=medium    * Use youtube-dl rather than quvi to download media from web pages,     since quvi is not being actively developed and youtube-dl supports

@@ -2,7 +2,7 @@ Source: native package  Files: *-Copyright: © 2010-2017 Joey Hess <id@joeyh.name>+Copyright: © 2010-2018 Joey Hess <id@joeyh.name> License: GPL-3+  Files: Assistant/WebApp.hs Assistant/WebApp/* templates/* static/*@@ -21,7 +21,7 @@ License: BSD-2-clause  Files: Utility/*-Copyright: 2012-2017 Joey Hess <id@joeyh.name>+Copyright: 2012-2018 Joey Hess <id@joeyh.name> License: BSD-2-clause  Files: doc/logo* */favicon.ico standalone/osx/git-annex.app/Contents/Resources/git-annex.icns standalone/android/icons/*

@@ -149,15 +149,20 @@ {- Like callCommandAction, but returns Nothing when the command did not  - perform any action. -} callCommandAction' :: CommandStart -> Annex (Maybe Bool)-callCommandAction' = start+callCommandAction' a = callCommandActionQuiet a >>= \case+	Nothing -> return Nothing+	Just r -> implicitMessage (showEndResult r) >> return (Just r)++callCommandActionQuiet :: CommandStart -> Annex (Maybe Bool)+callCommandActionQuiet = start   where 	start   = stage $ maybe skip perform 	perform = stage $ maybe failure cleanup 	cleanup = stage $ status 	stage = (=<<) 	skip = return Nothing-	failure = implicitMessage showEndFail >> return (Just False)-	status r = implicitMessage (showEndResult r) >> return (Just r)+	failure = return (Just False)+	status = return . Just  {- Do concurrent output when that has been requested. -} allowConcurrentOutput :: Annex a -> Annex a@@ -188,7 +193,7 @@   where 	-- Run whole action, not just start stage, so other threads 	-- block until it's done.-	run = callCommandAction' a >>= \case+	run = callCommandActionQuiet a >>= \case 		Nothing -> return Nothing 		Just r' -> return $ Just $ return $ Just $ return r' 

@@ -73,6 +73,7 @@ import qualified Command.ResolveMerge import qualified Command.Info import qualified Command.Status+import qualified Command.Inprogress import qualified Command.Migrate import qualified Command.Uninit import qualified Command.Reinit@@ -116,10 +117,8 @@ #endif #endif import qualified Command.Test-#ifdef WITH_TESTSUITE import qualified Command.FuzzTest import qualified Command.TestRemote-#endif #ifdef WITH_BENCHMARK import qualified Command.Benchmark #endif@@ -205,6 +204,7 @@ 	, Command.ResolveMerge.cmd 	, Command.Info.cmd 	, Command.Status.cmd+	, Command.Inprogress.cmd 	, Command.Migrate.cmd 	, Command.Map.cmd 	, Command.Direct.cmd@@ -226,10 +226,8 @@ #endif #endif 	, Command.Test.cmd testoptparser testrunner-#ifdef WITH_TESTSUITE 	, Command.FuzzTest.cmd 	, Command.TestRemote.cmd-#endif #ifdef WITH_BENCHMARK 	, Command.Benchmark.cmd #endif

@@ -1,6 +1,6 @@ {- git-annex command-line option parsing  -- - Copyright 2010-2017 Joey Hess <id@joeyh.name>+ - Copyright 2010-2018 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -10,10 +10,12 @@ import Options.Applicative import Options.Applicative.Builder.Internal import Control.Concurrent+import qualified Data.Map as M  import Annex.Common import qualified Git.Config import qualified Git.Construct+import Git.Remote import Git.Types import Types.Key import Types.TrustLevel@@ -348,9 +350,10 @@ completeRemotes = completer $ mkCompleter $ \input -> do 	r <- maybe (pure Nothing) (Just <$$> Git.Config.read) 		=<< Git.Construct.fromCwd-	return $ filter (input `isPrefixOf`) -		(maybe [] (mapMaybe remoteName . remotes) r)-		+	return $ filter (input `isPrefixOf`) $+		map remoteKeyToRemoteName $+			filter isRemoteKey $+				maybe [] (M.keys . config) r 		 completeBackends :: HasCompleter f => Mod f a completeBackends = completeWith $

@@ -30,6 +30,7 @@ import Utility.Metered import Utility.FileSystemEncoding import Utility.HtmlDetect+import Utility.Path.Max import qualified Annex.Transfer as Transfer  cmd :: Command@@ -272,26 +273,42 @@ 		showDestinationFile file 		liftIO $ createDirectoryIfMissing True (parentDir file) 		finishDownloadWith tmp webUUID url file-	tryyoutubedl tmp = withTmpWorkDir mediakey $ \workdir ->-		Transfer.notifyTransfer Transfer.Download url $-			Transfer.download webUUID mediakey (AssociatedFile Nothing) Transfer.noRetry $ \_p ->-				youtubeDl url workdir >>= \case-					Right (Just mediafile) -> do-						pruneTmpWorkDirBefore tmp (liftIO . nukeFile)-						let dest = if isJust (fileOption o)-							then file-							else takeFileName mediafile-						checkCanAdd dest $ do-							showDestinationFile dest-							addWorkTree webUUID mediaurl dest mediakey (Just mediafile)-							return $ Just mediakey-					Right Nothing -> normalfinish tmp-					Left msg -> do-						warning msg-						return Nothing+	tryyoutubedl tmp+		| isJust (fileOption o) = dl file+		-- Ask youtube-dl what filename it will download+		-- first, and check if that is already an annexed file,+		-- to avoid unnecessary work in that case.+		| otherwise = youtubeDlFileName' url >>= \case+			Right dest -> ifAnnexed dest +				(alreadyannexed dest)+				(dl dest)+			Left _ -> normalfinish tmp 	  where+		dl dest = withTmpWorkDir mediakey $ \workdir ->+			Transfer.notifyTransfer Transfer.Download url $+				Transfer.download webUUID mediakey (AssociatedFile Nothing) Transfer.noRetry $ \_p ->+					youtubeDl url workdir >>= \case+						Right (Just mediafile) -> do+							pruneTmpWorkDirBefore tmp (liftIO . nukeFile)+							checkCanAdd dest $ do+								showDestinationFile dest+								addWorkTree webUUID mediaurl dest mediakey (Just mediafile)+								return $ Just mediakey+						Right Nothing -> normalfinish tmp+						Left msg -> do+							warning msg+							return Nothing 		mediaurl = setDownloader url YoutubeDownloader 		mediakey = Backend.URL.fromUrl mediaurl Nothing+		-- Does the already annexed file have the mediaurl+		-- as an url? If so nothing to do.+		alreadyannexed dest k = do+			us <- getUrls k+			if mediaurl `elem` us+				then return (Just k)+				else do+					warning $ dest ++ " already exists; not overwriting"+					return Nothing  showDestinationFile :: FilePath -> Annex () showDestinationFile file = do

@@ -12,7 +12,7 @@ import Annex.Init import Annex.Path import Config.Files-import qualified Build.SysConfig+import qualified BuildInfo import Utility.HumanTime import Assistant.Install @@ -78,7 +78,7 @@ 		f <- autoStartFile 		giveup $ "Nothing listed in " ++ f 	program <- programPath-	haveionice <- pure Build.SysConfig.ionice <&&> inPath "ionice"+	haveionice <- pure BuildInfo.ionice <&&> inPath "ionice" 	pids <- forM dirs $ \d -> do 		putStrLn $ "git-annex autostart in " ++ d 		mpid <- catchMaybeIO $ go haveionice program d

@@ -36,7 +36,7 @@  start :: [String] -> CommandStart start [] = unknownNameError "Specify the remote to enable."-start (name:rest) = go =<< filter matchingname <$> Annex.fromRepo Git.remotes+start (name:rest) = go =<< filter matchingname <$> Annex.getGitRemotes   where 	matchingname r = Git.remoteName r == Just name 	go [] = startSpecialRemote name (Logs.Remote.keyValToConfig rest)@@ -104,7 +104,7 @@ 			else Remote.prettyPrintUUIDsDescs 				"known special remotes" 				descm (M.keys m)-	disabledremotes <- filterM isdisabled =<< Annex.fromRepo Git.remotes+	disabledremotes <- filterM isdisabled =<< Annex.getGitRemotes 	let remotesmsg = unlines $ map ("\t" ++) $ 		mapMaybe Git.remoteName disabledremotes 	giveup $ concat $ filter (not . null) [prefix ++ "\n", remotesmsg, specialmsg]

@@ -563,15 +563,15 @@ recordStartTime u = do 	f <- fromRepo (gitAnnexFsckState u) 	createAnnexDirectory $ parentDir f-	liftIO $ do-		nukeFile f-		withFile f WriteMode $ \h -> do+	liftIO $ nukeFile f+	liftIO $ withFile f WriteMode $ \h -> do #ifndef mingw32_HOST_OS-			t <- modificationTime <$> getFileStatus f+		t <- modificationTime <$> getFileStatus f #else-			t <- getPOSIXTime+		t <- getPOSIXTime #endif-			hPutStr h $ showTime $ realToFrac t+		hPutStr h $ showTime $ realToFrac t+	setAnnexFilePerm f   where 	showTime :: POSIXTime -> String 	showTime = show

@@ -33,7 +33,7 @@ 	guardTest 	logf <- fromRepo gitAnnexFuzzTestLogFile 	showStart "fuzztest" logf-	logh <-liftIO $ openFile logf WriteMode+	logh <- liftIO $ openFile logf WriteMode 	void $ forever $ fuzz logh 	stop 

@@ -30,10 +30,10 @@ import qualified Types.Remote as Remote import Types.UrlContents import Logs.Web+import Logs.File import qualified Utility.Format import Utility.Tmp import Command.AddUrl (addUrlFile, downloadRemoteFile, parseDownloadOptions, DownloadOptions(..))-import Annex.Perms import Annex.UUID import Backend.URL (fromUrl) import Annex.Content@@ -386,8 +386,7 @@ 	now <- liftIO getCurrentTime 	case prev of 		Nothing -> do-			createAnnexDirectory (parentDir f)-			liftIO $ writeFile f $ show now+			writeLogFile f $ show now 			return False 		Just prevtime -> do 			let broken = diffUTCTime now prevtime > 60 * 60 * 23

@@ -0,0 +1,60 @@+{- git-annex command+ -+ - Copyright 2017 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Command.Inprogress where++import Command+import Annex.Transfer++import qualified Data.Set as S++cmd :: Command+cmd = noCommit $ noMessages $ command "inprogress" SectionQuery+		"access files while they're being downloaded"+		paramPaths (seek <$$> optParser)++data InprogressOptions = InprogressOptions+	{ inprogressFiles :: CmdParams+	, allOption :: Bool+	}++optParser :: CmdParamsDesc -> Parser InprogressOptions+optParser desc = InprogressOptions+	<$> cmdParams desc+	<*> switch+		( long "all"+		<> short 'A'+		<> help "access all files currently being downloaded"+		)++seek :: InprogressOptions -> CommandSeek+seek o = do+	ts <- map (transferKey . fst) <$> getTransfers+	if allOption o+		then forM_ ts $ commandAction . start'+		else do+			let s = S.fromList ts+			withFilesInGit (whenAnnexed (start s))+				=<< workTreeItems (inprogressFiles o)++start :: S.Set Key -> FilePath -> Key -> CommandStart+start s _file k+	| S.member k s = start' k+	| otherwise = notInprogress++start' :: Key -> CommandStart+start' k = do+	tmpf <- fromRepo $ gitAnnexTmpObjectLocation k+	ifM (liftIO $ doesFileExist tmpf)+		( next $ next $ do+			liftIO $ putStrLn tmpf+			return True+		, notInprogress+		)++notInprogress :: CommandStart+notInprogress = next stop

@@ -27,6 +27,9 @@ -- a link from the first repository to the second (its remote) data Link = Link Git.Repo Git.Repo +-- a repo and its remotes+type RepoRemotes = (Git.Repo, [Git.Repo])+ cmd :: Command cmd = dontCheck repoExists $ 	command "map" SectionQuery@@ -76,11 +79,11 @@  - the repositories first, followed by uuids that were not matched  - to a repository.  -}-drawMap :: [Git.Repo] -> TrustMap -> M.Map UUID String -> String+drawMap :: [RepoRemotes] -> TrustMap -> M.Map UUID String -> String drawMap rs trustmap umap = Dot.graph $ repos ++ others   where-	repos = map (node umap rs trustmap) rs-	ruuids = map getUncachedUUID rs+	repos = map (node umap (map fst rs) trustmap) rs+	ruuids = map (getUncachedUUID . fst) rs 	others = map uuidnode $  		filter (\u -> M.lookup u trustmap /= Just DeadTrusted) $ 		filter (`notElem` ruuids) (M.keys umap)@@ -113,13 +116,13 @@ 		UUID u -> u  {- A node representing a repo. -}-node :: M.Map UUID String -> [Git.Repo] -> TrustMap -> Git.Repo -> String-node umap fullinfo trustmap r = unlines $ n:edges+node :: M.Map UUID String -> [Git.Repo] -> TrustMap -> RepoRemotes -> String+node umap fullinfo trustmap (r, rs) = unlines $ n:edges   where 	n = Dot.subGraph (hostname r) (basehostname r) "lightblue" $ 		trustDecorate trustmap (getUncachedUUID r) $ 			Dot.graphNode (nodeId r) (repoName umap r)-	edges = map (edge umap fullinfo r) (Git.remotes r)+	edges = map (edge umap fullinfo r) rs  {- An edge between two repos. The second repo is a remote of the first. -} edge :: M.Map UUID String -> [Git.Repo] -> Git.Repo -> Git.Repo -> String	@@ -149,21 +152,21 @@ 	Nothing -> Dot.fillColor "white" s  {- Recursively searches out remotes starting with the specified repo. -}-spider :: Git.Repo -> Annex [Git.Repo]+spider :: Git.Repo -> Annex [RepoRemotes] spider r = spider' [r] []-spider' :: [Git.Repo] -> [Git.Repo] -> Annex [Git.Repo]+spider' :: [Git.Repo] -> [RepoRemotes] -> Annex [RepoRemotes] spider' [] known = return known spider' (r:rs) known-	| any (same r) known = spider' rs known+	| any (same r) (map fst known) = spider' rs known 	| otherwise = do 		r' <- scan r  		-- The remotes will be relative to r', and need to be 		-- made absolute for later use.-		remotes <- mapM (absRepo r') (Git.remotes r')-		let r'' = r' { Git.remotes = remotes }--		spider' (rs ++ remotes) (r'':known)+		remotes <- mapM (absRepo r')+			=<< (liftIO $ Git.Construct.fromRemotes r')+	+		spider' (rs ++ remotes) ((r', remotes):known)  {- Converts repos to a common absolute form. -} absRepo :: Git.Repo -> Git.Repo -> Annex Git.Repo@@ -260,11 +263,11 @@  {- Spidering can find multiple paths to the same repo, so this is used  - to combine (really remove) duplicate repos with the same UUID. -}-combineSame :: [Git.Repo] -> [Git.Repo]+combineSame :: [RepoRemotes] -> [RepoRemotes] combineSame = map snd . nubBy sameuuid . map pair   where 	sameuuid (u1, _) (u2, _) = u1 == u2 && u1 /= NoUUID-	pair r = (getUncachedUUID r, r)+	pair (r, rs) = (getUncachedUUID r, (r, rs))  safely :: IO Git.Repo -> IO (Maybe Git.Repo) safely a = do

@@ -25,6 +25,8 @@ import qualified Git.LsFiles as LsFiles import Utility.Hash import Utility.Tmp+import Utility.Tmp.Dir+import Utility.Process.Transcript import Config  import Data.Char

@@ -19,7 +19,7 @@ import Annex.UUID import Config import Utility.AuthToken-import Utility.Tmp+import Utility.Tmp.Dir import Utility.FileMode import Utility.ThreadScheduler import qualified Utility.MagicWormhole as Wormhole@@ -76,7 +76,7 @@ unusedPeerRemoteName :: Annex RemoteName unusedPeerRemoteName = go (1 :: Integer) =<< usednames   where-	usednames = mapMaybe remoteName . remotes <$> Annex.gitRepo+	usednames = mapMaybe remoteName <$> Annex.getGitRemotes 	go n names = do 		let name = "peer" ++ show n 		if name `elem` names

@@ -9,7 +9,7 @@  import Command import Config-import Utility.Tmp+import Utility.Tmp.Dir import Utility.Env import Annex.Direct import qualified Git

@@ -63,6 +63,7 @@ import qualified Database.Export as Export import Utility.Bloom import Utility.OptParse+import Utility.Process.Transcript  import Control.Concurrent.MVar import qualified Data.Map as M

@@ -8,9 +8,9 @@ module Command.Version where  import Command-import qualified Build.SysConfig as SysConfig import Annex.Version import BuildInfo+import BuildFlags import Types.Key import qualified Types.Backend as B import qualified Types.Remote as R@@ -61,7 +61,7 @@  showPackageVersion :: IO () showPackageVersion = do-	vinfo "git-annex version" SysConfig.packageversion+	vinfo "git-annex version" BuildInfo.packageversion 	vinfo "build flags" $ unwords buildFlags 	vinfo "dependency versions" $ unwords dependencyVersions 	vinfo "key/value backends" $ unwords $@@ -70,7 +70,7 @@  showRawVersion :: IO () showRawVersion = do-	putStr SysConfig.packageversion+	putStr BuildInfo.packageversion 	hFlush stdout -- no newline, so flush  vinfo :: String -> String -> IO ()

@@ -1,4 +1,4 @@-{-# LANGUAGE PackageImports, CPP #-}+{-# LANGUAGE PackageImports #-}  module Common (module X) where @@ -14,9 +14,6 @@  import System.FilePath as X import System.IO as X hiding (FilePath)-#ifndef mingw32_HOST_OS-import System.Posix.IO as X hiding (createPipe)-#endif import System.Exit as X import System.PosixCompat.Files as X hiding (fileSize) 

@@ -8,14 +8,14 @@ module Git.BuildVersion where  import Git.Version-import qualified Build.SysConfig+import qualified BuildInfo  {- Using the version it was configured for avoids running git to check its  - version, at the cost that upgrading git won't be noticed.  - This is only acceptable because it's rare that git's version influences  - code's behavior. -} buildVersion :: GitVersion-buildVersion = normalize Build.SysConfig.gitversion+buildVersion = normalize BuildInfo.gitversion  older :: String -> Bool older n = buildVersion < normalize n 

@@ -13,8 +13,8 @@ import Common import Git import Git.Types-import qualified Git.Construct import qualified Git.Command+import qualified Git.Construct import Utility.UserInfo  {- Returns a single git config setting, or a default value if not set. -}@@ -89,12 +89,10 @@ store :: String -> Repo -> IO Repo store s repo = do 	let c = parse s-	repo' <- updateLocation $ repo+	updateLocation $ repo 		{ config = (M.map Prelude.head c) `M.union` config repo 		, fullconfig = M.unionWith (++) c (fullconfig repo) 		}-	rs <- Git.Construct.fromRemotes repo'-	return $ repo' { remotes = rs }  {- Updates the location of a repo, based on its configuration.  -

@@ -127,8 +127,7 @@   where 	filterconfig f = filter f $ M.toList $ config repo 	filterkeys f = filterconfig (\(k,_) -> f k)-	remotepairs = filterkeys isremote-	isremote k = "remote." `isPrefixOf` k && ".url" `isSuffixOf` k+	remotepairs = filterkeys isRemoteKey 	construct (k,v) = remoteNamedFromKey k $ fromRemoteLocation v repo  {- Sets the name of a remote when constructing the Repo to represent it. -}@@ -140,10 +139,7 @@ {- Sets the name of a remote based on the git config key, such as  - "remote.foo.url". -} remoteNamedFromKey :: String -> IO Repo -> IO Repo-remoteNamedFromKey k = remoteNamed basename-  where-	basename = intercalate "." $ -		reverse $ drop 1 $ reverse $ drop 1 $ splitc '.' k+remoteNamedFromKey = remoteNamed . remoteKeyToRemoteName  {- Constructs a new Repo for one of a Repo's remotes using a given  - location (ie, an url). -}@@ -233,7 +229,6 @@ 	{ location = l 	, config = M.empty 	, fullconfig = M.empty-	, remotes = [] 	, remoteName = Nothing 	, gitEnv = Nothing 	, gitEnvOverridesGitDir = False

@@ -12,6 +12,7 @@ import Git.Construct import qualified Git.Config import Utility.Env+import Utility.Env.Set  {- Gets the current git repository.  -

@@ -10,6 +10,7 @@ import Common import Git import Utility.Env+import Utility.Env.Set  indexEnv :: String indexEnv = "GIT_INDEX_FILE"

@@ -13,6 +13,7 @@  #ifndef mingw32_HOST_OS import System.Posix.Types+import System.Posix.IO #else import System.Win32.Types import System.Win32.File

@@ -20,6 +20,15 @@ import Git.FilePath #endif +{- Is a git config key one that specifies the location of a remote? -}+isRemoteKey :: String -> Bool+isRemoteKey k = "remote." `isPrefixOf` k && ".url" `isSuffixOf` k++{- Get a remote's name from the config key that specifies its location. -}+remoteKeyToRemoteName :: String -> RemoteName+remoteKeyToRemoteName k = intercalate "." $+	reverse $ drop 1 $ reverse $ drop 1 $ splitc '.' k+ {- Construct a legal git remote name out of an arbitrary input string.  -  - There seems to be no formal definition of this in the git source,

@@ -11,7 +11,6 @@ 	removeBadBranches, 	successfulRepair, 	cleanCorruptObjects,-	retrieveMissingObjects, 	resetLocalBranches, 	checkIndex, 	checkIndexFast,@@ -36,7 +35,7 @@ import qualified Git.RefLog as RefLog import qualified Git.UpdateIndex as UpdateIndex import qualified Git.Branch as Branch-import Utility.Tmp+import Utility.Tmp.Dir import Utility.Rsync import Utility.FileMode import Utility.Tuple@@ -102,10 +101,11 @@ 		unlessM (boolSystem "git" [Param "init", File tmpdir]) $ 			error $ "failed to create temp repository in " ++ tmpdir 		tmpr <- Config.read =<< Construct.fromAbsPath tmpdir-		stillmissing <- pullremotes tmpr (remotes r) fetchrefstags missing+		rs <- Construct.fromRemotes r+		stillmissing <- pullremotes tmpr rs fetchrefstags missing 		if S.null (knownMissing stillmissing) 			then return stillmissing-			else pullremotes tmpr (remotes r) fetchallrefs stillmissing+			else pullremotes tmpr rs fetchallrefs stillmissing   where 	pullremotes tmpr [] fetchrefs stillmissing = case referencerepo of 		Nothing -> return stillmissing

@@ -34,8 +34,8 @@ 	, config :: M.Map String String 	-- a given git config key can actually have multiple values 	, fullconfig :: M.Map String [String]-	, remotes :: [Repo]-	-- remoteName holds the name used for this repo in remotes+	-- remoteName holds the name used for this repo in some other+	-- repo's list of remotes, when this repo is such a remote 	, remoteName :: Maybe RemoteName 	-- alternate environment to use when running git commands 	, gitEnv :: Maybe [(String, String)]

@@ -0,0 +1,27 @@+{- git-annex log files+ -+ - Copyright 2018 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Logs.File where++import Annex.Common+import Annex.Perms+import Utility.Tmp++-- | Writes content to a file, replacing the file atomically, and+-- making the new file have whatever permissions the git repository is+-- configured to use. Creates the parent directory when necessary.+writeLogFile :: FilePath -> String -> Annex ()+writeLogFile f c = go `catchNonAsync` \_e -> do+	-- Most of the time, the directory will exist, so this is only+	-- done if writing the file fails.+	createAnnexDirectory (parentDir f)+	go+  where+	go = viaTmp writelog f c+	writelog f' c' = do+		liftIO $ writeFile f' c'+		setAnnexFilePerm f'

@@ -12,25 +12,22 @@ ) where  import Annex.Common-import Utility.Tmp import Git.Fsck import Git.Types+import Logs.File  import qualified Data.Set as S  writeFsckResults :: UUID -> FsckResults -> Annex () writeFsckResults u fsckresults = do 	logfile <- fromRepo $ gitAnnexFsckResultsLog u-	liftIO $ -		case fsckresults of-			FsckFailed -> store S.empty False logfile-			FsckFoundMissing s t-				| S.null s -> nukeFile logfile-				| otherwise -> store s t logfile+	case fsckresults of+		FsckFailed -> store S.empty False logfile+		FsckFoundMissing s t+			| S.null s -> liftIO $ nukeFile logfile+			| otherwise -> store s t logfile   where-	store s t logfile = do -		createDirectoryIfMissing True (parentDir logfile)-		liftIO $ viaTmp writeFile logfile $ serialize s t+	store s t logfile = writeLogFile logfile $ serialize s t 	serialize s t = 		let ls = map fromRef (S.toList s) 		in if t

@@ -26,7 +26,7 @@ import qualified Annex.Branch import Logs import Logs.UUIDBased-import Utility.Tmp+import Logs.File  scheduleSet :: UUID -> [ScheduledActivity] -> Annex () scheduleSet uuid@(UUID _) activities = do@@ -67,5 +67,5 @@ setLastRunTime :: ScheduledActivity -> LocalTime -> Annex () setLastRunTime activity lastrun = do 	f <- fromRepo gitAnnexScheduleState-	liftIO . viaTmp writeFile f . show . M.insert activity lastrun+	writeLogFile f . show . M.insert activity lastrun 		=<< getLastRunTimes

@@ -19,6 +19,7 @@ import Utility.PID import Annex.LockPool import Logs.TimeStamp+import Logs.File  import Data.Time.Clock import Data.Time.Clock.POSIX@@ -51,7 +52,7 @@ mkProgressUpdater :: Transfer -> TransferInfo -> Annex (MeterUpdate, FilePath, MVar Integer) mkProgressUpdater t info = do 	tfile <- fromRepo $ transferFile t-	_ <- tryNonAsync $ createAnnexDirectory $ takeDirectory tfile+	_ <- tryNonAsync $ writeTransferInfoFile info tfile 	mvar <- liftIO $ newMVar 0 	return (liftIO . updater tfile mvar, tfile, mvar)   where@@ -60,7 +61,7 @@ 		if newbytes - oldbytes >= mindelta 			then do 				let info' = info { bytesComplete = Just newbytes }-				_ <- tryIO $ writeTransferInfoFile info' tfile+				_ <- tryIO $ updateTransferInfoFile info' tfile 				return newbytes 			else return oldbytes 	{- The minimum change in bytesComplete that is worth@@ -181,8 +182,7 @@ recordFailedTransfer :: Transfer -> TransferInfo -> Annex () recordFailedTransfer t info = do 	failedtfile <- fromRepo $ failedTransferFile t-	createAnnexDirectory $ takeDirectory failedtfile-	liftIO $ writeTransferInfoFile info failedtfile+	writeTransferInfoFile info failedtfile  {- The transfer information file to use for a given Transfer. -} transferFile :: Transfer -> Git.Repo -> FilePath@@ -213,8 +213,13 @@   where 	bits = splitDirectories file -writeTransferInfoFile :: TransferInfo -> FilePath -> IO ()-writeTransferInfoFile info tfile = writeFile tfile $ writeTransferInfo info+writeTransferInfoFile :: TransferInfo -> FilePath -> Annex ()+writeTransferInfoFile info tfile = writeLogFile tfile $ writeTransferInfo info++-- The file keeps whatever permissions it has, so should be used only+-- after it's been created with the right perms by writeTransferInfoFile.+updateTransferInfoFile :: TransferInfo -> FilePath -> IO ()+updateTransferInfoFile info tfile = writeFile tfile $ writeTransferInfo info  {- File format is a header line containing the startedTime and any  - bytesComplete value. Followed by a newline and the associatedFile.

@@ -33,8 +33,8 @@  import Annex.Common import qualified Annex-import Utility.Tmp import Logs.TimeStamp+import Logs.File  -- everything that is stored in the unused log type UnusedLog = M.Map Key (Int, Maybe POSIXTime)@@ -64,7 +64,7 @@ writeUnusedLog :: FilePath -> UnusedLog -> Annex () writeUnusedLog prefix l = do 	logfile <- fromRepo $ gitAnnexUnusedLog prefix-	liftIO $ viaTmp writeFile logfile $ unlines $ map format $ M.toList l+	writeLogFile logfile $ unlines $ map format $ M.toList l   where 	format (k, (i, Just t)) = show i ++ " " ++ key2file k ++ " " ++ show t 	format (k, (i, Nothing)) = show i ++ " " ++ key2file k

@@ -26,7 +26,7 @@ import qualified Git.Branch import qualified Git.Ref import Git.Types-import Utility.Tmp+import Logs.File  import qualified Data.Set as S import Data.Char@@ -39,7 +39,7 @@ writeViews :: [View] -> Annex () writeViews l = do 	f <- fromRepo gitAnnexViewLog-	liftIO $ viaTmp writeFile f $ unlines $ map show l+	writeLogFile f $ unlines $ map show l  removeView :: View -> Annex () removeView v = writeViews =<< filter (/= v) <$> recentViews

@@ -182,7 +182,7 @@ 		(c', _encsetup) <- encryptionSetup c gc  		let url = Git.GCrypt.urlPrefix ++ gitrepo-		rs <- fromRepo Git.remotes+		rs <- Annex.getGitRemotes 		case filter (\r -> Git.remoteName r == Just remotename) rs of 			[] -> inRepo $ Git.Command.run  				[ Param "remote", Param "add"

@@ -1,6 +1,6 @@ {- Standard git remotes.  -- - Copyright 2011-2017 Joey Hess <id@joeyh.name>+ - Copyright 2011-2018 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -78,7 +78,7 @@ list :: Bool -> Annex [Git.Repo] list autoinit = do 	c <- fromRepo Git.config-	rs <- mapM (tweakurl c) =<< fromRepo Git.remotes+	rs <- mapM (tweakurl c) =<< Annex.getGitRemotes 	mapM (configRead autoinit) rs   where 	annexurl n = "remote." ++ n ++ ".annexurl"@@ -104,8 +104,8 @@ gitSetup Init mu _ c _ = do 	let location = fromMaybe (giveup "Specify location=url") $ 		Url.parseURIRelaxed =<< M.lookup "location" c-	g <- Annex.gitRepo-	u <- case filter (\r -> Git.location r == Git.Url location) (Git.remotes g) of+	rs <- Annex.getGitRemotes+	u <- case filter (\r -> Git.location r == Git.Url location) rs of 		[r] -> getRepoUUID r 		[] -> giveup "could not find existing git remote with specified location" 		_ -> giveup "found multiple git remotes with specified location"@@ -123,7 +123,8 @@ gitSetup (Enable _) Nothing _ _ _ = error "unable to enable git remote with no specified uuid"  {- It's assumed to be cheap to read the config of non-URL remotes, so this is- - done each time git-annex is run in a way that uses remotes.+ - done each time git-annex is run in a way that uses remotes, unless+ - annex-checkuuid is false.  -  - Conversely, the config of an URL remote is only read when there is no  - cached UUID value. -}@@ -134,7 +135,9 @@ 	annexignore <- liftIO $ getDynamicConfig (remoteAnnexIgnore gc) 	case (repoCheap r, annexignore, u) of 		(_, True, _) -> return r-		(True, _, _) -> tryGitConfigRead autoinit r+		(True, _, _)+			| remoteAnnexCheckUUID gc -> tryGitConfigRead autoinit r+			| otherwise -> return r 		(False, _, NoUUID) -> tryGitConfigRead autoinit r 		_ -> return r @@ -142,22 +145,24 @@ gen r u c gc 	| Git.GCrypt.isEncrypted r = Remote.GCrypt.chainGen r u c gc 	| otherwise = case repoP2PAddress r of-		Nothing -> go <$> remoteCost gc defcst+		Nothing -> do+			duc <- mkDeferredUUIDCheck r u gc+			go duc <$> remoteCost gc defcst 		Just addr -> Remote.P2P.chainGen addr r u c gc   where 	defcst = if repoCheap r then cheapRemoteCost else expensiveRemoteCost-	go cst = Just new+	go duc cst = Just new 	  where 		new = Remote  			{ uuid = u 			, cost = cst 			, name = Git.repoDescribe r-			, storeKey = copyToRemote new+			, storeKey = copyToRemote new duc 			, retrieveKeyFile = copyFromRemote new 			, retrieveKeyFileCheap = copyFromRemoteCheap new-			, removeKey = dropKey new-			, lockContent = Just (lockKey new)-			, checkPresent = inAnnex new+			, removeKey = dropKey new duc+			, lockContent = Just (lockKey new duc)+			, checkPresent = inAnnex new duc 			, checkPresentCheap = repoCheap r 			, exportActions = exportUnsupported 			, whereisKey = Nothing@@ -263,10 +268,9 @@ 				return r  	store = observe $ \r' -> do-		g <- gitRepo-		let l = Git.remotes g-		let g' = g { Git.remotes = exchange l r' }-		Annex.changeState $ \s -> s { Annex.repo = g' }+		l <- Annex.getGitRemotes+		let rs = exchange l r'+		Annex.changeState $ \s -> s { Annex.gitremotes = Just rs }  	exchange [] _ = [] 	exchange (old:ls) new@@ -323,8 +327,8 @@ 		else []  {- Checks if a given remote has the content for a key in its annex. -}-inAnnex :: Remote -> Key -> Annex Bool-inAnnex rmt key+inAnnex :: Remote -> DeferredUUIDCheck -> Key -> Annex Bool+inAnnex rmt duc key 	| Git.repoIsHttp r = checkhttp 	| Git.repoIsUrl r = checkremote 	| otherwise = checklocal@@ -337,9 +341,12 @@ 			, giveup "not found" 			) 	checkremote = Ssh.inAnnex r key-	checklocal = guardUsable r (cantCheck r) $-		maybe (cantCheck r) return-			=<< onLocalFast rmt (Annex.Content.inAnnexSafe key)+	checklocal = ifM duc+		( guardUsable r (cantCheck r) $+			maybe (cantCheck r) return+				=<< onLocalFast rmt (Annex.Content.inAnnexSafe key)+		, cantCheck r+		)  keyUrls :: Remote -> Key -> [String] keyUrls r key = map tourl locs'@@ -358,10 +365,10 @@ 	remoteconfig = gitconfig r 	cfg = remoteGitConfig remoteconfig -dropKey :: Remote -> Key -> Annex Bool-dropKey r key-	| not $ Git.repoIsUrl (repo r) =-		guardUsable (repo r) (return False) $+dropKey :: Remote -> DeferredUUIDCheck -> Key -> Annex Bool+dropKey r duc key+	| not $ Git.repoIsUrl (repo r) = ifM duc+		( guardUsable (repo r) (return False) $ 			commitOnCleanup r $ onLocalFast r $ do 				ensureInitialized 				whenM (Annex.Content.inAnnex key) $ do@@ -370,13 +377,15 @@ 						logStatus key InfoMissing 					Annex.Content.saveState True 				return True+		, return False+		) 	| Git.repoIsHttp (repo r) = giveup "dropping from http remote not supported" 	| otherwise = commitOnCleanup r $ Ssh.dropKey (repo r) key -lockKey :: Remote -> Key -> (VerifiedCopy -> Annex r) -> Annex r-lockKey r key callback-	| not $ Git.repoIsUrl (repo r) =-		guardUsable (repo r) failedlock $ do+lockKey :: Remote -> DeferredUUIDCheck -> Key -> (VerifiedCopy -> Annex r) -> Annex r+lockKey r duc key callback+	| not $ Git.repoIsUrl (repo r) = ifM duc+		( guardUsable (repo r) failedlock $ do 			inorigrepo <- Annex.makeRunner 			-- Lock content from perspective of remote, 			-- and then run the callback in the original@@ -387,6 +396,8 @@ 						( liftIO $ inorigrepo $ callback vc 						, failedlock 						)+		, failedlock+		) 	| Git.repoIsSsh (repo r) = do 		showLocking r 		Just (cmd, params) <- Ssh.git_annex_shell ConsumeStdin@@ -545,11 +556,13 @@ #endif  {- Tries to copy a key's content to a remote's annex. -}-copyToRemote :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool-copyToRemote r key file meterupdate-	| not $ Git.repoIsUrl (repo r) =-		guardUsable (repo r) (return False) $ commitOnCleanup r $+copyToRemote :: Remote -> DeferredUUIDCheck -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool+copyToRemote r duc key file meterupdate+	| not $ Git.repoIsUrl (repo r) = ifM duc+		( guardUsable (repo r) (return False) $ commitOnCleanup r $ 			copylocal =<< Annex.Content.prepSendAnnex key+		, return False+		) 	| Git.repoIsSsh (repo r) = commitOnCleanup r $ 		Annex.Content.sendAnnex key noop $ \object -> 			withmeter object $ \p -> do@@ -718,3 +731,26 @@ 				) 		, return copier 		)++{- Normally the UUID is checked at startup, but annex-checkuuid config+ - can prevent that. To avoid getting confused, a deferred+ - check is done just before the repository is used. This returns False+ - when the repository UUID is not as expected. -}+type DeferredUUIDCheck = Annex Bool++mkDeferredUUIDCheck :: Git.Repo -> UUID -> RemoteGitConfig -> Annex DeferredUUIDCheck+mkDeferredUUIDCheck r u gc+	| remoteAnnexCheckUUID gc = return (return True)+	| otherwise = do+		v <- liftIO newEmptyMVar+		return $ ifM (liftIO $ isEmptyMVar v)+			( do+				r' <- tryGitConfigRead False r+				u' <- getRepoUUID r'+				let ok = u' == u+				void $ liftIO $ tryPutMVar v ok+				unless ok $+					warning $ Git.repoDescribe r ++ " is not the expected repository. The remote's annex-checkuuid configuration prevented noticing the change until now."+				return ok+			, liftIO $ readMVar v+			)

@@ -38,7 +38,7 @@ import Types.Transfer import Types.Creds import Annex.DirHashes-import Utility.Tmp+import Utility.Tmp.Dir import Utility.SshHost  import qualified Data.Map as M

@@ -17,6 +17,7 @@ import qualified Git import qualified Git.Types as Git import qualified Git.CurrentRepo+import qualified Git.Construct import Utility.SimpleProtocol import Utility.ThreadScheduler import Config@@ -137,8 +138,9 @@ -- Generates a map with a transport for each supported remote in the git repo, -- except those that have annex.sync = false genRemoteMap :: TransportHandle -> TChan Emitted -> IO RemoteMap-genRemoteMap h@(TransportHandle (LocalRepo g) _) ochan = -	M.fromList . catMaybes <$> mapM gen (Git.remotes g)+genRemoteMap h@(TransportHandle (LocalRepo g) _) ochan = do+	rs <- Git.Construct.fromRemotes g+	M.fromList . catMaybes <$> mapM gen rs   where 	gen r = do 		gc <- atomically $ extractRemoteGitConfig g (Git.repoDescribe r)

@@ -12,18 +12,6 @@ import Types.Test import Options.Applicative.Types -#ifndef WITH_TESTSUITE--import Options.Applicative (pure)--optParser :: Parser ()-optParser = pure ()--runner :: Maybe (() -> IO ())-runner = Nothing--#else- import Test.Tasty import Test.Tasty.Runners import Test.Tasty.HUnit@@ -88,13 +76,14 @@ import qualified Logs.View import qualified Utility.Path import qualified Utility.FileMode-import qualified Build.SysConfig+import qualified BuildInfo import qualified Utility.Format import qualified Utility.Verifiable import qualified Utility.Process import qualified Utility.Misc import qualified Utility.InodeCache import qualified Utility.Env+import qualified Utility.Env.Set import qualified Utility.Matcher import qualified Utility.Exception import qualified Utility.Hash@@ -103,7 +92,7 @@ import qualified Utility.HumanTime import qualified Utility.ThreadScheduler import qualified Utility.Base64-import qualified Utility.Tmp+import qualified Utility.Tmp.Dir import qualified Utility.FileSystemEncoding import qualified Command.Uninit import qualified CmdLine.GitAnnex as GitAnnex@@ -142,7 +131,7 @@ 	subenv = "GIT_ANNEX_TEST_SUBPROCESS" 	runsubprocesstests opts Nothing = do 		pp <- Annex.Path.programPath-		Utility.Env.setEnv subenv "1" True+		Utility.Env.Set.setEnv subenv "1" True 		ps <- getArgs 		(Nothing, Nothing, Nothing, pid) <-createProcess (proc pp ps) 		exitcode <- waitForProcess pid@@ -368,7 +357,7 @@ 	git_annex "log" [annexedfile] @? "log failed"  test_import :: Assertion-test_import = intmpclonerepo $ Utility.Tmp.withTmpDir "importtest" $ \importdir -> do+test_import = intmpclonerepo $ Utility.Tmp.Dir.withTmpDir "importtest" $ \importdir -> do 	(toimport1, importf1, imported1) <- mktoimport importdir "import1" 	git_annex "import" [toimport1] @? "import failed" 	annexed_present_imported imported1@@ -1622,7 +1611,7 @@ 	annexed_present annexedfile  test_bup_remote :: Assertion-test_bup_remote = intmpclonerepo $ when Build.SysConfig.bup $ do+test_bup_remote = intmpclonerepo $ when BuildInfo.bup $ do 	dir <- absPath "dir" -- bup special remote needs an absolute path 	createDirectory dir 	git_annex "initremote" (words $ "foo type=bup encryption=none buprepo="++dir) @? "initremote failed"@@ -1929,11 +1918,11 @@ 	 {- Prevent global git configs from affecting the test suite. -} isolateGitConfig :: IO a -> IO a-isolateGitConfig a = Utility.Tmp.withTmpDir "testhome" $ \tmphome -> do+isolateGitConfig a = Utility.Tmp.Dir.withTmpDir "testhome" $ \tmphome -> do 	tmphomeabs <- absPath tmphome-	Utility.Env.setEnv "HOME" tmphomeabs True-	Utility.Env.setEnv "XDG_CONFIG_HOME" tmphomeabs True-	Utility.Env.setEnv "GIT_CONFIG_NOSYSTEM" "1" True+	Utility.Env.Set.setEnv "HOME" tmphomeabs True+	Utility.Env.Set.setEnv "XDG_CONFIG_HOME" tmphomeabs True+	Utility.Env.Set.setEnv "GIT_CONFIG_NOSYSTEM" "1" True 	a  cleanup :: FilePath -> IO ()@@ -1945,7 +1934,7 @@  finalCleanup :: IO () finalCleanup = whenM (doesDirectoryExist tmpdir) $ do-	Utility.Misc.reapZombies+	Annex.Action.reapZombies 	Command.Uninit.prepareRemoveAnnexDir' tmpdir 	catchIO (removeDirectoryRecursive tmpdir) $ \e -> do 		print e@@ -1953,7 +1942,7 @@ 		Utility.ThreadScheduler.threadDelaySeconds $ 			Utility.ThreadScheduler.Seconds 10 		whenM (doesDirectoryExist tmpdir) $ do-			Utility.Misc.reapZombies+			Annex.Action.reapZombies 			removeDirectoryRecursive tmpdir 	 checklink :: FilePath -> Assertion@@ -2119,7 +2108,7 @@ 	currdir <- getCurrentDirectory 	p <- Utility.Env.getEnvDefault "PATH" "" -	mapM_ (\(var, val) -> Utility.Env.setEnv var val True)+	mapM_ (\(var, val) -> Utility.Env.Set.setEnv var val True) 		-- Ensure that the just-built git annex is used. 		[ ("PATH", currdir ++ [searchPathSeparator] ++ p) 		, ("TOPDIR", currdir)@@ -2235,5 +2224,3 @@ 			, Types.KeySource.contentLocation = f 			, Types.KeySource.inodeCache = Nothing 			}--#endif

@@ -199,6 +199,7 @@ 	, remoteAnnexPush :: Bool 	, remoteAnnexReadOnly :: Bool 	, remoteAnnexVerify :: Bool+	, remoteAnnexCheckUUID :: Bool 	, remoteAnnexExportTracking :: Maybe Git.Ref 	, remoteAnnexTrustLevel :: Maybe String 	, remoteAnnexStartCommand :: Maybe String@@ -247,6 +248,7 @@ 		, remoteAnnexPull = getbool "pull" True 		, remoteAnnexPush = getbool "push" True 		, remoteAnnexReadOnly = getbool "readonly" False+		, remoteAnnexCheckUUID = getbool "checkuuid" True 		, remoteAnnexVerify = getbool "verify" True 		, remoteAnnexExportTracking = Git.Ref 			<$> notempty (getmaybe "export-tracking")

@@ -5,18 +5,13 @@  - Licensed under the GNU GPL version 3 or higher.  -} -{-# LANGUAGE CPP #-}- module Types.Test where -#ifdef WITH_TESTSUITE import Test.Tasty.Options import Data.Monoid import Prelude import Types.Command-#endif -#ifdef WITH_TESTSUITE data TestOptions = TestOptions 	{ tastyOptionSet :: OptionSet 	, keepFailuresOption :: Bool@@ -32,8 +27,5 @@ 		(fakeSsh a || fakeSsh b) 		(internalData a <> internalData b) -#else-type TestOptions = ()-#endif  type TestRunner = TestOptions -> IO ()

@@ -14,7 +14,7 @@ ) where  import Common-import qualified Build.SysConfig as SysConfig+import qualified BuildInfo  data CopyMetaData  	-- Copy timestamps when possible, but no other metadata, and@@ -34,11 +34,11 @@   where #ifndef __ANDROID__ 	params = map snd $ filter fst-		[ (SysConfig.cp_reflink_auto, Param "--reflink=auto")-		, (allmeta && SysConfig.cp_a, Param "-a")-		, (allmeta && SysConfig.cp_p && not SysConfig.cp_a+		[ (BuildInfo.cp_reflink_auto, Param "--reflink=auto")+		, (allmeta && BuildInfo.cp_a, Param "-a")+		, (allmeta && BuildInfo.cp_p && not BuildInfo.cp_a 			, Param "-p")-		, (not allmeta && SysConfig.cp_preserve_timestamps+		, (not allmeta && BuildInfo.cp_preserve_timestamps 			, Param "--preserve=timestamps") 		] #else

@@ -18,15 +18,11 @@ import System.FilePath import System.PosixCompat.Files import Control.Applicative-import Control.Concurrent import System.IO.Unsafe (unsafeInterleaveIO) import Data.Maybe import Prelude -#ifdef mingw32_HOST_OS-import qualified System.Win32 as Win32-#else-import qualified System.Posix as Posix+#ifndef mingw32_HOST_OS import Utility.SafeCommand import Control.Monad.IfElse #endif@@ -158,90 +154,3 @@ #else 	go = removeFile file #endif--#ifndef mingw32_HOST_OS-data DirectoryHandle = DirectoryHandle IsOpen Posix.DirStream-#else-data DirectoryHandle = DirectoryHandle IsOpen Win32.HANDLE Win32.FindData (MVar ())-#endif--type IsOpen = MVar () -- full when the handle is open--openDirectory :: FilePath -> IO DirectoryHandle-openDirectory path = do-#ifndef mingw32_HOST_OS-	dirp <- Posix.openDirStream path-	isopen <- newMVar ()-	return (DirectoryHandle isopen dirp)-#else-	(h, fdat) <- Win32.findFirstFile (path </> "*")-	-- Indicate that the fdat contains a filename that readDirectory-	-- has not yet returned, by making the MVar be full.-	-- (There's always at least a "." entry.)-	alreadyhave <- newMVar ()-	isopen <- newMVar ()-	return (DirectoryHandle isopen h fdat alreadyhave)-#endif--closeDirectory :: DirectoryHandle -> IO ()-#ifndef mingw32_HOST_OS-closeDirectory (DirectoryHandle isopen dirp) =-	whenOpen isopen $-		Posix.closeDirStream dirp-#else-closeDirectory (DirectoryHandle isopen h _ alreadyhave) =-	whenOpen isopen $ do-		_ <- tryTakeMVar alreadyhave-		Win32.findClose h-#endif-  where-	whenOpen :: IsOpen -> IO () -> IO ()-	whenOpen mv f = do-		v <- tryTakeMVar mv-		when (isJust v) f--{- |Reads the next entry from the handle. Once the end of the directory-is reached, returns Nothing and automatically closes the handle.--}-readDirectory :: DirectoryHandle -> IO (Maybe FilePath)-#ifndef mingw32_HOST_OS-readDirectory hdl@(DirectoryHandle _ dirp) = do-	e <- Posix.readDirStream dirp-	if null e-		then do-			closeDirectory hdl-			return Nothing-		else return (Just e)-#else-readDirectory hdl@(DirectoryHandle _ h fdat mv) = do-	-- If the MVar is full, then the filename in fdat has-	-- not yet been returned. Otherwise, need to find the next-	-- file.-	r <- tryTakeMVar mv-	case r of-		Just () -> getfn-		Nothing -> do-			more <- Win32.findNextFile h fdat-			if more-				then getfn-				else do-					closeDirectory hdl-					return Nothing-  where-	getfn = do-		filename <- Win32.getFindDataFileName fdat-		return (Just filename)-#endif---- True only when directory exists and contains nothing.--- Throws exception if directory does not exist.-isDirectoryEmpty :: FilePath -> IO Bool-isDirectoryEmpty d = bracket (openDirectory d) closeDirectory check-  where-	check h = do-		v <- readDirectory h-		case v of-			Nothing -> return True-			Just f-				| not (dirCruft f) -> return False-				| otherwise -> check h

@@ -0,0 +1,113 @@+{- streaming directory traversal+ -+ - Copyright 2011-2014 Joey Hess <id@joeyh.name>+ -+ - License: BSD-2-clause+ -}++{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-tabs #-}++module Utility.Directory.Stream where++import Control.Monad+import System.FilePath+import Control.Concurrent+import Data.Maybe+import Prelude++#ifdef mingw32_HOST_OS+import qualified System.Win32 as Win32+#else+import qualified System.Posix as Posix+#endif++import Utility.Directory+import Utility.Exception++#ifndef mingw32_HOST_OS+data DirectoryHandle = DirectoryHandle IsOpen Posix.DirStream+#else+data DirectoryHandle = DirectoryHandle IsOpen Win32.HANDLE Win32.FindData (MVar ())+#endif++type IsOpen = MVar () -- full when the handle is open++openDirectory :: FilePath -> IO DirectoryHandle+openDirectory path = do+#ifndef mingw32_HOST_OS+	dirp <- Posix.openDirStream path+	isopen <- newMVar ()+	return (DirectoryHandle isopen dirp)+#else+	(h, fdat) <- Win32.findFirstFile (path </> "*")+	-- Indicate that the fdat contains a filename that readDirectory+	-- has not yet returned, by making the MVar be full.+	-- (There's always at least a "." entry.)+	alreadyhave <- newMVar ()+	isopen <- newMVar ()+	return (DirectoryHandle isopen h fdat alreadyhave)+#endif++closeDirectory :: DirectoryHandle -> IO ()+#ifndef mingw32_HOST_OS+closeDirectory (DirectoryHandle isopen dirp) =+	whenOpen isopen $+		Posix.closeDirStream dirp+#else+closeDirectory (DirectoryHandle isopen h _ alreadyhave) =+	whenOpen isopen $ do+		_ <- tryTakeMVar alreadyhave+		Win32.findClose h+#endif+  where+	whenOpen :: IsOpen -> IO () -> IO ()+	whenOpen mv f = do+		v <- tryTakeMVar mv+		when (isJust v) f++{- |Reads the next entry from the handle. Once the end of the directory+is reached, returns Nothing and automatically closes the handle.+-}+readDirectory :: DirectoryHandle -> IO (Maybe FilePath)+#ifndef mingw32_HOST_OS+readDirectory hdl@(DirectoryHandle _ dirp) = do+	e <- Posix.readDirStream dirp+	if null e+		then do+			closeDirectory hdl+			return Nothing+		else return (Just e)+#else+readDirectory hdl@(DirectoryHandle _ h fdat mv) = do+	-- If the MVar is full, then the filename in fdat has+	-- not yet been returned. Otherwise, need to find the next+	-- file.+	r <- tryTakeMVar mv+	case r of+		Just () -> getfn+		Nothing -> do+			more <- Win32.findNextFile h fdat+			if more+				then getfn+				else do+					closeDirectory hdl+					return Nothing+  where+	getfn = do+		filename <- Win32.getFindDataFileName fdat+		return (Just filename)+#endif++-- True only when directory exists and contains nothing.+-- Throws exception if directory does not exist.+isDirectoryEmpty :: FilePath -> IO Bool+isDirectoryEmpty d = bracket (openDirectory d) closeDirectory check+  where+	check h = do+		v <- readDirectory h+		case v of+			Nothing -> return True+			Just f+				| not (dirCruft f) -> return False+				| otherwise -> check h

@@ -16,7 +16,6 @@ import Data.Maybe import Prelude import qualified System.Environment as E-import qualified System.SetEnv #else import qualified System.Posix.Env as PE #endif@@ -40,29 +39,6 @@ getEnvironment = PE.getEnvironment #else getEnvironment = E.getEnvironment-#endif--{- Sets an environment variable. To overwrite an existing variable,- - overwrite must be True.- -- - On Windows, setting a variable to "" unsets it. -}-setEnv :: String -> String -> Bool -> IO ()-#ifndef mingw32_HOST_OS-setEnv var val overwrite = PE.setEnv var val overwrite-#else-setEnv var val True = System.SetEnv.setEnv var val-setEnv var val False = do-	r <- getEnv var-	case r of-		Nothing -> setEnv var val True-		Just _ -> return ()-#endif--unsetEnv :: String -> IO ()-#ifndef mingw32_HOST_OS-unsetEnv = PE.unsetEnv-#else-unsetEnv = System.SetEnv.unsetEnv #endif  {- Adds the environment variable to the input environment. If already

@@ -0,0 +1,22 @@+{- portable environment variables, without any dependencies+ -+ - Copyright 2013 Joey Hess <id@joeyh.name>+ -+ - License: BSD-2-clause+ -}++{-# OPTIONS_GHC -fno-warn-tabs #-}++module Utility.Env.Basic where++import Utility.Exception+import Control.Applicative+import Data.Maybe+import Prelude+import qualified System.Environment as E++getEnv :: String -> IO (Maybe String)+getEnv = catchMaybeIO . E.getEnv++getEnvDefault :: String -> String -> IO String+getEnvDefault var fallback = fromMaybe fallback <$> getEnv var

@@ -0,0 +1,41 @@+{- portable environment variables+ -+ - Copyright 2013 Joey Hess <id@joeyh.name>+ -+ - License: BSD-2-clause+ -}++{-# LANGUAGE CPP #-}++module Utility.Env.Set where++#ifdef mingw32_HOST_OS+import qualified System.Environment as E+import qualified System.SetEnv+import Utility.Env+#else+import qualified System.Posix.Env as PE+#endif++{- Sets an environment variable. To overwrite an existing variable,+ - overwrite must be True.+ -+ - On Windows, setting a variable to "" unsets it. -}+setEnv :: String -> String -> Bool -> IO ()+#ifndef mingw32_HOST_OS+setEnv var val overwrite = PE.setEnv var val overwrite+#else+setEnv var val True = System.SetEnv.setEnv var val+setEnv var val False = do+	r <- getEnv var+	case r of+		Nothing -> setEnv var val True+		Just _ -> return ()+#endif++unsetEnv :: String -> IO ()+#ifndef mingw32_HOST_OS+unsetEnv = PE.unsetEnv+#else+unsetEnv = System.SetEnv.unsetEnv+#endif

@@ -10,13 +10,16 @@ module Utility.Gpg where  import Common-import qualified Build.SysConfig as SysConfig+import qualified BuildInfo #ifndef mingw32_HOST_OS import System.Posix.Types-import qualified System.Posix.IO+import System.Posix.IO import Utility.Env-#endif+import Utility.Env.Set+#else import Utility.Tmp+#endif+import Utility.Tmp.Dir import Utility.Format (decode_c)  import Control.Concurrent@@ -35,7 +38,7 @@  - command was found at configure time, use it, or otherwise, "gpg". -} mkGpgCmd :: Maybe FilePath -> GpgCmd mkGpgCmd (Just c) = GpgCmd c-mkGpgCmd Nothing = GpgCmd (fromMaybe "gpg" SysConfig.gpg)+mkGpgCmd Nothing = GpgCmd (fromMaybe "gpg" BuildInfo.gpg)  boolGpgCmd :: GpgCmd -> [CommandParam] -> IO Bool boolGpgCmd (GpgCmd cmd) = boolSystem cmd

@@ -13,6 +13,7 @@  #ifndef mingw32_HOST_OS import System.Posix.Types+import System.Posix.IO #endif  openLog :: FilePath -> IO Handle

@@ -10,8 +10,8 @@ module Utility.Lsof where  import Common-import Build.SysConfig as SysConfig-import Utility.Env+import BuildInfo+import Utility.Env.Set  import System.Posix.Types @@ -23,12 +23,12 @@ data ProcessInfo = ProcessInfo ProcessID CmdLine 	deriving (Show) -{- lsof is not in PATH on all systems, so SysConfig may have the absolute+{- lsof is not in PATH on all systems, so BuildInfo may have the absolute  - path where the program was found. Make sure at runtime that lsof is  - available, and if it's not in PATH, adjust PATH to contain it. -} setup :: IO () setup = do-	let cmd = fromMaybe "lsof" SysConfig.lsof+	let cmd = fromMaybe "lsof" BuildInfo.lsof 	when (isAbsolute cmd) $ do 		path <- getSearchPath 		let path' = takeDirectory cmd : path

@@ -5,7 +5,6 @@  - License: BSD-2-clause  -} -{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-tabs #-}  module Utility.Misc where@@ -16,10 +15,6 @@ import Data.Char import Data.List import System.Exit-#ifndef mingw32_HOST_OS-import System.Posix.Process (getAnyProcessStatus)-import Utility.Exception-#endif import Control.Applicative import Prelude @@ -111,22 +106,6 @@   where 	peekbytes :: Int -> Ptr Word8 -> IO [Word8] 	peekbytes len buf = mapM (peekElemOff buf) [0..pred len]--{- Reaps any zombie processes that may be hanging around.- -- - Warning: Not thread safe. Anything that was expecting to wait- - on a process and get back an exit status is going to be confused- - if this reap gets there first. -}-reapZombies :: IO ()-#ifndef mingw32_HOST_OS-reapZombies =-	-- throws an exception when there are no child processes-	catchDefaultIO Nothing (getAnyProcessStatus False True)-		>>= maybe (return ()) (const reapZombies)--#else-reapZombies = return ()-#endif  exitBool :: Bool -> IO a exitBool False = exitFailure

@@ -5,7 +5,7 @@  - License: BSD-2-clause  -} -{-# LANGUAGE PackageImports, CPP #-}+{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-tabs #-}  module Utility.Path where@@ -17,13 +17,6 @@ import Control.Applicative import Prelude -#ifdef mingw32_HOST_OS-import qualified System.FilePath.Posix as Posix-#else-import System.Posix.Files-import Utility.Exception-#endif- import Utility.Monad import Utility.UserInfo import Utility.Directory@@ -246,50 +239,6 @@ 	| otherwise = "." `isPrefixOf` f || dotfile (takeDirectory file)   where 	f = takeFileName file--{- Converts a DOS style path to a msys2 style path. Only on Windows.- - Any trailing '\' is preserved as a trailing '/' - - - - Taken from: http://sourceforge.net/p/msys2/wiki/MSYS2%20introduction/i- -- - The virtual filesystem contains:- -  /c, /d, ...	mount points for Windows drives- -}-toMSYS2Path :: FilePath -> FilePath-#ifndef mingw32_HOST_OS-toMSYS2Path = id-#else-toMSYS2Path p-	| null drive = recombine parts-	| otherwise = recombine $ "/" : driveletter drive : parts-  where-	(drive, p') = splitDrive p-	parts = splitDirectories p'-	driveletter = map toLower . takeWhile (/= ':')-	recombine = fixtrailing . Posix.joinPath-	fixtrailing s-		| hasTrailingPathSeparator p = Posix.addTrailingPathSeparator s-		| otherwise = s-#endif--{- Maximum size to use for a file in a specified directory.- -- - Many systems have a 255 byte limit to the name of a file, - - so that's taken as the max if the system has a larger limit, or has no- - limit.- -}-fileNameLengthLimit :: FilePath -> IO Int-#ifdef mingw32_HOST_OS-fileNameLengthLimit _ = return 255-#else-fileNameLengthLimit dir = do-	-- getPathVar can fail due to statfs(2) overflow-	l <- catchDefaultIO 0 $-		fromIntegral <$> getPathVar dir FileNameLimit-	if l <= 0-		then return 255-		else return $ minimum [l, 255]-#endif  {- Given a string that we'd like to use as the basis for FilePath, but that  - was provided by a third party and is not to be trusted, returns the closest

@@ -0,0 +1,40 @@+{- path manipulation+ -+ - Copyright 2010-2014 Joey Hess <id@joeyh.name>+ -+ - License: BSD-2-clause+ -}++{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-tabs #-}++module Utility.Path.Max where++import System.FilePath+import Data.List+import Control.Applicative+import Prelude++#ifndef mingw32_HOST_OS+import Utility.Exception+import System.Posix.Files+#endif++{- Maximum size to use for a file in a specified directory.+ -+ - Many systems have a 255 byte limit to the name of a file, + - so that's taken as the max if the system has a larger limit, or has no+ - limit.+ -}+fileNameLengthLimit :: FilePath -> IO Int+#ifdef mingw32_HOST_OS+fileNameLengthLimit _ = return 255+#else+fileNameLengthLimit dir = do+	-- getPathVar can fail due to statfs(2) overflow+	l <- catchDefaultIO 0 $+		fromIntegral <$> getPathVar dir FileNameLimit+	if l <= 0+		then return 255+		else return $ minimum [l, 255]+#endif

@@ -24,8 +24,6 @@ 	createProcessSuccess, 	createProcessChecked, 	createBackgroundProcess,-	processTranscript,-	processTranscript', 	withHandle, 	withIOHandles, 	withOEHandles,@@ -54,13 +52,6 @@ import Control.Concurrent import qualified Control.Exception as E import Control.Monad-#ifndef mingw32_HOST_OS-import qualified System.Posix.IO-#else-import Control.Applicative-#endif-import Data.Maybe-import Prelude  type CreateProcessRunner = forall a. CreateProcess -> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO a) -> IO a @@ -169,68 +160,6 @@ -- Note: Zombies will result, and must be waited on. createBackgroundProcess :: CreateProcessRunner createBackgroundProcess p a = a =<< createProcess p---- | Runs a process, optionally feeding it some input, and--- returns a transcript combining its stdout and stderr, and--- whether it succeeded or failed.-processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool)-processTranscript cmd opts = processTranscript' (proc cmd opts)--processTranscript' :: CreateProcess -> Maybe String -> IO (String, Bool)-processTranscript' cp input = do-#ifndef mingw32_HOST_OS-{- This implementation interleves stdout and stderr in exactly the order- - the process writes them. -}-	(readf, writef) <- System.Posix.IO.createPipe-	readh <- System.Posix.IO.fdToHandle readf-	writeh <- System.Posix.IO.fdToHandle writef-	p@(_, _, _, pid) <- createProcess $ cp-		{ std_in = if isJust input then CreatePipe else Inherit-		, std_out = UseHandle writeh-		, std_err = UseHandle writeh-		}-	hClose writeh--	get <- mkreader readh-	writeinput input p-	transcript <- get--	ok <- checkSuccessProcess pid-	return (transcript, ok)-#else-{- This implementation for Windows puts stderr after stdout. -}-	p@(_, _, _, pid) <- createProcess $ cp-		{ std_in = if isJust input then CreatePipe else Inherit-		, std_out = CreatePipe-		, std_err = CreatePipe-		}--	getout <- mkreader (stdoutHandle p)-	geterr <- mkreader (stderrHandle p)-	writeinput input p-	transcript <- (++) <$> getout <*> geterr--	ok <- checkSuccessProcess pid-	return (transcript, ok)-#endif-  where-	mkreader h = do-		s <- hGetContents h-		v <- newEmptyMVar-		void $ forkIO $ do-			void $ E.evaluate (length s)-			putMVar v ()-		return $ do-			takeMVar v-			return s--	writeinput (Just s) p = do-		let inh = stdinHandle p-		unless (null s) $ do-			hPutStr inh s-			hFlush inh-		hClose inh-	writeinput Nothing _ = return ()  -- | Runs a CreateProcessRunner, on a CreateProcess structure, that -- is adjusted to pipe only from/to a single StdHandle, and passes

@@ -0,0 +1,87 @@+{- Process transcript+ -+ - Copyright 2012-2015 Joey Hess <id@joeyh.name>+ -+ - License: BSD-2-clause+ -}++{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-tabs #-}++module Utility.Process.Transcript where++import Utility.Process++import System.IO+import Control.Concurrent+import qualified Control.Exception as E+import Control.Monad+#ifndef mingw32_HOST_OS+import qualified System.Posix.IO+#else+import Control.Applicative+#endif+import Data.Maybe+import Prelude++-- | Runs a process, optionally feeding it some input, and+-- returns a transcript combining its stdout and stderr, and+-- whether it succeeded or failed.+processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool)+processTranscript cmd opts = processTranscript' (proc cmd opts)++processTranscript' :: CreateProcess -> Maybe String -> IO (String, Bool)+processTranscript' cp input = do+#ifndef mingw32_HOST_OS+{- This implementation interleves stdout and stderr in exactly the order+ - the process writes them. -}+	(readf, writef) <- System.Posix.IO.createPipe+	readh <- System.Posix.IO.fdToHandle readf+	writeh <- System.Posix.IO.fdToHandle writef+	p@(_, _, _, pid) <- createProcess $ cp+		{ std_in = if isJust input then CreatePipe else Inherit+		, std_out = UseHandle writeh+		, std_err = UseHandle writeh+		}+	hClose writeh++	get <- mkreader readh+	writeinput input p+	transcript <- get++	ok <- checkSuccessProcess pid+	return (transcript, ok)+#else+{- This implementation for Windows puts stderr after stdout. -}+	p@(_, _, _, pid) <- createProcess $ cp+		{ std_in = if isJust input then CreatePipe else Inherit+		, std_out = CreatePipe+		, std_err = CreatePipe+		}++	getout <- mkreader (stdoutHandle p)+	geterr <- mkreader (stderrHandle p)+	writeinput input p+	transcript <- (++) <$> getout <*> geterr++	ok <- checkSuccessProcess pid+	return (transcript, ok)+#endif+  where+	mkreader h = do+		s <- hGetContents h+		v <- newEmptyMVar+		void $ forkIO $ do+			void $ E.evaluate (length s)+			putMVar v ()+		return $ do+			takeMVar v+			return s++	writeinput (Just s) p = do+		let inh = stdinHandle p+		unless (null s) $ do+			hPutStr inh s+			hFlush inh+		hClose inh+	writeinput Nothing _ = return ()

@@ -13,6 +13,10 @@ import Utility.Metered import Utility.Tuple +#ifdef mingw32_HOST_OS+import qualified System.FilePath.Posix as Posix+#endif+ import Data.Char import System.Console.GetOpt @@ -139,3 +143,29 @@ 	[ Option [] ["bwlimit"] (reqArgLong "bwlimit") "" ]   where 	reqArgLong x = ReqArg (\v -> "--" ++ x ++ "=" ++ v) ""++{- Converts a DOS style path to a msys2 style path. Only on Windows.+ - Any trailing '\' is preserved as a trailing '/' + - + - Taken from: http://sourceforge.net/p/msys2/wiki/MSYS2%20introduction/i+ -+ - The virtual filesystem contains:+ -  /c, /d, ...	mount points for Windows drives+ -}+toMSYS2Path :: FilePath -> FilePath+#ifndef mingw32_HOST_OS+toMSYS2Path = id+#else+toMSYS2Path p+	| null drive = recombine parts+	| otherwise = recombine $ "/" : driveletter drive : parts+  where+	(drive, p') = splitDrive p+	parts = splitDirectories p'+	driveletter = map toLower . takeWhile (/= ':')+	recombine = fixtrailing . Posix.joinPath+	fixtrailing s+		| hasTrailingPathSeparator p = Posix.addTrailingPathSeparator s+		| otherwise = s+#endif+

@@ -13,6 +13,7 @@  #ifndef mingw32_HOST_OS import Utility.Env+import System.Posix.IO import System.Posix.Terminal #endif 

@@ -1,4 +1,4 @@-{- Temporary files and directories.+{- Temporary files.  -  - Copyright 2010-2013 Joey Hess <id@joeyh.name>  -@@ -11,14 +11,10 @@ module Utility.Tmp where  import System.IO-import Control.Monad.IfElse import System.FilePath import System.Directory import Control.Monad.IO.Class import System.PosixCompat.Files-#ifndef mingw32_HOST_OS-import System.Posix.Temp (mkdtemp)-#endif  import Utility.Exception import Utility.FileSystemEncoding@@ -61,51 +57,6 @@ 		hClose h 		catchBoolIO (removeFile name >> return True) 	use (name, h) = a name h--{- Runs an action with a tmp directory located within the system's tmp- - directory (or within "." if there is none), then removes the tmp- - directory and all its contents. -}-withTmpDir :: (MonadMask m, MonadIO m) => Template -> (FilePath -> m a) -> m a-withTmpDir template a = do-	topleveltmpdir <- liftIO $ catchDefaultIO "." getTemporaryDirectory-#ifndef mingw32_HOST_OS-	-- Use mkdtemp to create a temp directory securely in /tmp.-	bracket-		(liftIO $ mkdtemp $ topleveltmpdir </> template)-		removeTmpDir-		a-#else-	withTmpDirIn topleveltmpdir template a-#endif--{- Runs an action with a tmp directory located within a specified directory,- - then removes the tmp directory and all its contents. -}-withTmpDirIn :: (MonadMask m, MonadIO m) => FilePath -> Template -> (FilePath -> m a) -> m a-withTmpDirIn tmpdir template = bracketIO create removeTmpDir-  where-	create = do-		createDirectoryIfMissing True tmpdir-		makenewdir (tmpdir </> template) (0 :: Int)-	makenewdir t n = do-		let dir = t ++ "." ++ show n-		catchIOErrorType AlreadyExists (const $ makenewdir t $ n + 1) $ do-			createDirectory dir-			return dir--{- Deletes the entire contents of the the temporary directory, if it- - exists. -}-removeTmpDir :: MonadIO m => FilePath -> m ()-removeTmpDir tmpdir = liftIO $ whenM (doesDirectoryExist tmpdir) $ do-#if mingw32_HOST_OS-	-- Windows will often refuse to delete a file-	-- after a process has just written to it and exited.-	-- Because it's crap, presumably. So, ignore failure-	-- to delete the temp directory.-	_ <- tryIO $ removeDirectoryRecursive tmpdir-	return ()-#else-	removeDirectoryRecursive tmpdir-#endif  {- It's not safe to use a FilePath of an existing file as the template  - for openTempFile, because if the FilePath is really long, the tmpfile

@@ -0,0 +1,68 @@+{- Temporary directorie+ -+ - Copyright 2010-2013 Joey Hess <id@joeyh.name>+ -+ - License: BSD-2-clause+ -}++{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-tabs #-}++module Utility.Tmp.Dir where++import Control.Monad.IfElse+import System.FilePath+import System.Directory+import Control.Monad.IO.Class+#ifndef mingw32_HOST_OS+import System.Posix.Temp (mkdtemp)+#endif++import Utility.Exception++type Template = String++{- Runs an action with a tmp directory located within the system's tmp+ - directory (or within "." if there is none), then removes the tmp+ - directory and all its contents. -}+withTmpDir :: (MonadMask m, MonadIO m) => Template -> (FilePath -> m a) -> m a+withTmpDir template a = do+	topleveltmpdir <- liftIO $ catchDefaultIO "." getTemporaryDirectory+#ifndef mingw32_HOST_OS+	-- Use mkdtemp to create a temp directory securely in /tmp.+	bracket+		(liftIO $ mkdtemp $ topleveltmpdir </> template)+		removeTmpDir+		a+#else+	withTmpDirIn topleveltmpdir template a+#endif++{- Runs an action with a tmp directory located within a specified directory,+ - then removes the tmp directory and all its contents. -}+withTmpDirIn :: (MonadMask m, MonadIO m) => FilePath -> Template -> (FilePath -> m a) -> m a+withTmpDirIn tmpdir template = bracketIO create removeTmpDir+  where+	create = do+		createDirectoryIfMissing True tmpdir+		makenewdir (tmpdir </> template) (0 :: Int)+	makenewdir t n = do+		let dir = t ++ "." ++ show n+		catchIOErrorType AlreadyExists (const $ makenewdir t $ n + 1) $ do+			createDirectory dir+			return dir++{- Deletes the entire contents of the the temporary directory, if it+ - exists. -}+removeTmpDir :: MonadIO m => FilePath -> m ()+removeTmpDir tmpdir = liftIO $ whenM (doesDirectoryExist tmpdir) $ do+#if mingw32_HOST_OS+	-- Windows will often refuse to delete a file+	-- after a process has just written to it and exited.+	-- Because it's crap, presumably. So, ignore failure+	-- to delete the temp directory.+	_ <- tryIO $ removeDirectoryRecursive tmpdir+	return ()+#else+	removeDirectoryRecursive tmpdir+#endif

@@ -32,8 +32,8 @@ ) where  import Common-import Utility.Tmp-import qualified Build.SysConfig+import Utility.Tmp.Dir+import qualified BuildInfo  import Network.URI import Network.HTTP.Types@@ -163,7 +163,7 @@ 						sz <- getFileSize' f stat 						found (Just sz) Nothing 					Nothing -> dne-			| Build.SysConfig.curl -> existscurl u+			| BuildInfo.curl -> existscurl u 			| otherwise -> dne 	Nothing -> dne   where@@ -281,7 +281,7 @@ 	 -} #ifndef __ANDROID__ 	wgetparams = concat-		[ if Build.SysConfig.wgetunclutter && not quiet+		[ if BuildInfo.wgetunclutter && not quiet 			then [Param "-nv", Param "--show-progress"] 			else [] 		, [ Param "--clobber", Param "-c", Param "-O"]

@@ -14,7 +14,7 @@ 	myUserGecos, ) where -import Utility.Env+import Utility.Env.Basic import Utility.Exception #ifndef mingw32_HOST_OS import Utility.Data

@@ -0,0 +1,118 @@+# NAME++git-annex export - export content to a remote++# SYNOPSIS++git annex export `treeish --to remote`++git annex export `--tracking treeish --to remote`++# DESCRIPTION++Use this command to export a tree of files from a git-annex repository.++Normally files are stored on a git-annex special remote named by their+keys. That is great for reliable data storage, but your filenames are+obscured. Exporting replicates the tree to the special remote as-is.++Mixing key/value storage and exports in the same remote would be a mess and+so is not allowed. You have to configure a special remote with+`exporttree=yes` when initially setting it up with+[[git-annex-initremote]](1).++The treeish to export can be the name of a git branch, or a tag, or any+other treeish accepted by git, including eg master:subdir to only export a+subdirectory from a branch.++Repeated exports are done efficiently, by diffing the old and new tree,+and transferring only the changed files, and renaming files as necessary.++Exports can be interrupted and resumed. However, partially uploaded files+will be re-started from the beginning.++Once content has been exported to a remote, commands like `git annex get`+can download content from there the same as from other remotes. However,+since an export is not a key/value store, git-annex has to do more+verification of content downloaded from an export. Some types of keys,+that are not based on checksums, cannot be downloaded from an export.+And, git-annex will never trust an export to retain the content of a key.++# OPTIONS++* `--to=remote`++  Specify the special remote to export to.++* `--tracking`++  This makes the export track changes that are committed to+  the branch. `git annex sync --content` and the git-annex assistant+  will update exports when it commits to the branch they are tracking.++* `--fast`++  This sets up an export of a tree, but avoids any expensive file uploads to+  the remote. You can later run `git annex sync --content` to upload+  the files to the export.++# EXAMPLE++	git annex initremote myexport type=directory directory=/mnt/myexport \+		exporttree=yes encryption=none+	git annex export master --to myexport++After that, /mnt/myexport will contain the same tree of files as the master+branch does.++	git mv myfile subdir/myfile+	git commit -m renamed+	git annex export master --to myexport++That updates /mnt/myexport to reflect the renamed file.++	git annex export master:subdir --to myexport++That updates /mnt/myexport, to contain only the files in the "subdir"+directory of the master branch.++	git annex export --tracking master --to myexport++That makes myexport track changes that are committed to the master branch.++# EXPORT CONFLICTS++If two different git-annex repositories are both exporting different trees+to the same special remote, it's possible for an export conflict to occur.+This leaves the special remote with some files from one tree, and some+files from the other. Files in the special remote may have entirely the+wrong content as well.++It's not possible for git-annex to detect when making an export will result+in an export conflict. The best way to avoid export conflicts is to either+only ever export to a special remote from a single repository, or to have a+rule about the tree that you export to the special remote. For example, if+you always export origin/master after pushing to origin, then an export+conflict can't happen.++An export conflict can only be detected after the two git repositories+that produced it get back in sync. Then the next time you run `git annex+export`, it will detect the export conflict, and resolve it.++# SEE ALSO++[[git-annex]](1)++[[git-annex-initremote]](1)++[[git-annex-sync]](1)++# HISTORY++The `export` command was introduced in git-annex version 6.20170925.++# AUTHOR++Joey Hess <id@joeyh.name>++Warning: Automatically converted into a man page by mdwn2man. Edit with care.

@@ -0,0 +1,53 @@+# NAME++git-annex inprogress - access files while they're being downloaded++# SYNOPSIS++git annex inprogress `[path ...]`++# DESCRIPTION++This command allows accessing the content of an annexed file while+it is still being downloaded. It outputs to standard output the+name of the temporary file that is being used to download the specified+annexed file.++This can sometimes be used to stream a file before it's been fully+downloaded, for example:++	git annex get video.mpeg &+	vlc $(git annex inprogress video.mpeg)++Of course if the file is downloading too slowly, the media player will+reach the end too soon and not show the whole thing. And of course, only+some file formats can be usefully streamed in this way.++# OPTIONS++* file matching options+ +  The [[git-annex-matching-options]](1)+  can be used to specify files to access.++* `--all`++  Rather than specifying a filename or path, this option can be+  used to access all files that are currently being downloaded.++# EXIT STATUS++If any of the requested files are not currently being downloaded,+the exit status will be 1.++# SEE ALSO++[[git-annex]](1)++[[git-annex-get]](1)++# AUTHOR++Joey Hess <id@joeyh.name>++Warning: Automatically converted into a man page by mdwn2man. Edit with care.

@@ -461,6 +461,12 @@    See [[git-annex-map]](1) for details. +* `inprogress`++  Access files while they're being downloaded.++  See [[git-annex-inprogress]](1) for details.+ # METADATA COMMANDS  * `metadata [path ...]`@@ -1227,6 +1233,18 @@ * `remote.<name>.annex-uuid`    git-annex caches UUIDs of remote repositories here.++- `remote.<name>.annex-checkuuid`++  This only affects remotes that have their url pointing to a directory on+  the same system. git-annex normally checks the uuid of such+  remotes each time it's run, which lets it transparently deal with+  different drives being mounted to the location at different times.++  Setting annex-checkuuid to false will prevent it from checking the uuid +  at startup (although the uuid is still verified before making any+  changes to the remote repository). This may be useful to set to prevent+  unncessary spin-up or automounting of a drive.  * `remote.<name>.annex-trustlevel` 

@@ -1,5 +1,5 @@ Name: git-annex-Version: 6.20171214+Version: 6.20180112 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess <id@joeyh.name>@@ -62,6 +62,7 @@   doc/git-annex-enable-tor.mdwn   doc/git-annex-examinekey.mdwn   doc/git-annex-expire.mdwn+  doc/git-annex-export.mdwn   doc/git-annex-find.mdwn   doc/git-annex-findref.mdwn   doc/git-annex-fix.mdwn@@ -78,6 +79,7 @@   doc/git-annex-info.mdwn   doc/git-annex-init.mdwn   doc/git-annex-initremote.mdwn+  doc/git-annex-inprogress.mdwn   doc/git-annex-list.mdwn   doc/git-annex-lock.mdwn   doc/git-annex-log.mdwn@@ -276,9 +278,6 @@   Description: Building to get TH splices for Android   Default: False -Flag TestSuite-  Description: Embed the test suite into git-annex- Flag TorrentParser   Description: Use haskell torrent library to parse torrent files @@ -303,6 +302,11 @@   type: git   location: git://git-annex.branchable.com/ +custom-setup+  Setup-Depends: base (>= 4.6), hslogger, split, unix-compat, process,+    filepath, exceptions, bytestring, directory, IfElse, data-default,+    utf8-string, Cabal+ Executable git-annex   Main-Is: git-annex.hs   Build-Depends:@@ -310,7 +314,6 @@    optparse-applicative (>= 0.11.0),     containers (>= 0.5.0.0),    exceptions (>= 0.6),-   QuickCheck (>= 2.1),    stm (>= 2.3),    mtl (>= 2),    uuid (>= 1.2.6),@@ -358,7 +361,12 @@    crypto-api,    cryptonite,    memory,-   split+   split,+   QuickCheck (>= 2.1),+   tasty (>= 0.7),+   tasty-hunit,+   tasty-quickcheck,+   tasty-rerun   CC-Options: -Wall   GHC-Options: -Wall -fno-warn-tabs   Extensions: PackageImports, LambdaCase@@ -391,10 +399,6 @@     if impl(ghc <= 7.6.3)       Other-Modules: Utility.Touch.Old -  if flag(TestSuite)-    Build-Depends: tasty (>= 0.7), tasty-hunit, tasty-quickcheck, tasty-rerun-    CPP-Options: -DWITH_TESTSUITE-   if flag(S3)     Build-Depends: conduit, conduit-extra, aws (>= 0.9.2)     CPP-Options: -DWITH_S3@@ -662,6 +666,7 @@     Build.TestConfig     Build.Version     BuildInfo+    BuildFlags     CmdLine     CmdLine.Action     CmdLine.Batch@@ -719,6 +724,7 @@     Command.Info     Command.Init     Command.InitRemote+    Command.Inprogress     Command.List     Command.Lock     Command.LockContent@@ -854,6 +860,7 @@     Logs.Difference     Logs.Difference.Pure     Logs.Export+    Logs.File     Logs.FsckResults     Logs.Group     Logs.Line@@ -987,10 +994,13 @@     Utility.DirWatcher     Utility.DirWatcher.Types     Utility.Directory+    Utility.Directory.Stream     Utility.DiskFree     Utility.Dot     Utility.DottedVersion     Utility.Env+    Utility.Env.Basic+    Utility.Env.Set     Utility.Exception     Utility.ExternalSHA     Utility.FileMode@@ -1029,9 +1039,11 @@     Utility.Parallel     Utility.PartialPrelude     Utility.Path+    Utility.Path.Max     Utility.Percentage     Utility.Process     Utility.Process.Shim+    Utility.Process.Transcript     Utility.QuickCheck     Utility.Rsync     Utility.SRV@@ -1050,6 +1062,7 @@     Utility.ThreadLock     Utility.ThreadScheduler     Utility.Tmp+    Utility.Tmp.Dir     Utility.Tor     Utility.Touch     Utility.Tuple

@@ -19,7 +19,7 @@  #ifdef mingw32_HOST_OS import Utility.UserInfo-import Utility.Env+import Utility.Env.Set #endif  main :: IO ()

@@ -6,7 +6,6 @@     pairing: true     network-uri: true     s3: true-    testsuite: true     webdav: true     torrentparser: true     webapp: true