packages feed

git-annex 7.20190912 → 7.20191009

raw patch · 33 files changed

+557/−167 lines, 33 filesdep +unliftio-core

Dependencies added: unliftio-core

Files

Annex/AdjustedBranch/Name.hs view
@@ -49,7 +49,7 @@ 	serializeAdjustment FixAdjustment = "fixed" 	serializeAdjustment UnFixAdjustment = "unfixed" 	deserializeAdjustment "unlocked" = Just UnlockAdjustment-	deserializeAdjustment "locked" = Just UnlockAdjustment+	deserializeAdjustment "locked" = Just LockAdjustment 	deserializeAdjustment "fixed" = Just FixAdjustment 	deserializeAdjustment "unfixed" = Just UnFixAdjustment 	deserializeAdjustment _ = Nothing
Annex/Content/PointerFile.hs view
@@ -9,15 +9,20 @@  module Annex.Content.PointerFile where +#if ! defined(mingw32_HOST_OS)+import System.Posix.Files+#else import System.PosixCompat.Files+#endif  import Annex.Common import Annex.Perms import Annex.Link import Annex.ReplaceFile import Annex.InodeSentinal-import Utility.InodeCache import Annex.Content.LowLevel+import Utility.InodeCache+import Utility.Touch  {- Populates a pointer file with the content of a key.   -@@ -48,10 +53,18 @@  - Does not check if the pointer file is modified. -} depopulatePointerFile :: Key -> FilePath -> Annex () depopulatePointerFile key file = do-	mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file+	st <- liftIO $ catchMaybeIO $ getFileStatus file+	let mode = fmap fileMode st 	secureErase file 	liftIO $ nukeFile file 	ic <- replaceFile file $ \tmp -> do 		liftIO $ writePointerFile tmp key mode+#if ! defined(mingw32_HOST_OS)+		-- Don't advance mtime; this avoids unncessary re-smudging+		-- by git in some cases.+		liftIO $ maybe noop+			(\t -> touch tmp t False)+			(fmap modificationTimeHiRes st)+#endif 		withTSDelta (liftIO . genInodeCache tmp) 	maybe noop (restagePointerFile (Restage True) file) ic
Annex/FileMatcher.hs view
@@ -113,14 +113,14 @@   where 	splitparens = segmentDelim (`elem` "()") -commonKeylessTokens :: [ParseToken (MatchFiles Annex)]-commonKeylessTokens =+commonKeylessTokens :: LimitBy -> [ParseToken (MatchFiles Annex)]+commonKeylessTokens lb = 	[ SimpleToken "anything" (simply limitAnything) 	, SimpleToken "nothing" (simply limitNothing) 	, ValueToken "include" (usev limitInclude) 	, ValueToken "exclude" (usev limitExclude)-	, ValueToken "largerthan" (usev $ limitSize (>))-	, ValueToken "smallerthan" (usev $ limitSize (<))+	, ValueToken "largerthan" (usev $ limitSize lb (>))+	, ValueToken "smallerthan" (usev $ limitSize lb (<)) 	]  commonKeyedTokens :: [ParseToken (MatchFiles Annex)]@@ -147,7 +147,7 @@ 	[ SimpleToken "standard" (call $ matchStandard pcd) 	, SimpleToken "groupwanted" (call $ matchGroupWanted pcd) 	, SimpleToken "inpreferreddir" (simply $ limitInDir preferreddir)-	] ++ commonKeylessTokens+	] ++ commonKeylessTokens LimitAnnexFiles   where 	preferreddir = fromMaybe "public" $ 		M.lookup "preferreddir" =<< (`M.lookup` configMap pcd) =<< repoUUID pcd@@ -182,7 +182,9 @@ 	let mimer n = ValueToken n $  		const $ Left $ "\""++n++"\" not supported; not built with MagicMime support" #endif-	let parse = parseToken $ commonKeyedTokens ++ commonKeylessTokens +++	let parse = parseToken $+		commonKeyedTokens +++		commonKeylessTokens LimitDiskFiles ++ #ifdef WITH_MAGICMIME 		[ mimer "mimetype" $ 			matchMagic "mimetype" getMagicMimeType providedMimeType
Annex/Hook.hs view
@@ -1,10 +1,10 @@ {- git-annex git hooks  -- - Note that it's important that the scripts installed by git-annex- - not change, otherwise removing old hooks using an old version of- - the script would fail.+ - Note that it's important that the content of scripts installed by+ - git-annex not change, otherwise removing old hooks using an old+ - version of the script would fail.  -- - Copyright 2013-2018 Joey Hess <id@joeyh.name>+ - Copyright 2013-2019 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -17,6 +17,16 @@ import Utility.Shell  import qualified Data.Map as M++-- Remove all hooks.+unHook :: Annex ()+unHook = do+	hookUnWrite preCommitHook+	hookUnWrite postReceiveHook+	hookUnWrite postCheckoutHook+	hookUnWrite postMergeHook+	hookUnWrite preCommitAnnexHook+	hookUnWrite postUpdateAnnexHook  preCommitHook :: Git.Hook preCommitHook = Git.Hook "pre-commit" (mkHookScript "git annex pre-commit .") []
Annex/Init.hs view
@@ -128,8 +128,8 @@  uninitialize :: Annex () uninitialize = do-	hookUnWrite preCommitHook-	hookUnWrite postReceiveHook+	unHook+	deconfigureSmudgeFilter 	removeRepoUUID 	removeVersion
Annex/Magic.hs view
@@ -17,6 +17,7 @@ ) where  import Types.Mime+import Control.Monad.IO.Class #ifdef WITH_MAGICMIME import Magic import Utility.Env@@ -52,8 +53,8 @@ getMagicMime _ _ = return Nothing #endif -getMagicMimeType :: Magic -> FilePath -> IO (Maybe MimeType)-getMagicMimeType m f = fmap fst <$> getMagicMime m f+getMagicMimeType :: MonadIO m => Magic -> FilePath -> m (Maybe MimeType)+getMagicMimeType m f = liftIO $ fmap fst <$> getMagicMime m f -getMagicMimeEncoding :: Magic -> FilePath -> IO (Maybe MimeEncoding)-getMagicMimeEncoding m f = fmap snd <$> getMagicMime m f+getMagicMimeEncoding :: MonadIO m => Magic -> FilePath -> m(Maybe MimeEncoding)+getMagicMimeEncoding m f = liftIO $ fmap snd <$> getMagicMime m f
Assistant/Threads/Cronner.hs view
@@ -132,7 +132,7 @@ 		tolate nowt tz = case mmaxt of 			Just maxt -> nowt > maxt 			-- allow the job to start 10 minutes late-			Nothing ->diffUTCTime +			Nothing -> diffUTCTime  				(localTimeToUTC tz nowt) 				(localTimeToUTC tz t) > 600 	run nowt = do
CHANGELOG view
@@ -1,3 +1,35 @@+git-annex (7.20191009) upstream; urgency=medium++  * Fix bug in handling of annex.largefiles that use largerthan/smallerthan.+    When adding a modified file, it incorrectly used the file size of the+    old version of the file, not the current size.+  * Added --mimetype and --mimeencoding file matching options.+  * Added --unlocked and --locked file matching options.+  * Added adjust --lock, to enter an adjusted branch where files are locked.+  * git-lfs: Added support for http basic auth.+  * git-lfs: Only do endpoint discovery once when concurrency is enabled.+  * fsck --incremental/--more: Fix bug that prevented the incremental fsck+    information from being updated every 5 minutes as it was supposed to be;+    it was only updated after 1000 files were checked, which may be more+    files that are possible to fsck in a given fsck time window.+    Thanks to Peter Simons for help with analysis of this bug.+  * Test: Use more robust directory removal when built with directory-1.2.7.+  * Close sqlite databases more robustly.+  * remotedaemon: Don't list --stop in help since it's not supported.+  * enable-tor: Run kdesu with -c option.+  * enable-tor: Use pkexec to run command as root when gksu and kdesu are not+    available.+  * When dropping an unlocked file, preserve its mtime, which avoids+    git status unncessarily running the clean filter on the file.+  * uninit: Remove several git hooks that git-annex init sets up.+  * uninit: Remove the smudge and clean filters that git-annex init sets up.+  * Work around git cat-file --batch's odd stripping of carriage return+    from the end of the line (some windows infection), avoiding crashing+    when the repo contains a filename ending in a carriage return.+  * git-annex-standalone.rpm: Fix the git-annex-shell symlink.++ -- Joey Hess <id@joeyh.name>  Wed, 09 Oct 2019 12:31:31 -0400+ git-annex (7.20190912) upstream; urgency=medium    * Default to v7 for new repositories.
@@ -10,6 +10,10 @@            © 2014 Sören Brunk License: AGPL-3+ +Files: doc/special_remotes/external/*+Copyright: © 2013 Joey Hess <id@joeyh.name>+License: GPL-3++ Files: Remote/Ddar.hs Copyright: © 2011 Joey Hess <id@joeyh.name>            © 2014 Robie Basak <robie@justgohome.co.uk>
CmdLine/GitAnnex/Options.hs view
@@ -282,6 +282,26 @@ 		<> help "match files accessed within a time interval" 		<> hidden 		)+	, globalSetter Limit.addMimeType $ strOption+		( long "mimetype" <> metavar paramGlob+		<> help "match files by mime type"+		<> hidden+		)+	, globalSetter Limit.addMimeEncoding $ strOption+		( long "mimeencoding" <> metavar paramGlob+		<> help "match files by mime encoding"+		<> hidden+		)+	, globalFlag Limit.addUnlocked+		( long "unlocked"+		<> help "match files that are unlocked"+		<> hidden+		)+	, globalFlag Limit.addLocked+		( long "locked"+		<> help "match files that are locked"+		<> hidden+		) 	]  -- Options to match files which may not yet be annexed.@@ -387,16 +407,20 @@ 	, stopDaemonOption :: Bool 	} -parseDaemonOptions :: Parser DaemonOptions-parseDaemonOptions = DaemonOptions-	<$> switch+parseDaemonOptions :: Bool -> Parser DaemonOptions+parseDaemonOptions canstop+	| canstop = DaemonOptions <$> foreground <*> stop+	| otherwise = DaemonOptions <$> foreground <*> pure False+  where+	foreground = switch 		( long "foreground" 		<> help "do not daemonize" 		)-	<*> switch+	stop = switch 		( long "stop" 		<> help "stop daemon" 		)+ completeRemotes :: HasCompleter f => Mod f a completeRemotes = completer $ mkCompleter $ \input -> do 	r <- maybe (pure Nothing) (Just <$$> Git.Config.read)
Command/Adjust.hs view
@@ -26,6 +26,10 @@ 		( long "unlock" 		<> help "unlock annexed files" 		)+	<|> flag' LockAdjustment+		( long "lock"+		<> help "lock annexed files"+		) 	<|> flag' FixAdjustment 		( long "fix" 		<> help "fix symlinks to annnexed files"
Command/Assistant.hs view
@@ -34,7 +34,7 @@  optParser :: CmdParamsDesc -> Parser AssistantOptions optParser _ = AssistantOptions-	<$> parseDaemonOptions+	<$> parseDaemonOptions True 	<*> switch 		( long "autostart" 		<> help "start in known repositories"
Command/RemoteDaemon.hs view
@@ -15,9 +15,9 @@  cmd :: Command cmd = noCommit $-	command "remotedaemon" SectionMaintenance+	command "remotedaemon" SectionCommon 		"persistent communication with remotes"-		paramNothing (run <$$> const parseDaemonOptions)+		paramNothing (run <$$> const (parseDaemonOptions False))  run :: DaemonOptions -> CommandSeek run o
Command/Watch.hs view
@@ -15,7 +15,7 @@ cmd = notBareRepo $ 	command "watch" SectionCommon  		"watch for changes and autocommit"-		paramNothing (seek <$$> const parseDaemonOptions)+		paramNothing (seek <$$> const (parseDaemonOptions True))  seek :: DaemonOptions -> CommandSeek seek o = commandAction $ start False o Nothing
Config/Smudge.hs view
@@ -1,6 +1,6 @@ {- Git smudge filter configuration  -- - Copyright 2011-2018 Joey Hess <id@joeyh.name>+ - Copyright 2011-2019 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -32,10 +32,25 @@ 	gfs <- readattr gf 	liftIO $ unless ("filter=annex" `isInfixOf` (lfs ++ gfs)) $ do 		createDirectoryIfMissing True (takeDirectory lf)-		writeFile lf (lfs ++ "\n" ++ stdattr)+		writeFile lf (lfs ++ "\n" ++ unlines stdattr)   where 	readattr = liftIO . catchDefaultIO "" . readFileStrict-	stdattr = unlines-		[ "* filter=annex"-		, ".* !filter"-		]++stdattr :: [String]+stdattr =+	[ "* filter=annex"+	, ".* !filter"+	]++-- Note that this removes the local git attributes for filtering, +-- which is what git-annex installed, but it does not change anything+-- that may have been committed to a .gitattributes in the repository.+-- git-annex does not commit that.+deconfigureSmudgeFilter :: Annex ()+deconfigureSmudgeFilter = do+	lf <- Annex.fromRepo Git.attributesLocal+	ls <- liftIO $ catchDefaultIO [] $ lines <$> readFileStrict lf+	liftIO $ writeFile lf $ unlines $+		filter (\l -> l `notElem` stdattr && not (null l)) ls+	unsetConfig (ConfigKey "filter.annex.smudge")+	unsetConfig (ConfigKey "filter.annex.clean")
Database/Fsck.hs view
@@ -83,7 +83,7 @@ 		| sz > 1000 = return True 		| otherwise = do 			now <- getCurrentTime-			return $ diffUTCTime lastcommittime now > 300+			return $ diffUTCTime now lastcommittime > 300  {- Doesn't know about keys that were just added with addDb. -} inDb :: FsckHandle -> Key -> IO Bool
Database/Handle.hs view
@@ -1,10 +1,12 @@ {- Persistent sqlite database handles.  -- - Copyright 2015-2018 Joey Hess <id@joeyh.name>+ - Copyright 2015-2019 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE TypeFamilies, FlexibleContexts #-}+ module Database.Handle ( 	DbHandle, 	DbConcurrency(..),@@ -23,6 +25,8 @@ import qualified Database.Sqlite as Sqlite import Control.Monad import Control.Monad.IO.Class (liftIO)+import Control.Monad.IO.Unlift (MonadUnliftIO, withRunInIO)+import Control.Monad.Logger (MonadLogger) import Control.Concurrent import Control.Concurrent.Async import Control.Exception (throwIO, BlockedIndefinitelyOnMVar(..))@@ -193,7 +197,7 @@ 	 	go conn retries = do 		r <- try $ runResourceT $ runNoLoggingT $-			withSqlConn (wrapConnection conn) $+			withSqlConnRobustly (wrapConnection conn) $ 				runSqlConn a 		case r of 			Right v -> return v@@ -237,3 +241,46 @@ 	nullselect = T.pack $ "SELECT null from " ++ tablename ++ " limit 1"  	briefdelay = threadDelay 1000 -- 1/1000th second++-- Like withSqlConn, but more robust.+withSqlConnRobustly+	 :: (MonadUnliftIO m, MonadLogger m, IsPersistBackend backend, BaseBackend backend ~ SqlBackend)+	 => (LogFunc -> IO backend)+	 -> (backend -> m a)+	 -> m a+withSqlConnRobustly open f = do+	logFunc <- askLogFunc+	withRunInIO $ \run -> bracket+		(open logFunc)+		closeRobustly+		(run . f)++-- Sqlite can throw ErrorBusy while closing a database; this catches+-- the exception and retries.+closeRobustly+	 :: (IsPersistBackend backend, BaseBackend backend ~ SqlBackend)+	 => backend+	-> IO ()+closeRobustly conn = go maxretries briefdelay+  where+	briefdelay = 1000 -- 1/1000th second++	-- Try up to 14 times; with the delay doubling each time,+	-- the maximum delay before giving up is 16 seconds.+	maxretries = 14 :: Int++	go retries delay = do+		r <- try $ close' conn+		case r of+			Right () -> return ()+			Left ex@(Sqlite.SqliteException { Sqlite.seError = e })+				| e == Sqlite.ErrorBusy -> do+					threadDelay delay+					let delay' = delay * 2+					let retries' = retries - 1+					if retries' < 1+						then rethrow "while closing database connection" ex+						else go retries' delay'+				| otherwise -> rethrow "while closing database connection" ex+	+	rethrow msg e = throwIO $ userError $ show e ++ "(" ++ msg ++ ")"
Database/Keys/SQL.hs view
@@ -57,7 +57,7 @@ 		| sz > 1000 = return True 		| otherwise = do 			now <- getCurrentTime-			return $ diffUTCTime lastcommittime now > 300+			return $ diffUTCTime now lastcommittime > 300  addAssociatedFile :: IKey -> TopFilePath -> WriteHandle -> IO () addAssociatedFile ik f = queueDb $ do
Git/AutoCorrect.hs view
@@ -40,13 +40,14 @@ 	similarEnough (_, cst) = cst < similarityFloor  {- Takes action based on git's autocorrect configuration, in preparation for- - an autocorrected command being run. -}+ - an autocorrected command being run.+ -} prepare :: String -> (c -> String) -> [c] -> Maybe Repo -> IO () prepare input showmatch matches r = 	case readish . Git.Config.get "help.autocorrect" "0" =<< r of 		Just n 			| n == 0 -> list-			| n < 0 -> warn+			| n < 0 -> warn Nothing 			| otherwise -> sleep n 		Nothing -> list   where@@ -55,17 +56,16 @@ 		, "" 		, "Did you mean one of these?" 		] ++ map (\m -> "\t" ++ showmatch m) matches-	warn = -		hPutStr stderr $ unlines-			[ "WARNING: You called a command named '" ++-			  input ++ "', which does not exist."-			, "Continuing under the assumption that you meant '" ++-			  showmatch (Prelude.head matches) ++ "'"-			]+	warn :: Maybe Float -> IO ()+	warn mdelaysec = hPutStr stderr $ unlines+		[ "WARNING: You called a git-annex command named '" +++		  input ++ "', which does not exist."+		, case mdelaysec of+			Nothing -> "Continuing under the assumption that you meant " ++ match+			Just sec -> "Continuing in " ++ show sec ++ " seconds, assuming that you meant " ++ match+		]+	  where+		match = "'" ++ showmatch (Prelude.head matches) ++ "'." 	sleep n = do-		warn-		hPutStrLn stderr $ unwords-			[ "in"-			, show (fromIntegral n / 10 :: Float)-			, "seconds automatically..."]+		warn (Just (fromIntegral n / 10 :: Float)) 		threadDelay (n * 100000) -- deciseconds to microseconds
Git/CatFile.hs view
@@ -132,6 +132,10 @@ 	-- filename itself contains a newline, have to fall back to another 	-- method of getting the information. 	| '\n' `elem` s = newlinefallback+	-- git strips carriage return from the end of a line, out of some+	-- misplaced desire to support windows, so also use the newline+	-- fallback for those.+	| "\r" `isSuffixOf` s = newlinefallback 	| otherwise = CoProcess.query hdl send receive   where 	send to = hPutStrLn to s
+ Git/Credential.hs view
@@ -0,0 +1,64 @@+{- git credential interface+ -+ - Copyright 2019 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Git.Credential where++import Common+import Git+import Git.Command+import Utility.Url++import qualified Data.Map as M++data Credential = Credential { fromCredential :: M.Map String String }++credentialUsername :: Credential -> Maybe String+credentialUsername = M.lookup "username" . fromCredential++credentialPassword :: Credential -> Maybe String+credentialPassword = M.lookup "password" . fromCredential++-- | This may prompt the user for login information, or get cached login+-- information.+getUrlCredential :: URLString -> Repo -> IO Credential+getUrlCredential = runCredential "fill" . urlCredential++-- | Call if the credential the user entered works, and can be cached for+-- later use if git is configured to do so.+approveUrlCredential :: Credential -> Repo -> IO ()+approveUrlCredential c = void . runCredential "approve" c++-- | Call if the credential the user entered does not work.+rejectUrlCredential :: Credential -> Repo -> IO ()+rejectUrlCredential c = void . runCredential "reject" c++urlCredential :: URLString -> Credential+urlCredential = Credential . M.singleton "url"++runCredential :: String -> Credential -> Repo -> IO Credential+runCredential action input r =+	parseCredential <$> pipeWriteRead +		[ Param "credential"+		, Param action+		]+		(Just (flip hPutStr formatinput))+		r+  where+	formatinput = concat+		[ formatCredential input+		, "\n" -- blank line signifies end of input+		]++formatCredential :: Credential -> String+formatCredential = unlines . map (\(k, v) -> k ++"=" ++ v) . M.toList . fromCredential++parseCredential :: String -> Credential+parseCredential = Credential . M.fromList . map go . lines+  where+	go l = case break (== '=') l of+		(k, _:v) -> (k, v)+		(k, []) -> (k, "")
Limit.hs view
@@ -1,6 +1,6 @@ {- user-specified limits on files to act on  -- - Copyright 2011-2017 Joey Hess <id@joeyh.name>+ - Copyright 2011-2019 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -16,6 +16,7 @@ import Annex.Action import Annex.UUID import Annex.Magic+import Annex.Link import Logs.Trust import Annex.NumCopies import Types.Key@@ -37,6 +38,10 @@ import qualified Data.Set as S import qualified Data.Map as M +{- Some limits can look at the current status of files on+ - disk, or in the annex. This allows controlling which happens. -}+data LimitBy = LimitDiskFiles | LimitAnnexFiles+ {- Checks if there are user-specified limits. -} limited :: Annex Bool limited = (not . Utility.Matcher.isEmpty) <$> getMatcher'@@ -94,12 +99,33 @@ 	go (MatchingKey _ (AssociatedFile Nothing)) = pure False 	go (MatchingKey _ (AssociatedFile (Just af))) = pure $ matchGlob cglob af -matchMagic :: String -> (Magic -> FilePath -> IO (Maybe String)) -> (ProvidedInfo -> OptInfo String) -> Maybe Magic -> MkLimit Annex+addMimeType :: String -> Annex ()+addMimeType = addMagicLimit "mimetype" getMagicMimeType providedMimeType++addMimeEncoding :: String -> Annex ()+addMimeEncoding = addMagicLimit "mimeencoding" getMagicMimeEncoding providedMimeEncoding++addMagicLimit :: String -> (Magic -> FilePath -> Annex (Maybe String)) -> (ProvidedInfo -> OptInfo String) -> String -> Annex ()+addMagicLimit limitname querymagic selectprovidedinfo glob = do+	magic <- liftIO initMagicMime+	addLimit $ matchMagic limitname querymagic' selectprovidedinfo magic glob+  where+	querymagic' magic f = liftIO (isPointerFile f) >>= \case+		-- Avoid getting magic of a pointer file, which would+		-- wrongly be detected as text.+		Just _ -> return Nothing+		-- When the file is an annex symlink, get magic of the+		-- object file.+		Nothing -> isAnnexLink f >>= \case+			Just k -> withObjectLoc k $ querymagic magic+			Nothing -> querymagic magic f++matchMagic :: String -> (Magic -> FilePath -> Annex (Maybe String)) -> (ProvidedInfo -> OptInfo String) -> Maybe Magic -> MkLimit Annex matchMagic _limitname querymagic selectprovidedinfo (Just magic) glob = Right $ const go   where  	cglob = compileGlob glob CaseSensative -- memoized 	go (MatchingKey _ _) = pure False-	go (MatchingFile fi) = liftIO $ catchBoolIO $+	go (MatchingFile fi) = catchBoolIO $ 		maybe False (matchGlob cglob) 			<$> querymagic magic (currFile fi) 	go (MatchingInfo p) =@@ -107,6 +133,22 @@ matchMagic limitname _ _ Nothing _ =  	Left $ "unable to load magic database; \""++limitname++"\" cannot be used" +addUnlocked :: Annex ()+addUnlocked = addLimit $ Right $ const $ matchLockStatus False++addLocked :: Annex ()+addLocked = addLimit $ Right $ const $ matchLockStatus True++matchLockStatus :: Bool -> MatchInfo -> Annex Bool+matchLockStatus _ (MatchingKey _ _) = pure False+matchLockStatus _ (MatchingInfo _) = pure False+matchLockStatus wantlocked (MatchingFile fi) = liftIO $ do+	islocked <- isPointerFile (currFile fi) >>= \case+		Just _key -> return False+		Nothing -> isSymbolicLink+			<$> getSymbolicLinkStatus (currFile fi)+	return (islocked == wantlocked)+ {- Adds a limit to skip files not believed to be present  - in a specfied repository. Optionally on a prior date. -} addIn :: String -> Annex ()@@ -264,26 +306,28 @@  {- Adds a limit to skip files that are too large or too small -} addLargerThan :: String -> Annex ()-addLargerThan = addLimit . limitSize (>)+addLargerThan = addLimit . limitSize LimitAnnexFiles (>)  addSmallerThan :: String -> Annex ()-addSmallerThan = addLimit . limitSize (<)+addSmallerThan = addLimit . limitSize LimitAnnexFiles (<) -limitSize :: (Maybe Integer -> Maybe Integer -> Bool) -> MkLimit Annex-limitSize vs s = case readSize dataUnits s of+limitSize :: LimitBy -> (Maybe Integer -> Maybe Integer -> Bool) -> MkLimit Annex+limitSize lb vs s = case readSize dataUnits s of 	Nothing -> Left "bad size" 	Just sz -> Right $ go sz   where-	go sz _ (MatchingFile fi) = lookupFileKey fi >>= check fi sz+	go sz _ (MatchingFile fi) = case lb of+		LimitAnnexFiles -> lookupFileKey fi >>= \case+			Just key -> checkkey sz key+			Nothing -> return False+		LimitDiskFiles -> do+			filesize <- liftIO $ catchMaybeIO $ getFileSize (currFile fi)+			return $ filesize `vs` Just sz 	go sz _ (MatchingKey key _) = checkkey sz key 	go sz _ (MatchingInfo p) = 		getInfo (providedFileSize p)  			>>= \sz' -> return (Just sz' `vs` Just sz) 	checkkey sz key = return $ keySize key `vs` Just sz-	check _ sz (Just key) = checkkey sz key-	check fi sz Nothing = do-		filesize <- liftIO $ catchMaybeIO $ getFileSize (currFile fi)-		return $ filesize `vs` Just sz  addMetaData :: String -> Annex () addMetaData = addLimit . limitMetaData
Remote/GitLFS.hs view
@@ -17,6 +17,7 @@ import qualified Git.Types as Git import qualified Git.Url import qualified Git.GCrypt+import qualified Git.Credential as Git import Config import Config.Cost import Remote.Helper.Special@@ -42,6 +43,7 @@ import qualified Data.ByteString.Lazy as L import qualified Data.Text as T import qualified Data.Text.Encoding as E+import qualified Control.Concurrent.MSemN as MSemN  remote :: RemoteType remote = RemoteType@@ -64,7 +66,8 @@ 			g <- Annex.gitRepo 			liftIO $ Git.GCrypt.encryptedRemote g r 		else pure r-	h <- liftIO $ newTVarIO $ LFSHandle Nothing Nothing r' gc+	sem <- liftIO $ MSemN.new 1+	h <- liftIO $ newTVarIO $ LFSHandle Nothing Nothing sem r' gc 	cst <- remoteCost gc expensiveRemoteCost 	return $ Just $ specialRemote' specialcfg c 		(simplyPrepare $ store u h)@@ -159,31 +162,34 @@ data LFSHandle = LFSHandle 	{ downloadEndpoint :: Maybe LFS.Endpoint 	, uploadEndpoint :: Maybe LFS.Endpoint+	, getEndPointLock :: MSemN.MSemN Int  	, remoteRepo :: Git.Repo 	, remoteGitConfig :: RemoteGitConfig 	} +-- Only let one thread at a time do endpoint discovery.+withEndPointLock :: LFSHandle -> Annex a -> Annex a+withEndPointLock h = bracket_+	(liftIO $ MSemN.wait l 1)+	(liftIO $ MSemN.signal l 1)+  where+	l = getEndPointLock h+ discoverLFSEndpoint :: LFS.TransferRequestOperation -> LFSHandle -> Annex (Maybe LFS.Endpoint) discoverLFSEndpoint tro h 	| Git.repoIsSsh r = gossh 	| Git.repoIsHttp r = gohttp-	| otherwise = do-		warning "git-lfs endpoint has unsupported URI scheme"-		return Nothing+	| otherwise = unsupportedurischeme   where   	r = remoteRepo h 	lfsrepouri = case Git.location r of 		Git.Url u -> u 		_ -> giveup $ "unsupported git-lfs remote location " ++ Git.repoLocation r-	gohttp = case tro of-		LFS.RequestDownload -> return $ LFS.guessEndpoint lfsrepouri-		LFS.RequestUpload -> do-			-- git-lfs does support storing over http,-			-- but it would need prompting for http basic-			-- authentication each time git-annex discovered-			-- the endpoint.-			warning "Storing content in git-lfs currently needs a ssh repository url, not http."-			return Nothing+	+	unsupportedurischeme = do+		warning "git-lfs endpoint has unsupported URI scheme"+		return Nothing+	 	gossh = case mkSshHost <$> Git.Url.hostuser r of 		Nothing -> do 			warning "Unable to parse ssh url for git-lfs remote."@@ -216,14 +222,56 @@ 						warning $ "unexpected response from git-lfs remote when doing ssh endpoint discovery" 						return Nothing 					Just endpoint -> return (Just endpoint)+	+	-- The endpoint may or may not need http basic authentication,+	-- which involves using git-credential to prompt for the password.+	--+	-- To determine if it does, make a download or upload request to+	-- it, not including any objects in the request, and see if+	-- the server requests authentication.+	gohttp = case LFS.guessEndpoint lfsrepouri of+		Nothing -> unsupportedurischeme+		Just endpoint -> do+			let testreq = LFS.startTransferRequest endpoint transfernothing+			flip catchNonAsync (const (returnendpoint endpoint)) $ do+				resp <- makeSmallAPIRequest testreq+				if needauth (responseStatus resp)+					then do+						cred <- prompt $ inRepo $ Git.getUrlCredential (show lfsrepouri)+						let endpoint' = addbasicauth cred endpoint+						let testreq' = LFS.startTransferRequest endpoint' transfernothing+						flip catchNonAsync (const (returnendpoint endpoint')) $ do+						resp' <- makeSmallAPIRequest testreq'+						inRepo $ if needauth (responseStatus resp')+							then Git.rejectUrlCredential cred+							else Git.approveUrlCredential cred+						returnendpoint endpoint'+					else returnendpoint endpoint+	  where+	  	transfernothing = LFS.TransferRequest+			{ LFS.req_operation = tro+			, LFS.req_transfers = [LFS.Basic]+			, LFS.req_ref = Nothing+			, LFS.req_objects = []+			}+		returnendpoint = return . Just +		needauth status = status == unauthorized401++		addbasicauth cred endpoint =+			case (Git.credentialUsername cred, Git.credentialPassword cred) of+				(Just u, Just p) ->+					LFS.modifyEndpointRequest endpoint $+						applyBasicAuth (encodeBS u) (encodeBS p)+				_ -> endpoint+ -- The endpoint is cached for later use. getLFSEndpoint :: LFS.TransferRequestOperation -> TVar LFSHandle -> Annex (Maybe LFS.Endpoint) getLFSEndpoint tro hv = do 	h <- liftIO $ atomically $ readTVar hv 	case f h of 		Just endpoint -> return (Just endpoint)-		Nothing -> discoverLFSEndpoint tro h >>= \case+		Nothing -> withEndPointLock h $ discoverLFSEndpoint tro h >>= \case 			Just endpoint -> do 				liftIO $ atomically $ writeTVar hv $ 					case tro of@@ -256,16 +304,14 @@ 	=> LFS.TransferRequest 	-> LFS.Endpoint 	-> Annex (Either String (LFS.TransferResponse op))-sendTransferRequest req endpoint = -	case LFS.startTransferRequest endpoint req of-		Just httpreq -> do-			httpresp <- makeSmallAPIRequest $ setRequestCheckStatus httpreq-			return $ case LFS.parseTransferResponse (responseBody httpresp) of-				LFS.ParsedTransferResponse resp -> Right resp-				LFS.ParsedTransferResponseError tro -> Left $-					T.unpack $ LFS.resperr_message tro-				LFS.ParseFailed err -> Left err-		Nothing -> return $ Left "unable to parse git-lfs endpoint url"+sendTransferRequest req endpoint = do+	let httpreq = LFS.startTransferRequest endpoint req+	httpresp <- makeSmallAPIRequest $ setRequestCheckStatus httpreq+	return $ case LFS.parseTransferResponse (responseBody httpresp) of+		LFS.ParsedTransferResponse resp -> Right resp+		LFS.ParsedTransferResponseError tro -> Left $+			T.unpack $ LFS.resperr_message tro+		LFS.ParseFailed err -> Left err  extractKeySha256 :: Key -> Maybe LFS.SHA256 extractKeySha256 k = case keyVariety k of@@ -409,9 +455,8 @@ 		-- Unable to find enough information to request the key 		-- from git-lfs, so it's not present there. 		Nothing -> return False-		Just (req, sha256, size) -> case LFS.startTransferRequest endpoint req of-			Nothing -> giveup "unable to parse git-lfs endpoint url"-			Just httpreq -> go sha256 size =<< makeSmallAPIRequest httpreq+		Just (req, sha256, size) -> go sha256 size +			=<< makeSmallAPIRequest (LFS.startTransferRequest endpoint req)   where 	go sha256 size httpresp 		| responseStatus httpresp == status200 = go' sha256 size $
Test/Framework.hs view
@@ -5,6 +5,8 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE CPP #-}+ module Test.Framework where  import Test.Tasty@@ -223,26 +225,33 @@ 	Utility.Env.Set.setEnv "GIT_CONFIG_NOSYSTEM" "1" True 	a +removeDirectoryForCleanup :: FilePath -> IO ()+#if MIN_VERSION_directory(1,2,7)+removeDirectoryForCleanup = removePathForcibly+#else+removeDirectoryForCleanup = removeDirectoryRecursive+#endif+ cleanup :: FilePath -> IO () cleanup dir = whenM (doesDirectoryExist dir) $ do 	Command.Uninit.prepareRemoveAnnexDir' dir 	-- This can fail if files in the directory are still open by a 	-- subprocess.-	void $ tryIO $ removeDirectoryRecursive dir+	void $ tryIO $ removeDirectoryForCleanup dir  finalCleanup :: IO () finalCleanup = whenM (doesDirectoryExist tmpdir) $ do 	Annex.Action.reapZombies 	Command.Uninit.prepareRemoveAnnexDir' tmpdir-	catchIO (removeDirectoryRecursive tmpdir) $ \e -> do+	catchIO (removeDirectoryForCleanup tmpdir) $ \e -> do 		print e 		putStrLn "sleeping 10 seconds and will retry directory cleanup" 		Utility.ThreadScheduler.threadDelaySeconds $ 			Utility.ThreadScheduler.Seconds 10 		whenM (doesDirectoryExist tmpdir) $ do 			Annex.Action.reapZombies-			removeDirectoryRecursive tmpdir-	+			removeDirectoryForCleanup tmpdir+ checklink :: FilePath -> Assertion checklink f = ifM (annexeval Config.crippledFileSystem) 	( (isJust <$> annexeval (Annex.Link.getAnnexLinkTarget f))
Types/AdjustedBranch.hs view
@@ -39,7 +39,8 @@  instance ReversableAdjustment LinkAdjustment where 	reverseAdjustment UnlockAdjustment = LockAdjustment-	reverseAdjustment LockAdjustment = UnlockAdjustment+	-- Keep the file locked intentionally when reversing LockAdjustment.+	reverseAdjustment LockAdjustment = LockAdjustment 	reverseAdjustment FixAdjustment = UnFixAdjustment 	reverseAdjustment UnFixAdjustment = FixAdjustment
Utility/GitLFS.hs view
@@ -7,18 +7,29 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +-- | This implementation of the git-lfs API uses http Request and Response,+-- but leaves actually connecting up the http client to the user.+--+-- You'll want to use a Manager that supports https, since the protocol+-- uses http basic auth.+--+-- Some LFS servers, notably Github's, may require a User-Agent header+-- in some of the requests, in order to allow eg, uploads. No such header+-- is added by default, so be sure to add your own.+ {-# LANGUAGE DeriveGeneric, FlexibleInstances, FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE LambdaCase #-}  module Utility.GitLFS (-	-- * transfer requests+	-- * Transfer requests 	TransferRequest(..), 	TransferRequestOperation(..), 	TransferAdapter(..), 	TransferRequestObject(..), 	startTransferRequest,-	-- * responses to transfer requests++	-- * Responses to transfer requests 	TransferResponse(..), 	TransferResponseOperation(..), 	IsTransferResponseOperation,@@ -27,19 +38,23 @@ 	OperationParams(..), 	ParsedTransferResponse(..), 	parseTransferResponse,-	-- * making transfers++	-- * Making transfers 	downloadOperationRequest, 	uploadOperationRequests,-	-- * endpoint discovery++	-- * Endpoint discovery 	Endpoint, 	guessEndpoint,-	HostUser,+	modifyEndpointRequest, 	sshDiscoverEndpointCommand, 	parseSshDiscoverEndpointResponse,-	-- * errors++	-- * Errors 	TransferResponseError(..), 	TransferResponseObjectError(..),-	-- * additional data types++	-- * Additional data types 	Url, 	SHA256, 	GitRef(..),@@ -48,16 +63,6 @@ 	HTTPHeaderValue, ) where --- | This implementation of the git-lfs API uses http Request and Response,--- but leaves actually connecting up the http client to the user.------ You'll want to use a Manager that supports https, since the protocol--- uses http basic auth.------ Some LFS servers, notably Github's, may require a User-Agent header--- in some of the requests, in order to allow eg, uploads. No such header--- is added by dedault, so be sure to add your own.- import Data.Aeson import Data.Aeson.Types import GHC.Generics@@ -278,9 +283,7 @@ type SHA256 = T.Text  -- | The endpoint of a git-lfs server.-data Endpoint-	= EndpointURI URI.URI-	| EndpointDiscovered SshDiscoveryResponse+data Endpoint = Endpoint Request 	deriving (Show)  -- | Command to run via ssh with to discover an endpoint. The FilePath is@@ -298,20 +301,41 @@ 		RequestUpload -> "upload" 	] +-- Internal smart constructor for an Endpoint.+-- +-- Since this uses the LFS batch API, it adds /objects/batch+-- to the endpoint url. It also adds the necessary headers to use JSON.+mkEndpoint :: URI.URI -> Maybe Endpoint+mkEndpoint uri = do+	r <- requestFromURI uri+	let r' = addLfsJsonHeaders $ r { path = path r <> "/objects/batch" }+	return (Endpoint r')+ -- | Parse the json output when doing ssh endpoint discovery. parseSshDiscoverEndpointResponse :: L.ByteString -> Maybe Endpoint-parseSshDiscoverEndpointResponse resp = EndpointDiscovered <$> decode resp+parseSshDiscoverEndpointResponse resp = do+	sr <- decode resp+	uri <- URI.parseURI (T.unpack (endpoint_href sr))+	endpoint <- mkEndpoint uri+	return $ modifyEndpointRequest endpoint $ case endpoint_header sr of+		Nothing -> id+		Just headers ->+			let headers' = map convheader (M.toList headers)+			in \req -> req+				{ requestHeaders = requestHeaders req ++ headers' }+  where+	convheader (k, v) = (CI.mk (E.encodeUtf8 k), E.encodeUtf8 v)  -- | Guesses the LFS endpoint from the http url of a git remote. -- -- https://github.com/git-lfs/git-lfs/blob/master/docs/api/server-discovery.md guessEndpoint :: URI.URI -> Maybe Endpoint guessEndpoint uri = case URI.uriScheme uri of-	"https:" -> Just endpoint-	"http:" -> Just endpoint+	"https:" -> endpoint+	"http:" -> endpoint 	_ -> Nothing   where-	endpoint = EndpointURI $ uri+	endpoint = mkEndpoint $ uri 		-- force https because the git-lfs protocol uses http 		-- basic auth tokens, which should not be exposed 		{ URI.uriScheme = "https:"@@ -327,28 +351,22 @@ 	 	droptrailing c = reverse . dropWhile (== c) . reverse +-- | When an Endpoint is used to generate a Request, this allows adjusting+-- that Request.+--+-- This can be used to add http basic authentication to an Endpoint:+--+-- > modifyEndpointRequest (guessEndpoint u) (applyBasicAuth "user" "pass")+modifyEndpointRequest :: Endpoint -> (Request -> Request) -> Endpoint+modifyEndpointRequest (Endpoint r) f = Endpoint (f r)+ -- | Makes a Request that will start the process of making a transfer to or -- from the LFS endpoint.-startTransferRequest :: Endpoint -> TransferRequest -> Maybe Request-startTransferRequest (EndpointURI uri) tr = do-	r <- requestFromURI uri-	return $ addLfsJsonHeaders $ r-		-- Since this uses the LFS batch API, it adds /objects/batch-		-- to the endpoint url.-		{ path = path r <> "/objects/batch"-		, method = "POST"-		, requestBody = RequestBodyLBS (encode tr)-		}-startTransferRequest (EndpointDiscovered sr) tr = do-	uri <- URI.parseURI (T.unpack (endpoint_href sr))-	req <- startTransferRequest (EndpointURI uri) tr-	let headers = map convheader $ maybe [] M.toList $ endpoint_header sr-	return $ req { requestHeaders = requestHeaders req ++ headers }-  where-	convheader (k, v) = (CI.mk (E.encodeUtf8 k), E.encodeUtf8 v)---- | "user@host" or just the hostname.-type HostUser = String+startTransferRequest :: Endpoint -> TransferRequest -> Request+startTransferRequest (Endpoint r) tr = r+	{ method = "POST"+	, requestBody = RequestBodyLBS (encode tr)+	}  addLfsJsonHeaders :: Request -> Request addLfsJsonHeaders r = r
Utility/Su.hs view
@@ -76,7 +76,9 @@ 		[ SuCommand (MayPromptPassword SomePassword) "gksu" 			[Param shellcmd] 		, SuCommand (MayPromptPassword SomePassword) "kdesu"-			[Param shellcmd]+			[Param "-c", Param shellcmd]+		, SuCommand (MayPromptPassword SomePassword) "pkexec"+			([Param cmd] ++ ps) 		-- Available in Debian's menu package; knows about lots of 		-- ways to gain root. 		, SuCommand (MayPromptPassword SomePassword) "su-to-root"
doc/git-annex-adjust.mdwn view
@@ -4,7 +4,7 @@  # SYNOPSIS -git annex adjust `--unlock|--fix|--hide-missing [--unlock|--fix]`+git annex adjust `--unlock|--lock|--fix|--hide-missing [--unlock|--lock|--fix]`  # DESCRIPTION @@ -49,6 +49,20 @@   disk space, any modification made to a file will cause the old version of the   file to be lost from the local repository. So, enable annex.thin with care. +  When in an adjusted unlocked branch, `git annex add` will add files+  unlocked instead of the default behavior of adding them locked.++* `--lock`++  Lock all annexed file in the adjusted branch. This may be preferred+  by those who like seeing broken symlinks when the content of an+  annexed file is not present.++  When in an adjusted locked branch, `git annex add` will add files locked,+  as usual. However, `git add` (and `git commit -a` etc) still add files+  unlocked. This is because it's not possible for those git commands to+  add files locked.+ * `--fix`    Fix the symlinks to annexed files to point to the local git annex@@ -74,7 +88,7 @@   still operate on them, and can be used to download missing   files from remotes. -  This option can be combined with --unlock or --fix.+  This option can be combined with --unlock, --lock, or --fix.  # SEE ALSO
doc/git-annex-copy.mdwn view
@@ -69,7 +69,7 @@  * `--key=keyname` -  Use this option to move a specified key.+  Use this option to copy a specified key.  * file matching options
doc/git-annex-matching-options.mdwn view
@@ -159,6 +159,43 @@   If the OS or filesystem does not support access times, this will not   match any files. +* `--unlocked`++  Matches annexed files that are unlocked.++* `--locked`++  Matches annexed files that are locked.++* `--mimetype=glob`++  Looks up the MIME type of a file, and checks if the glob matches it.++  For example, `--mimetype="text/*"` will match many varieties of text files,+  including "text/plain", but also "text/x-shellscript", "text/x-makefile",+  etc.++  The MIME types are the same that are displayed by running `file --mime-type`++  If the file's annexed content is not present, the file will not match.++  This is only available to use when git-annex was built with the+  MagicMime build flag.++* `--mimeencoding=glob`++  Looks up the MIME encoding of a file, and checks if the glob matches it.++  For example, `--mimeencoding=binary` will match many kinds of binary+  files.++  The MIME encodings are the same that are displayed by running `file --mime-encoding`++  If the file's annexed content is not present, the file will not match.++  This is only available to use when git-annex was built with the+  MagicMime build flag.+ * `--not`    Inverts the next matching option. For example, to only act on
doc/git-annex-remotedaemon.mdwn view
@@ -9,20 +9,15 @@ # DESCRIPTION  The remotedaemon provides persistent communication with remotes.-It detects when git branches on remotes have changes, and fetches-the changes from them. -The assistant runs the remotedaemon and communicates with it on-stdio using a simple textual protocol.- Several types of remotes are supported:  For ssh remotes, the remotedaemon tries to maintain a connection to the remote git repository, and uses git-annex-shell notifychanges to detect-when the remote git repository has changed. For this to work, the git-remote must have [[git-annex-shell]](1) installed, with notifychanges-support. The first version of git-annex-shell that supports it is-5.20140405.+when the remote git repository has changed, and fetches changes from it.+For this to work, the git remote must have [[git-annex-shell]](1)+installed, with notifychanges support. The first version of git-annex-shell+that supports it is 5.20140405.  For tor-annex remotes, the remotedaemon runs a tor hidden service, accepting connections from other nodes and serving up the contents of the
doc/git-annex.mdwn view
@@ -197,6 +197,12 @@    See [[git-annex-webapp]](1) for details. +* `remotedaemon`++  Persistant communication with remotes.++  See [[git-annex-remotedaemon]](1) for details.+ # REPOSITORY SETUP COMMANDS  * `init [description]`@@ -687,12 +693,6 @@    See [[git-annex-smudge]](1) for details. -* `remotedaemon`--  Detects when network remotes have received git pushes and fetches from them.--  See [[git-annex-remotedaemon]](1) for details.- * `findref [ref]`    Lists files in a git ref. (deprecated)@@ -868,7 +868,7 @@   the repository that use insecure hashes.    To configure the behavior in new clones of the repository,-  this can be set in [[git-annex-config]].+  this can be set using [[git-annex-config]].  * `annex.maxextensionlength` @@ -906,8 +906,11 @@ * `annex.addunlocked`    Set to true to make commands like `git-annex add` that add files to the-  repository add them in unlocked form. The default is to add files in-  locked form.+  repository add them in unlocked form. The default is for these commands+  to add files in locked form. +  +  (Using `git add` always adds files in unlocked form and it is not+  affected by this setting.)    When a repository has core.symlinks set to false, it implicitly   sets annex.addunlocked to true.@@ -941,7 +944,7 @@   This controls which refs `git-annex unused` considers to be used.   See REFSPEC FORMAT in [[git-annex-unused]](1) for details. -* `annex.jobs+* `annex.jobs`    Configure the number of concurrent jobs to run. Default is 1. @@ -1051,14 +1054,14 @@   and the git-annex post-receive hook.    To configure the behavior in all clones of the repository,-  this can be set in [[git-annex-config]].+  this can be set in [[git-annex-config]](1).  * `annex.synccontent`    Set to true to make git-annex sync default to syncing content.    To configure the behavior in all clones of the repository,-  this can be set in [[git-annex-config]].+  this can be set in [[git-annex-config]](1).  * `annex.debug` @@ -1630,7 +1633,7 @@   from automatically committing changes to files in the repository.    To configure the behavior in all clones of the repository,-  this can be set in [[git-annex-config]].+  this can be set in [[git-annex-config]](1).  * `annex.startupscan`
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 7.20190912+Version: 7.20191009 Cabal-Version: >= 1.8 License: AGPL-3 Maintainer: Joey Hess <id@joeyh.name>@@ -344,6 +344,7 @@    persistent-sqlite (>= 2.8.1),    persistent (>= 2.8.1),    persistent-template,+   unliftio-core,    microlens,    aeson,    vector,@@ -833,6 +834,7 @@     Git.Config     Git.ConfigTypes     Git.Construct+    Git.Credential     Git.CurrentRepo     Git.DiffTree     Git.DiffTreeItem