packages feed

git-annex 10.20220624 → 10.20220724

raw patch · 104 files changed

+684/−428 lines, 104 filesdep ~Win32dep ~directory

Dependency ranges changed: Win32, directory

Files

Annex.hs view
@@ -19,10 +19,8 @@ 	getState, 	changeState, 	withState,-	setFlag, 	setField, 	setOutput,-	getFlag, 	getField, 	addCleanupAction, 	gitRepo,@@ -123,6 +121,13 @@ 	, debugenabled :: Bool 	, debugselector :: DebugSelector 	, ciphers :: TMVar (M.Map StorableCipher Cipher)+	, fast :: Bool+	, force :: Bool+	, forcenumcopies :: Maybe NumCopies+	, forcemincopies :: Maybe MinCopies+	, forcebackend :: Maybe String+	, useragent :: Maybe String+	, desktopnotify :: DesktopNotify 	}  newAnnexRead :: GitConfig -> IO AnnexRead@@ -144,6 +149,13 @@ 		, debugenabled = annexDebug c 		, debugselector = debugSelectorFromGitConfig c 		, ciphers = cm+		, fast = False+		, force = False+		, forcebackend = Nothing+		, forcenumcopies = Nothing+		, forcemincopies = Nothing+		, useragent = Nothing+		, desktopnotify = mempty 		}  -- Values that can change while running an Annex action.@@ -159,8 +171,6 @@ 	, remotes :: [Types.Remote.RemoteA Annex] 	, output :: MessageState 	, concurrency :: ConcurrencySetting-	, force :: Bool-	, fast :: Bool 	, daemon :: Bool 	, branchstate :: BranchState 	, repoqueue :: Maybe (Git.Queue.Queue Annex)@@ -168,11 +178,8 @@ 	, hashobjecthandle :: Maybe HashObjectHandle 	, checkattrhandle :: Maybe (ResourcePool CheckAttrHandle) 	, checkignorehandle :: Maybe (ResourcePool CheckIgnoreHandle)-	, forcebackend :: Maybe String 	, globalnumcopies :: Maybe NumCopies 	, globalmincopies :: Maybe MinCopies-	, forcenumcopies :: Maybe NumCopies-	, forcemincopies :: Maybe MinCopies 	, limit :: ExpandableMatcher Annex 	, timelimit :: Maybe (Duration, POSIXTime) 	, sizelimit :: Maybe (TVar Integer)@@ -184,18 +191,15 @@ 	, trustmap :: Maybe TrustMap 	, groupmap :: Maybe GroupMap 	, lockcache :: LockCache-	, flags :: M.Map String Bool 	, fields :: M.Map String String 	, cleanupactions :: M.Map CleanupAction (Annex ()) 	, sentinalstatus :: Maybe SentinalStatus-	, useragent :: Maybe String 	, errcounter :: Integer 	, skippedfiles :: Bool 	, adjustedbranchrefreshcounter :: Integer 	, unusedkeys :: Maybe (S.Set Key) 	, tempurls :: M.Map Key URLString 	, existinghooks :: M.Map Git.Hook.Hook Bool-	, desktopnotify :: DesktopNotify 	, workers :: Maybe (TMVar (WorkerPool (AnnexState, AnnexRead))) 	, cachedcurrentbranch :: (Maybe (Maybe Git.Branch, Maybe Adjustment)) 	, cachedgitenv :: Maybe (AltIndexFile, FilePath, [(String, String)])@@ -220,8 +224,6 @@ 		, remotes = [] 		, output = o 		, concurrency = ConcurrencyCmdLine NonConcurrent-		, force = False-		, fast = False 		, daemon = False 		, branchstate = startBranchState 		, repoqueue = Nothing@@ -229,11 +231,8 @@ 		, hashobjecthandle = Nothing 		, checkattrhandle = Nothing 		, checkignorehandle = Nothing-		, forcebackend = Nothing 		, globalnumcopies = Nothing 		, globalmincopies = Nothing-		, forcenumcopies = Nothing-		, forcemincopies = Nothing 		, limit = BuildingMatcher [] 		, timelimit = Nothing 		, sizelimit = Nothing@@ -245,18 +244,15 @@ 		, trustmap = Nothing 		, groupmap = Nothing 		, lockcache = M.empty-		, flags = M.empty 		, fields = M.empty 		, cleanupactions = M.empty 		, sentinalstatus = Nothing-		, useragent = Nothing 		, errcounter = 0 		, skippedfiles = False 		, adjustedbranchrefreshcounter = 0 		, unusedkeys = Nothing 		, tempurls = M.empty 		, existinghooks = M.empty-		, desktopnotify = mempty 		, workers = Nothing 		, cachedcurrentbranch = Nothing 		, cachedgitenv = Nothing@@ -327,11 +323,6 @@ 	mvar <- fst <$> ask 	liftIO $ modifyMVar mvar modifier -{- Sets a flag to True -}-setFlag :: String -> Annex ()-setFlag flag = changeState $ \st ->-	st { flags = M.insert flag True $ flags st }- {- Sets a field to a value -} setField :: String -> String -> Annex () setField field value = changeState $ \st ->@@ -347,10 +338,6 @@ setOutput o = changeState $ \st -> 	let m = output st 	in st { output = m { outputType = adjustOutputType (outputType m) o } }--{- Checks if a flag was set. -}-getFlag :: String -> Annex Bool-getFlag flag = fromMaybe False . M.lookup flag <$> getState flags  {- Gets the value of a field. -} getField :: String -> Annex (Maybe String)
Annex/AdjustedBranch.hs view
@@ -207,7 +207,7 @@ 	go currbranch = do 		let origbranch = fromAdjustedBranch currbranch 		let adjbranch = adjBranch $ originalToAdjusted origbranch adj-		ifM (inRepo (Git.Ref.exists adjbranch) <&&> (not <$> Annex.getState Annex.force))+		ifM (inRepo (Git.Ref.exists adjbranch) <&&> (not <$> Annex.getRead Annex.force)) 			( do 				mapM_ (warning . unwords) 					[ [ "adjusted branch"
Annex/Branch.hs view
@@ -1,6 +1,6 @@ {- management of the git-annex branch  -- - Copyright 2011-2021 Joey Hess <id@joeyh.name>+ - Copyright 2011-2022 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -23,6 +23,8 @@ 	getUnmergedRefs, 	RegardingUUID(..), 	change,+	ChangeOrAppend(..),+	changeOrAppend, 	maybeChange, 	commitMessage, 	createMessage,@@ -48,7 +50,7 @@ import Control.Concurrent.MVar import qualified System.FilePath.ByteString as P -import Annex.Common+import Annex.Common hiding (append) import Types.BranchState import Annex.BranchState import Annex.Journal@@ -404,6 +406,56 @@ 			in when (v /= b) $ set jl ru file b 		_ -> noop +data ChangeOrAppend t = Change t | Append t++{- Applies a function that can either modify the content of the file,+ - or append to the file. Appending can be more efficient when several+ - lines are written to a file in succession.+ -+ - When annex.alwayscompact=false, the function is not passed the content+ - of the journal file when the journal file already exists, and whatever+ - value it provides is always appended to the journal file. That avoids+ - reading the journal file, and so can be faster when many lines are being+ - written to it. The information that is recorded will be effectively the+ - same, only obsolate log lines will not get compacted.+ -+ - Currently, only appends when annex.alwayscompact=false. That is to+ - avoid appending when an older version of git-annex is also in use in the+ - same repository. An interrupted append could leave the journal file in a+ - state that would confuse the older version. This is planned to be+ - changed in a future repository version.+ -}+changeOrAppend :: Journalable content => RegardingUUID -> RawFilePath -> (L.ByteString -> ChangeOrAppend content) -> Annex ()+changeOrAppend ru file f = lockJournal $ \jl ->+	checkCanAppendJournalFile jl ru file >>= \case+		Just appendable -> ifM (annexAlwaysCompact <$> Annex.getGitConfig)+			( do+				oldc <- getToChange ru file+				case f oldc of+					Change newc -> set jl ru file newc+					Append toappend -> +						set jl ru file $+							oldc <> journalableByteString toappend+						-- Use this instead in v11+						-- or whatever.+						-- append jl file appendable toappend+			, case f mempty of+				-- Append even though a change was+				-- requested; since mempty was passed in,+				-- the lines requested to change are+				-- minimized.+				Change newc -> append jl file appendable newc+				Append toappend -> append jl file appendable toappend+			)+		Nothing -> do+			oldc <- getToChange ru file+			case f oldc of+				Change newc -> set jl ru file newc+				-- Journal file does not exist yet, so+				-- cannot append and have to write it all.+				Append toappend -> set jl ru file $+					oldc <> journalableByteString toappend+ {- Only get private information when the RegardingUUID is itself private. -} getToChange :: RegardingUUID -> RawFilePath -> Annex L.ByteString getToChange ru f = flip getLocal' f . GetPrivate =<< regardingPrivateUUID ru@@ -426,6 +478,14 @@ 	-- evaluating a Journalable Builder twice, which is not very 	-- efficient. Instead, assume that it's not common to need to read 	-- a log file immediately after writing it.+	invalidateCache++{- Appends content to the journal file. -}+append :: Journalable content => JournalLocked -> RawFilePath -> AppendableJournalFile -> content -> Annex ()+append jl f appendable toappend = do+	journalChanged+	appendJournalFile jl appendable toappend+	fastDebug "Annex.Branch" ("append " ++ fromRawFilePath f) 	invalidateCache  {- Commit message used when making a commit of whatever data has changed
Annex/BranchState.hs view
@@ -2,7 +2,7 @@  -  - Runtime state about the git-annex branch, and a small cache.  -- - Copyright 2011-2021 Joey Hess <id@joeyh.name>+ - Copyright 2011-2022 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -54,7 +54,7 @@  - be checked going forward, until new information gets written to it.  -  - When the action is unable to update the branch due to a permissions- - problem, + - problem, the journal is still read every time.  -} runUpdateOnce :: Annex UpdateMade -> Annex BranchState runUpdateOnce update = do@@ -92,9 +92,9 @@ 	-- so avoid an unnecessary write to the MVar that changeState 	-- would do. 	---	-- This assumes that another thread is not changing journalIgnorable+	-- This assumes that another thread is not setting journalIgnorable 	-- at the same time, but since runUpdateOnce is the only-	-- thing that changes it, and it only runs once, that+	-- thing that sets it, and it only runs once, that 	-- should not happen. 	st <- getState  	when (journalIgnorable st) $@@ -109,8 +109,10 @@  - will be seen.  -} enableInteractiveBranchAccess :: Annex ()-enableInteractiveBranchAccess = changeState $-	\s -> s { needInteractiveAccess = True }+enableInteractiveBranchAccess = changeState $ \s -> s +	{ needInteractiveAccess = True+	, journalIgnorable = False+	}  setCache :: RawFilePath -> L.ByteString -> Annex () setCache file content = changeState $ \s -> s
Annex/CheckIgnore.hs view
@@ -25,7 +25,7 @@ checkIgnored :: CheckGitIgnore -> RawFilePath -> Annex Bool checkIgnored (CheckGitIgnore False) _ = pure False checkIgnored (CheckGitIgnore True) file =-	ifM (Annex.getState Annex.force)+	ifM (Annex.getRead Annex.force) 		( pure False 		, withCheckIgnoreHandle $ \h -> liftIO $ Git.checkIgnored h file 		)
Annex/Content/LowLevel.hs view
@@ -107,7 +107,7 @@ {- Allows specifying the size of the key, if it's known, which is useful  - as not all keys know their size. -} checkDiskSpace' :: Integer -> Maybe RawFilePath -> Key -> Integer -> Bool -> Annex Bool-checkDiskSpace' need destdir key alreadythere samefilesystem = ifM (Annex.getState Annex.force)+checkDiskSpace' need destdir key alreadythere samefilesystem = ifM (Annex.getRead Annex.force) 	( return True 	, do 		-- We can't get inprogress and free at the same
Annex/Ingest.hs view
@@ -325,7 +325,7 @@  - checked in, CheckGitIgnore True has no effect.  -} gitAddParams :: CheckGitIgnore -> Annex [CommandParam]-gitAddParams (CheckGitIgnore True) = ifM (Annex.getState Annex.force)+gitAddParams (CheckGitIgnore True) = ifM (Annex.getRead Annex.force) 	( return [Param "-f"] 	, return [] 	)
Annex/Journal.hs view
@@ -4,12 +4,16 @@  - git-annex branch. Among other things, it ensures that if git-annex is  - interrupted, its recorded data is not lost.  -- - Copyright 2011-2021 Joey Hess <id@joeyh.name>+ - All files in the journal must be a series of lines separated by+ - newlines.  -+ - Copyright 2011-2022 Joey Hess <id@joeyh.name>+ -  - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}  module Annex.Journal where @@ -20,6 +24,7 @@ import Annex.Tmp import Annex.LockFile import Utility.Directory.Stream+import qualified Utility.RawFilePath as R  import qualified Data.Set as S import qualified Data.ByteString.Lazy as L@@ -71,9 +76,9 @@  - Using the journal, rather than immediatly staging content to the index  - avoids git needing to rewrite the index after every change.  - - - The file in the journal is updated atomically, which allows- - getJournalFileStale to always return a consistent journal file- - content, although possibly not the most current one.+ - The file in the journal is updated atomically. This avoids an+ - interrupted write truncating information that was earlier read from the+ - file, and so losing data.  -} setJournalFile :: Journalable content => JournalLocked -> RegardingUUID -> RawFilePath -> content -> Annex () setJournalFile _jl ru file content = withOtherTmp $ \tmp -> do@@ -81,15 +86,60 @@ 		( return gitAnnexPrivateJournalDir 		, return gitAnnexJournalDir 		)-	createAnnexDirectory jd 	-- journal file is written atomically 	let jfile = journalFile file 	let tmpfile = tmp P.</> jfile-	liftIO $ do-		withFile (fromRawFilePath tmpfile) WriteMode $ \h ->-			writeJournalHandle h content-		moveFile tmpfile (jd P.</> jfile)+	liftIO $ withFile (fromRawFilePath tmpfile) WriteMode $ \h ->+		writeJournalHandle h content+	let mv = liftIO $ moveFile tmpfile (jd P.</> jfile)+	-- avoid overhead of creating the journal directory when it already+	-- exists+	mv `catchIO` (const (createAnnexDirectory jd >> mv)) +newtype AppendableJournalFile = AppendableJournalFile (RawFilePath, RawFilePath)++{- If the journal file does not exist, it cannot be appended to, because+ - that would overwrite whatever content the file has in the git-annex+ - branch. -}+checkCanAppendJournalFile :: JournalLocked -> RegardingUUID -> RawFilePath -> Annex (Maybe AppendableJournalFile)+checkCanAppendJournalFile _jl ru file = do+	jd <- fromRepo =<< ifM (regardingPrivateUUID ru)+		( return gitAnnexPrivateJournalDir+		, return gitAnnexJournalDir+		)+	let jfile = jd P.</> journalFile file+	ifM (liftIO $ R.doesPathExist jfile)+		( return (Just (AppendableJournalFile (jd, jfile)))+		, return Nothing+		)++{- Appends content to an existing journal file.+ -+ - Appends are not necessarily atomic, though short appends often are.+ - So, when this is interrupted, it can leave only part of the content+ - written to the file. To deal with that situation, both this and+ - getJournalFileStale check if the file ends with a newline, and if+ - not discard the incomplete line.+ -+ - Due to the lack of atomicity, this should not be used when multiple+ - lines need to be written to the file as an atomic unit.+ -}+appendJournalFile :: Journalable content => JournalLocked -> AppendableJournalFile -> content -> Annex ()+appendJournalFile _jl (AppendableJournalFile (jd, jfile)) content = do+	let write = liftIO $ withFile (fromRawFilePath jfile) ReadWriteMode $ \h -> do+		sz <- hFileSize h+		when (sz /= 0) $ do+			hSeek h SeekFromEnd (-1)+			lastchar <- B.hGet h 1+			unless (lastchar == "\n") $ do+				hSeek h AbsoluteSeek 0+				goodpart <- L.length . discardIncompleteAppend+					<$> L.hGet h (fromIntegral sz)+				hSetFileSize h (fromIntegral goodpart)+				hSeek h SeekFromEnd 0+		writeJournalHandle h content+	write `catchIO` (const (createAnnexDirectory jd >> write))+ data JournalledContent 	= NoJournalledContent 	| JournalledContent L.ByteString@@ -109,15 +159,17 @@ data GetPrivate = GetPrivate Bool  {- Without locking, this is not guaranteed to be the most recent- - version of the file in the journal, so should not be used as a basis for- - changes.+ - content of the file in the journal, so should not be used as a basis for+ - making changes to the file.  -  - The file is read strictly so that its content can safely be fed into- - an operation that modifies the file. While setJournalFile doesn't- - write directly to journal files and so probably avoids problems with- - writing to the same file that's being read, but there could be- - concurrency or other issues with a lazy read, and the minor loss of- - laziness doesn't matter much, as the files are not very large.+ - an operation that modifies the file (when getJournalFile calls this). + - The minor loss of laziness doesn't matter much, as the files are not+ - very large.+ -+ - To recover from an append of a line that is interrupted part way through+ - (or is in progress when this is called), if the file content does not end+ - with a newline, it is truncated back to the previous newline.  -} getJournalFileStale :: GetPrivate -> RawFilePath -> Annex JournalledContent getJournalFileStale (GetPrivate getprivate) file = do@@ -144,7 +196,22 @@   where 	jfile = journalFile file 	getfrom d = catchMaybeIO $-		L.fromStrict <$> B.readFile (fromRawFilePath (d P.</> jfile))+		discardIncompleteAppend . L.fromStrict+			<$> B.readFile (fromRawFilePath (d P.</> jfile))++-- Note that this forces read of the whole lazy bytestring.+discardIncompleteAppend :: L.ByteString -> L.ByteString+discardIncompleteAppend v+	| L.null v = v+	| L.last v == nl = v+	| otherwise = dropwhileend (/= nl) v+  where+	nl = fromIntegral (ord '\n')+#if MIN_VERSION_bytestring(0,11,2)+	dropwhileend = L.dropWhileEnd+#else+	dropwhileend p = L.reverse . L.dropWhile p . L.reverse+#endif  {- List of existing journal files in a journal directory, but without locking,  - may miss new ones just being added, or may have false positives if the
Annex/Notification.hs view
@@ -34,7 +34,7 @@ notifyTransfer direction t a = case descTransfrerrable t of 	Nothing -> a NotifyWitness 	Just desc -> do-		wanted <- Annex.getState Annex.desktopnotify+		wanted <- Annex.getRead Annex.desktopnotify 		if (notifyStart wanted || notifyFinish wanted) 			then do 				client <- liftIO DBus.Client.connectSession@@ -57,7 +57,7 @@ notifyDrop (AssociatedFile Nothing) _ = noop #ifdef WITH_DBUS_NOTIFICATIONS notifyDrop (AssociatedFile (Just f)) ok = do-	wanted <- Annex.getState Annex.desktopnotify+	wanted <- Annex.getRead Annex.desktopnotify 	when (notifyFinish wanted) $ liftIO $ do 		client <- DBus.Client.connectSession 		void $ Notify.notify client (droppedNote ok (fromRawFilePath f))
Annex/NumCopies.hs view
@@ -57,11 +57,11 @@  {- Value forced on the command line by --numcopies. -} getForcedNumCopies :: Annex (Maybe NumCopies)-getForcedNumCopies = Annex.getState Annex.forcenumcopies+getForcedNumCopies = Annex.getRead Annex.forcenumcopies  {- Value forced on the command line by --mincopies. -} getForcedMinCopies :: Annex (Maybe MinCopies)-getForcedMinCopies = Annex.getState Annex.forcemincopies+getForcedMinCopies = Annex.getRead Annex.forcemincopies  {- NumCopies value from any of the non-.gitattributes configuration  - sources. -}
Annex/Url.hs view
@@ -48,7 +48,7 @@ defaultUserAgent = "git-annex/" ++ BuildInfo.packageversion  getUserAgent :: Annex U.UserAgent-getUserAgent = Annex.getState $ +getUserAgent = Annex.getRead $  	fromMaybe defaultUserAgent . Annex.useragent  getUrlOptions :: Annex U.UrlOptions
Annex/YoutubeDl.hs view
@@ -118,7 +118,7 @@ -- and any files in the workdir that it may have partially downloaded -- before. youtubeDlMaxSize :: FilePath -> Annex (Either String [CommandParam])-youtubeDlMaxSize workdir = ifM (Annex.getState Annex.force)+youtubeDlMaxSize workdir = ifM (Annex.getRead Annex.force) 	( return $ Right [] 	, liftIO (getDiskFree workdir) >>= \case 		Just have -> do
Assistant/Install.hs view
@@ -184,7 +184,6 @@ 	clean environ 		| null vars = Nothing 		| otherwise = Just $ catMaybes $ map (restoreorig environ) environ-		| otherwise = Nothing 	  where 		vars = words $ fromMaybe "" $ 			lookup "GIT_ANNEX_STANDLONE_ENV" environ
Assistant/Threads/Watcher.hs view
@@ -57,7 +57,7 @@ 	| canWatch = do #ifndef mingw32_HOST_OS 		liftIO Lsof.setup-		unlessM (liftIO (inSearchPath "lsof") <||> Annex.getState Annex.force)+		unlessM (liftIO (inSearchPath "lsof") <||> Annex.getRead Annex.force) 			needLsof #else 		noop
Assistant/Upgrade.hs view
@@ -207,13 +207,13 @@ 			unless tarok $ 				error $ "failed to untar " ++ distributionfile 			sanitycheck $ tmpdir </> installBase-			installby rename newdir (tmpdir </> installBase)+			installby R.rename newdir (tmpdir </> installBase) 		let deleteold = do 			deleteFromManifest olddir 			makeorigsymlink olddir 		return (newdir </> "git-annex", deleteold) 	installby a dstdir srcdir =-		mapM_ (\x -> a x (dstdir </> takeFileName x))+		mapM_ (\x -> a (toRawFilePath x) (toRawFilePath (dstdir </> takeFileName x))) 			=<< dirContents srcdir #endif 	sanitycheck dir = 
Assistant/WebApp/Configurators/Local.hs view
@@ -45,6 +45,7 @@ import qualified Data.Map as M import Data.Char import Data.Ord+import Data.Kind import qualified Text.Hamlet as Hamlet  data RepositoryPath = RepositoryPath Text@@ -54,7 +55,7 @@  -  - Validates that the path entered is not empty, and is a safe value  - to use as a repository. -}-repositoryPathField :: forall (m :: * -> *). (MonadIO m, HandlerSite m ~ WebApp) => Bool -> Field m Text+repositoryPathField :: forall (m :: Type -> Type). (MonadIO m, HandlerSite m ~ WebApp) => Bool -> Field m Text repositoryPathField autofocus = Field 	{ fieldParse = \l _ -> parse l 	, fieldEnctype = UrlEncoded
Backend.hs view
@@ -44,7 +44,7 @@   where 	cache = do 		n <- maybe (annexBackend <$> Annex.getGitConfig) (return . Just)-			=<< Annex.getState Annex.forcebackend+			=<< Annex.getRead Annex.forcebackend 		b <- case n of 			Just name | valid name -> lookupname name 			_ -> pure (Prelude.head builtinList)@@ -79,7 +79,7 @@  - That can be configured on a per-file basis in the gitattributes file,  - or forced with --backend. -} chooseBackend :: RawFilePath -> Annex (Maybe Backend)-chooseBackend f = Annex.getState Annex.forcebackend >>= go+chooseBackend f = Annex.getRead Annex.forcebackend >>= go   where 	go Nothing = maybeLookupBackendVariety . parseKeyVariety . encodeBS 		=<< checkAttr "annex.backend" f
Backend/Hash.hs view
@@ -120,7 +120,7 @@  checkKeyChecksum :: Hash -> Key -> RawFilePath -> Annex Bool checkKeyChecksum hash key file = catchIOErrorType HardwareFault hwfault $ do-	fast <- Annex.getState Annex.fast+	fast <- Annex.getRead Annex.fast 	exists <- liftIO $ R.doesPathExist file 	case (exists, fast) of 		(True, False) -> do
CHANGELOG view
@@ -1,3 +1,30 @@+git-annex (10.20220724) upstream; urgency=medium++  * filter-process: Fix a bug involving handling of empty files,+    that caused git to kill git-annex filter-process.+  * add: Fix reversion when adding an annex link that has been moved to+    another directory. (Introduced in version 10.20220624)+  * Added annex.alwayscompact setting which can be unset to speed up+    writes to the git-annex branch in some cases. See its documentation+    for important notes on when it's appropariate to use.+  * adb: Added configuration setting oldandroid=true to avoid using+    find -printf, which was first supported in Android around 2019-2020.+    This may need to be enabled for old android devices that used to work+    without it being set, since version 10.20220222 started using +    find -printf.+  * --backend is no longer a global option, and is only accepted by+    commands that actually need it.+  * Improve handling of parallelization with -J when copying content+    from/to a git remote that is a local path.+  * S3: Avoid writing or checking the uuid file in the S3 bucket when+    importtree=yes or exporttree=yes.+  * Fix a reversion that prevented --batch commands (and the assistant)+    from noticing data written to the journal by other commands.+  * Fix building with the Assistant build flag disabled but the Webapp+    build flag enabled.++ -- Joey Hess <id@joeyh.name>  Mon, 25 Jul 2022 12:55:38 -0400+ git-annex (10.20220624) upstream; urgency=medium    * init: Added --no-autoenable option.
CmdLine.hs view
@@ -53,14 +53,14 @@   where 	go (Right g) = do 		g' <- Git.Config.read g-		(cmd, seek, globalsetter) <- parsewith False cmdparser+		(cmd, seek, annexsetter) <- parsewith False cmdparser 			(\a -> a (Just g')) 			O.handleParseResult-		state <- applyAnnexReadSetter globalsetter <$> Annex.new g'+		state <- applyAnnexReadSetter annexsetter <$> Annex.new g' 		Annex.eval state $ do 			checkEnvironment 			forM_ fields $ uncurry Annex.setField-			prepRunCommand cmd globalsetter+			prepRunCommand cmd annexsetter 			startup 			performCommandAction True cmd seek $ 				shutdown $ cmdnocommit cmd@@ -101,7 +101,7 @@ 			Just n -> n:args  {- Parses command line, selecting one of the commands from the list. -}-parseCmd :: String -> String -> CmdParams -> [Command] -> (Command -> O.Parser v) -> O.ParserResult (Command, v, GlobalSetter)+parseCmd :: String -> String -> CmdParams -> [Command] -> (Command -> O.Parser v) -> O.ParserResult (Command, v, AnnexSetter) parseCmd progname progdesc allargs allcmds getparser =  	O.execParserPure (O.prefs O.idm) pinfo allargs   where@@ -114,7 +114,7 @@ 	mkparser c = (,,)  		<$> pure c 		<*> getparser c-		<*> parserGlobalOptions (cmdglobaloptions c)+		<*> parserAnnexOptions (cmdannexoptions c) 	synopsis n d = n ++ " - " ++ d 	intro = mconcat $ concatMap (\l -> [H.text l, H.line]) 		(synopsis progname progdesc : commandList allcmds)@@ -141,14 +141,14 @@ 		| "-" `isPrefixOf` a = findname as (a:c) 		| otherwise = (Just a, reverse c ++ as) --- | Note that the GlobalSetter must have already had its annexReadSetter+-- | Note that the AnnexSetter must have already had its annexReadSetter -- applied before entering the Annex monad to run this; that cannot be -- changed while running in the Annex monad.-prepRunCommand :: Command -> GlobalSetter -> Annex ()-prepRunCommand cmd globalsetter = do+prepRunCommand :: Command -> AnnexSetter -> Annex ()+prepRunCommand cmd annexsetter = do 	when (cmdnomessages cmd) $ 		Annex.setOutput QuietOutput-	annexStateSetter globalsetter+	annexStateSetter annexsetter 	whenM (Annex.getRead Annex.debugenabled) $ 		enableDebugOutput @@ -186,7 +186,7 @@ 	, cmdparamdesc = "[PARAMS]" 	, cmdsection = SectionAddOn 	, cmddesc = "addon command"-	, cmdglobaloptions = []+	, cmdannexoptions = [] 	, cmdinfomod = O.forwardOptions 	, cmdparser = parse 	, cmdnorepo = Just parse
+ CmdLine/AnnexSetter.hs view
@@ -0,0 +1,36 @@+{- git-annex options that are stored in Annex+ -+ - Copyright 2015-2021 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+  -}+  +module CmdLine.AnnexSetter where++import Common+import Annex+import Types.DeferredParse++import Options.Applicative++setAnnexState :: Annex () -> AnnexSetter+setAnnexState a = AnnexSetter a id++setAnnexRead :: (AnnexRead -> AnnexRead) -> AnnexSetter+setAnnexRead f = AnnexSetter (return ()) f++annexFlag :: AnnexSetter -> Mod FlagFields AnnexSetter -> AnnexOption+annexFlag = flag'++annexOption :: (v -> AnnexSetter) -> Parser v -> AnnexOption+annexOption mk parser = mk <$> parser++-- | Combines a bunch of AnnexOptions together into a Parser+-- that returns a AnnexSetter that can be used to set all the options that+-- are enabled.+parserAnnexOptions :: [AnnexOption] -> Parser AnnexSetter+parserAnnexOptions [] = pure mempty+parserAnnexOptions l = mconcat <$> many (foldl1 (<|>) l)++applyAnnexReadSetter :: AnnexSetter -> (AnnexState, AnnexRead) -> (AnnexState, AnnexRead)+applyAnnexReadSetter gs (st, rd) = (st, annexReadSetter gs rd)
CmdLine/GitAnnex.hs view
@@ -130,7 +130,7 @@ import qualified Command.Benchmark  cmds :: Parser TestOptions -> TestRunner -> MkBenchmarkGenerator -> [Command]-cmds testoptparser testrunner mkbenchmarkgenerator = map addGitAnnexGlobalOptions $+cmds testoptparser testrunner mkbenchmarkgenerator = map addGitAnnexCommonOptions $ 	[ Command.Help.cmd 	, Command.Add.cmd 	, Command.Get.cmd@@ -245,8 +245,8 @@ 		mkbenchmarkgenerator $ cmds testoptparser testrunner (\_ _ -> return noop) 	] -addGitAnnexGlobalOptions :: Command -> Command-addGitAnnexGlobalOptions c = c { cmdglobaloptions = gitAnnexGlobalOptions ++ cmdglobaloptions c }+addGitAnnexCommonOptions :: Command -> Command+addGitAnnexCommonOptions c = c { cmdannexoptions = gitAnnexCommonOptions ++ cmdannexoptions c }  run :: Parser TestOptions -> TestRunner -> MkBenchmarkGenerator -> [String] -> IO () run testoptparser testrunner mkbenchmarkgenerator args = go envmodes
CmdLine/GitAnnex/Options.hs view
@@ -34,77 +34,77 @@ import qualified Limit.Wanted import CmdLine.Option import CmdLine.Usage-import CmdLine.GlobalSetter+import CmdLine.AnnexSetter import qualified Backend import qualified Types.Backend as Backend import Utility.HumanTime import Utility.DataUnits import Annex.Concurrent --- Global options that are accepted by all git-annex sub-commands,+-- Options that are accepted by all git-annex sub-commands, -- although not always used.-gitAnnexGlobalOptions :: [GlobalOption]-gitAnnexGlobalOptions = commonGlobalOptions ++-	[ globalOption (setAnnexState . setnumcopies) $ option auto+gitAnnexCommonOptions :: [AnnexOption]+gitAnnexCommonOptions = commonOptions +++	[ annexOption setnumcopies $ option auto 		( long "numcopies" <> short 'N' <> metavar paramNumber 		<> help "override desired number of copies" 		<> hidden 		)-	, globalOption (setAnnexState . setmincopies) $ option auto+	, annexOption setmincopies $ option auto 		( long "mincopies" <> short 'N' <> metavar paramNumber 		<> help "override minimum number of copies" 		<> hidden 		)-	, globalOption (setAnnexState . Remote.forceTrust Trusted) $ strOption+	, annexOption (setAnnexState . Remote.forceTrust Trusted) $ strOption 		( long "trust" <> metavar paramRemote 		<> help "deprecated, does not override trust setting" 		<> hidden 		<> completeRemotes 		)-	, globalOption (setAnnexState . Remote.forceTrust SemiTrusted) $ strOption+	, annexOption (setAnnexState . Remote.forceTrust SemiTrusted) $ strOption 		( long "semitrust" <> metavar paramRemote 		<> help "override trust setting back to default" 		<> hidden 		<> completeRemotes 		)-	, globalOption (setAnnexState . Remote.forceTrust UnTrusted) $ strOption+	, annexOption (setAnnexState . Remote.forceTrust UnTrusted) $ strOption 		( long "untrust" <> metavar paramRemote 		<> help "override trust setting to untrusted" 		<> hidden 		<> completeRemotes 		)-	, globalOption (setAnnexState . setgitconfig) $ strOption+	, annexOption (setAnnexState . setgitconfig) $ strOption 		( long "config" <> short 'c' <> metavar "NAME=VALUE" 		<> help "override git configuration setting" 		<> hidden 		)-	, globalOption (setAnnexState . setuseragent) $ strOption+	, annexOption setuseragent $ strOption 		( long "user-agent" <> metavar paramName 		<> help "override default User-Agent" 		<> hidden 		)-	, globalFlag (setAnnexState $ toplevelWarning False "--trust-glacier no longer has any effect")+	, annexFlag (setAnnexState $ toplevelWarning False "--trust-glacier no longer has any effect") 		( long "trust-glacier" 		<> help "deprecated, does not trust Amazon Glacier inventory" 		<> hidden 		)-	, globalFlag (setAnnexState $ setdesktopnotify mkNotifyFinish)+	, annexFlag (setdesktopnotify mkNotifyFinish) 		( long "notify-finish" 		<> help "show desktop notification after transfer finishes" 		<> hidden 		)-	, globalFlag (setAnnexState $ setdesktopnotify mkNotifyStart)+	, annexFlag (setdesktopnotify mkNotifyStart) 		( long "notify-start" 		<> help "show desktop notification after transfer starts" 		<> hidden 		) 	]   where-	setnumcopies n = Annex.changeState $ \s -> s { Annex.forcenumcopies = Just $ configuredNumCopies n }-	setmincopies n = Annex.changeState $ \s -> s { Annex.forcemincopies = Just $ configuredMinCopies n }-	setuseragent v = Annex.changeState $ \s -> s { Annex.useragent = Just v }+	setnumcopies n = setAnnexRead $ \rd -> rd { Annex.forcenumcopies = Just $ configuredNumCopies n }+	setmincopies n = setAnnexRead $ \rd -> rd { Annex.forcemincopies = Just $ configuredMinCopies n }+	setuseragent v = setAnnexRead $ \rd -> rd { Annex.useragent = Just v }+	setdesktopnotify v = setAnnexRead $ \rd -> rd { Annex.desktopnotify = Annex.desktopnotify rd <> v } 	setgitconfig v = Annex.addGitConfigOverride v-	setdesktopnotify v = Annex.changeState $ \s -> s { Annex.desktopnotify = Annex.desktopnotify s <> v }  {- Parser that accepts all non-option params. -} cmdParams :: CmdParamsDesc -> Parser CmdParams@@ -229,7 +229,7 @@ parseKey = maybe (Fail.fail "invalid key") return . deserializeKey  -- Options to match properties of annexed files.-annexedMatchingOptions :: [GlobalOption]+annexedMatchingOptions :: [AnnexOption] annexedMatchingOptions = concat 	[ keyMatchingOptions' 	, fileMatchingOptions' Limit.LimitAnnexFiles@@ -239,86 +239,86 @@ 	]  -- Matching options that can operate on keys as well as files.-keyMatchingOptions :: [GlobalOption]+keyMatchingOptions :: [AnnexOption] keyMatchingOptions = keyMatchingOptions' ++ combiningOptions ++ timeLimitOption ++ sizeLimitOption -keyMatchingOptions' :: [GlobalOption]+keyMatchingOptions' :: [AnnexOption] keyMatchingOptions' = -	[ globalOption (setAnnexState . Limit.addIn) $ strOption+	[ annexOption (setAnnexState . Limit.addIn) $ strOption 		( long "in" <> short 'i' <> metavar paramRemote 		<> help "match files present in a remote" 		<> hidden 		<> completeRemotes 		)-	, globalOption (setAnnexState . Limit.addCopies) $ strOption+	, annexOption (setAnnexState . Limit.addCopies) $ strOption 		( long "copies" <> short 'C' <> metavar paramRemote 		<> help "skip files with fewer copies" 		<> hidden 		)-	, globalOption (setAnnexState . Limit.addLackingCopies False) $ strOption+	, annexOption (setAnnexState . Limit.addLackingCopies False) $ strOption 		( long "lackingcopies" <> metavar paramNumber 		<> help "match files that need more copies" 		<> hidden 		)-	, globalOption (setAnnexState . Limit.addLackingCopies True) $ strOption+	, annexOption (setAnnexState . Limit.addLackingCopies True) $ strOption 		( long "approxlackingcopies" <> metavar paramNumber 		<> help "match files that need more copies (faster)" 		<> hidden 		)-	, globalOption (setAnnexState . Limit.addInBackend) $ strOption+	, annexOption (setAnnexState . Limit.addInBackend) $ strOption 		( long "inbackend" <> short 'B' <> metavar paramName 		<> help "match files using a key-value backend" 		<> hidden 		<> completeBackends 		)-	, globalFlag (setAnnexState Limit.addSecureHash)+	, annexFlag (setAnnexState Limit.addSecureHash) 		( long "securehash" 		<> help "match files using a cryptographically secure hash" 		<> hidden 		)-	, globalOption (setAnnexState . Limit.addInAllGroup) $ strOption+	, annexOption (setAnnexState . Limit.addInAllGroup) $ strOption 		( long "inallgroup" <> metavar paramGroup 		<> help "match files present in all remotes in a group" 		<> hidden 		)-	, globalOption (setAnnexState . Limit.addMetaData) $ strOption+	, annexOption (setAnnexState . Limit.addMetaData) $ strOption 		( long "metadata" <> metavar "FIELD=VALUE" 		<> help "match files with attached metadata" 		<> hidden 		)-	, globalFlag (setAnnexState Limit.Wanted.addWantGet)+	, annexFlag (setAnnexState Limit.Wanted.addWantGet) 		( long "want-get" 		<> help "match files the repository wants to get" 		<> hidden 		)-	, globalFlag (setAnnexState Limit.Wanted.addWantDrop)+	, annexFlag (setAnnexState Limit.Wanted.addWantDrop) 		( long "want-drop" 		<> help "match files the repository wants to drop" 		<> hidden 		)-	, globalOption (setAnnexState . Limit.addAccessedWithin) $+	, annexOption (setAnnexState . Limit.addAccessedWithin) $ 		option (eitherReader parseDuration) 			( long "accessedwithin" 			<> metavar paramTime 			<> help "match files accessed within a time interval" 			<> hidden 			)-	, globalOption (setAnnexState . Limit.addMimeType) $ strOption+	, annexOption (setAnnexState . Limit.addMimeType) $ strOption 		( long "mimetype" <> metavar paramGlob 		<> help "match files by mime type" 		<> hidden 		)-	, globalOption (setAnnexState . Limit.addMimeEncoding) $ strOption+	, annexOption (setAnnexState . Limit.addMimeEncoding) $ strOption 		( long "mimeencoding" <> metavar paramGlob 		<> help "match files by mime encoding" 		<> hidden 		)-	, globalFlag (setAnnexState Limit.addUnlocked)+	, annexFlag (setAnnexState Limit.addUnlocked) 		( long "unlocked" 		<> help "match files that are unlocked" 		<> hidden 		)-	, globalFlag (setAnnexState Limit.addLocked)+	, annexFlag (setAnnexState Limit.addLocked) 		( long "locked" 		<> help "match files that are locked" 		<> hidden@@ -326,44 +326,44 @@ 	]  -- Options to match files which may not yet be annexed.-fileMatchingOptions :: Limit.LimitBy -> [GlobalOption]+fileMatchingOptions :: Limit.LimitBy -> [AnnexOption] fileMatchingOptions lb = fileMatchingOptions' lb ++ combiningOptions ++ timeLimitOption -fileMatchingOptions' :: Limit.LimitBy -> [GlobalOption]+fileMatchingOptions' :: Limit.LimitBy -> [AnnexOption] fileMatchingOptions' lb =-	[ globalOption (setAnnexState . Limit.addExclude) $ strOption+	[ annexOption (setAnnexState . Limit.addExclude) $ strOption 		( long "exclude" <> short 'x' <> metavar paramGlob 		<> help "skip files matching the glob pattern" 		<> hidden 		)-	, globalOption (setAnnexState . Limit.addInclude) $ strOption+	, annexOption (setAnnexState . Limit.addInclude) $ strOption 		( long "include" <> short 'I' <> metavar paramGlob 		<> help "limit to files matching the glob pattern" 		<> hidden 		)-	, globalOption (setAnnexState . Limit.addExcludeSameContent) $ strOption+	, annexOption (setAnnexState . Limit.addExcludeSameContent) $ strOption 		( long "excludesamecontent" <> short 'x' <> metavar paramGlob 		<> help "skip files whose content is the same as another file matching the glob pattern" 		<> hidden 		)-	, globalOption (setAnnexState . Limit.addIncludeSameContent) $ strOption+	, annexOption (setAnnexState . Limit.addIncludeSameContent) $ strOption 		( long "includesamecontent" <> short 'I' <> metavar paramGlob 		<> help "limit to files whose content is the same as another file matching the glob pattern" 		<> hidden 		)-	, globalOption (setAnnexState . Limit.addLargerThan lb) $ strOption+	, annexOption (setAnnexState . Limit.addLargerThan lb) $ strOption 		( long "largerthan" <> metavar paramSize 		<> help "match files larger than a size" 		<> hidden 		)-	, globalOption (setAnnexState . Limit.addSmallerThan lb) $ strOption+	, annexOption (setAnnexState . Limit.addSmallerThan lb) $ strOption 		( long "smallerthan" <> metavar paramSize 		<> help "match files smaller than a size" 		<> hidden 		) 	] -combiningOptions :: [GlobalOption]+combiningOptions :: [AnnexOption] combiningOptions =  	[ longopt "not" "negate next option" 	, longopt "and" "both previous and next option must match"@@ -372,19 +372,19 @@ 	, shortopt ')' "close group of options" 	]   where-	longopt o h = globalFlag (setAnnexState $ Limit.addSyntaxToken o)+	longopt o h = annexFlag (setAnnexState $ Limit.addSyntaxToken o) 		( long o <> help h <> hidden )-	shortopt o h = globalFlag (setAnnexState $ Limit.addSyntaxToken [o])+	shortopt o h = annexFlag (setAnnexState $ Limit.addSyntaxToken [o]) 		( short o <> help h <> hidden ) -jsonOptions :: [GlobalOption]+jsonOptions :: [AnnexOption] jsonOptions = -	[ globalFlag (setAnnexState $ Annex.setOutput (JSONOutput stdjsonoptions))+	[ annexFlag (setAnnexState $ Annex.setOutput (JSONOutput stdjsonoptions)) 		( long "json" <> short 'j' 		<> help "enable JSON output" 		<> hidden 		)-	, globalFlag (setAnnexState $ Annex.setOutput (JSONOutput jsonerrormessagesoptions))+	, annexFlag (setAnnexState $ Annex.setOutput (JSONOutput jsonerrormessagesoptions)) 		( long "json-error-messages" 		<> help "include error messages in JSON" 		<> hidden@@ -397,9 +397,9 @@ 		} 	jsonerrormessagesoptions = stdjsonoptions { jsonErrorMessages = True } -jsonProgressOption :: [GlobalOption]+jsonProgressOption :: [AnnexOption] jsonProgressOption = -	[ globalFlag (setAnnexState $ Annex.setOutput (JSONOutput jsonoptions))+	[ annexFlag (setAnnexState $ Annex.setOutput (JSONOutput jsonoptions)) 		( long "json-progress" 		<> help "include progress in JSON output" 		<> hidden@@ -413,9 +413,9 @@  -- Note that a command that adds this option should wrap its seek -- action in `allowConcurrentOutput`.-jobsOption :: [GlobalOption]+jobsOption :: [AnnexOption] jobsOption = -	[ globalOption (setAnnexState . setConcurrency . ConcurrencyCmdLine) $ +	[ annexOption (setAnnexState . setConcurrency . ConcurrencyCmdLine) $  		option (maybeReader parseConcurrency) 			( long "jobs" <> short 'J'  			<> metavar (paramNumber `paramOr` "cpus")@@ -424,9 +424,9 @@ 			) 	] -timeLimitOption :: [GlobalOption]+timeLimitOption :: [AnnexOption] timeLimitOption = -	[ globalOption settimelimit $ option (eitherReader parseDuration)+	[ annexOption settimelimit $ option (eitherReader parseDuration) 		( long "time-limit" <> short 'T' <> metavar paramTime 		<> help "stop after the specified amount of time" 		<> hidden@@ -438,9 +438,9 @@ 		let cutoff = start + durationToPOSIXTime duration 		Annex.changeState $ \s -> s { Annex.timelimit = Just (duration, cutoff) } -sizeLimitOption :: [GlobalOption]+sizeLimitOption :: [AnnexOption] sizeLimitOption =-	[ globalOption setsizelimit $ option (maybeReader (readSize dataUnits))+	[ annexOption setsizelimit $ option (maybeReader (readSize dataUnits)) 		( long "size-limit" <> metavar paramSize 		<> help "total size of annexed files to process" 		<> hidden@@ -450,6 +450,18 @@ 	setsizelimit n = setAnnexState $ do 		v <- liftIO $ newTVarIO n 		Annex.changeState $ \s -> s { Annex.sizelimit = Just v }+	+backendOption :: [AnnexOption]+backendOption = +	[ annexOption setforcebackend $ strOption+		( long "backend" <> short 'b' <> metavar paramName+		<> help "specify key-value backend to use"+		<> hidden+		)+	]+  where+	setforcebackend v = setAnnexRead $ +		\rd -> rd { Annex.forcebackend = Just v }  data DaemonOptions = DaemonOptions 	{ foregroundDaemonOption :: Bool
CmdLine/GitAnnexShell.hs view
@@ -11,7 +11,7 @@ import qualified Git.Construct import qualified Git.Config import CmdLine-import CmdLine.GlobalSetter+import CmdLine.AnnexSetter import Command import Annex.UUID import CmdLine.GitAnnexShell.Checks@@ -37,7 +37,7 @@ 	, (ServeReadWrite, allcmds) 	]   where-	readonlycmds = map addGlobalOptions+	readonlycmds = map addAnnexOptions 		[ Command.ConfigList.cmd 		, gitAnnexShellCheck Command.NotifyChanges.cmd 		-- p2pstdio checks the enviroment variables to@@ -46,10 +46,10 @@ 		, gitAnnexShellCheck Command.InAnnex.cmd 		, gitAnnexShellCheck Command.SendKey.cmd 		]-	appendcmds = readonlycmds ++ map addGlobalOptions+	appendcmds = readonlycmds ++ map addAnnexOptions 		[ gitAnnexShellCheck Command.RecvKey.cmd 		]-	allcmds = appendcmds ++ map addGlobalOptions+	allcmds = appendcmds ++ map addAnnexOptions 		[ gitAnnexShellCheck Command.DropKey.cmd 		, Command.GCryptSetup.cmd 		]@@ -63,16 +63,16 @@ cmdsList :: [Command] cmdsList = nub $ concat $ M.elems cmdsMap -addGlobalOptions :: Command -> Command-addGlobalOptions c = c { cmdglobaloptions = globalOptions ++ cmdglobaloptions c }+addAnnexOptions :: Command -> Command+addAnnexOptions c = c { cmdannexoptions = commonShellOptions ++ cmdannexoptions c } -globalOptions :: [GlobalOption]-globalOptions = -	globalOption (setAnnexState . checkUUID) (strOption+commonShellOptions :: [AnnexOption]+commonShellOptions = +	annexOption (setAnnexState . checkUUID) (strOption 		( long "uuid" <> metavar paramUUID 		<> help "local repository uuid" 		))-	: commonGlobalOptions+	: commonOptions   where 	checkUUID expected = getUUID >>= check 	  where
− CmdLine/GlobalSetter.hs
@@ -1,36 +0,0 @@-{- git-annex global options- -- - Copyright 2015-2021 Joey Hess <id@joeyh.name>- -- - Licensed under the GNU AGPL version 3 or higher.-  -}-  -module CmdLine.GlobalSetter where--import Common-import Annex-import Types.DeferredParse--import Options.Applicative--setAnnexState :: Annex () -> GlobalSetter-setAnnexState a = GlobalSetter a id--setAnnexRead :: (AnnexRead -> AnnexRead) -> GlobalSetter-setAnnexRead f = GlobalSetter (return ()) f--globalFlag :: GlobalSetter -> Mod FlagFields GlobalSetter -> GlobalOption-globalFlag = flag'--globalOption :: (v -> GlobalSetter) -> Parser v -> GlobalOption-globalOption mk parser = mk <$> parser---- | Combines a bunch of GlobalOptions together into a Parser--- that returns a GlobalSetter that can be used to set all the options that--- are enabled.-parserGlobalOptions :: [GlobalOption] -> Parser GlobalSetter-parserGlobalOptions [] = pure mempty-parserGlobalOptions l = mconcat <$> many (foldl1 (<|>) l)--applyAnnexReadSetter :: GlobalSetter -> (AnnexState, AnnexRead) -> (AnnexState, AnnexRead)-applyAnnexReadSetter gs (st, rd) = (st, annexReadSetter gs rd)
CmdLine/Option.hs view
@@ -11,8 +11,7 @@  import Options.Applicative -import CmdLine.Usage-import CmdLine.GlobalSetter+import CmdLine.AnnexSetter import qualified Annex import Types.Messages import Types.DeferredParse@@ -22,58 +21,50 @@ import Utility.FileSystemEncoding import Annex.Debug --- Global options accepted by both git-annex and git-annex-shell sub-commands.-commonGlobalOptions :: [GlobalOption]-commonGlobalOptions =-	[ globalFlag (setAnnexState $ setforce True)+-- Options accepted by both git-annex and git-annex-shell sub-commands.+commonOptions :: [AnnexOption]+commonOptions =+	[ annexFlag (setforce True) 		( long "force"  		<> help "allow actions that may lose annexed data" 		<> hidden 		)-	, globalFlag (setAnnexState $ setfast True)+	, annexFlag (setfast True) 		( long "fast" <> short 'F' 		<> help "avoid slow operations" 		<> hidden 		)-	, globalFlag (setAnnexState $ Annex.setOutput QuietOutput)+	, annexFlag (setAnnexState $ Annex.setOutput QuietOutput) 		( long "quiet" <> short 'q' 		<> help "avoid verbose output" 		<> hidden 		)-	, globalFlag (setAnnexState $ Annex.setOutput NormalOutput)+	, annexFlag (setAnnexState $ Annex.setOutput NormalOutput) 		( long "verbose" <> short 'v' 		<> help "allow verbose output (default)" 		<> hidden 		)-	, globalFlag (setdebug True)+	, annexFlag (setdebug True) 		( long "debug" <> short 'd' 		<> help "show debug messages" 		<> hidden 		)-	, globalFlag (setdebug False)+	, annexFlag (setdebug False) 		( long "no-debug" 		<> help "don't show debug messages" 		<> hidden 		)-	, globalOption setdebugfilter $ strOption+	, annexOption setdebugfilter $ strOption 		( long "debugfilter" <> metavar "NAME[,NAME..]" 		<> help "show debug messages coming from a module" 		<> hidden 		)-	, globalOption setforcebackend $ strOption-		( long "backend" <> short 'b' <> metavar paramName-		<> help "specify key-value backend to use"-		<> hidden-		) 	]   where-	setforce v = Annex.changeState $ \s -> s { Annex.force = v }+	setforce v = setAnnexRead $ \rd -> rd { Annex.force = v } -	setfast v = Annex.changeState $ \s -> s { Annex.fast = v }+	setfast v = setAnnexRead $ \rd -> rd { Annex.fast = v } -	setforcebackend v = setAnnexState $-		Annex.changeState $ \s -> s { Annex.forcebackend = Just v }-	 	setdebug v = mconcat 		[ setAnnexRead $ \rd -> rd { Annex.debugenabled = v } 		-- Also set in git config so it will be passed on to any
CmdLine/Seek.hs view
@@ -64,7 +64,7 @@ 	seekHelper fst3 ww LsFiles.inRepoDetails l  withFilesInGitAnnexNonRecursive :: WarnUnmatchWhen -> String -> AnnexedFileSeeker -> WorkTreeItems -> CommandSeek-withFilesInGitAnnexNonRecursive ww needforce a (WorkTreeItems l) = ifM (Annex.getState Annex.force)+withFilesInGitAnnexNonRecursive ww needforce a (WorkTreeItems l) = ifM (Annex.getRead Annex.force) 	( withFilesInGitAnnex ww a (WorkTreeItems l) 	, if null l 		then giveup needforce@@ -90,7 +90,7 @@  withFilesNotInGit :: CheckGitIgnore -> WarnUnmatchWhen -> ((SeekInput, RawFilePath) -> CommandSeek) -> WorkTreeItems -> CommandSeek withFilesNotInGit (CheckGitIgnore ci) ww a l = do-	force <- Annex.getState Annex.force+	force <- Annex.getRead Annex.force 	let include_ignored = force || not ci 	seekFiltered (const (pure True)) a $ 		seekHelper id ww (const $ LsFiles.notInRepo [] include_ignored) l
Command.hs view
@@ -18,7 +18,7 @@ import CmdLine.Usage as ReExported import CmdLine.Action as ReExported import CmdLine.Option as ReExported-import CmdLine.GlobalSetter as ReExported+import CmdLine.AnnexSetter as ReExported import CmdLine.GitAnnex.Options as ReExported import CmdLine.Batch as ReExported import Options.Applicative as ReExported hiding (command)@@ -69,9 +69,9 @@ noRepo :: (String -> Parser (IO ())) -> Command -> Command noRepo a c = c { cmdnorepo = Just (a (cmdparamdesc c)) } -{- Adds global options to a command. -}-withGlobalOptions :: [[GlobalOption]] -> Command -> Command-withGlobalOptions os c = c { cmdglobaloptions = cmdglobaloptions c ++ concat os }+{- Adds Annex options to a command. -}+withAnnexOptions :: [[AnnexOption]] -> Command -> Command+withAnnexOptions os c = c { cmdannexoptions = cmdannexoptions c ++ concat os }  {- For start stage to indicate what will be done. -} starting:: MkActionItem actionitem => String -> actionitem -> SeekInput -> CommandPerform -> CommandStart
Command/Add.hs view
@@ -30,16 +30,17 @@ import qualified Utility.RawFilePath as R import qualified System.FilePath.ByteString as P -import System.PosixCompat.Files+import System.PosixCompat.Files (fileSize)  cmd :: Command cmd = notBareRepo $ -	withGlobalOptions opts $+	withAnnexOptions opts $ 		command "add" SectionCommon "add files to annex" 			paramPaths (seek <$$> optParser)   where 	opts =-		[ jobsOption+		[ backendOption+		, jobsOption 		, jsonOptions 		, jsonProgressOption 		, fileMatchingOptions LimitDiskFiles@@ -89,7 +90,7 @@ 			s <- liftIO $ R.getSymbolicLinkStatus file 			ifM (pure (annexdotfiles || not (dotfile file)) 				<&&> (checkFileMatcher largematcher file -				<||> Annex.getState Annex.force))+				<||> Annex.getRead Annex.force)) 				( start si file addunlockedmatcher 				, if includingsmall 					then ifM (annexAddSmallFiles <$> Annex.getGitConfig)@@ -209,7 +210,7 @@ 		starting "add" (ActionItemTreeFile file) si $ 			addingExistingLink file key $ 				withOtherTmp $ \tmp -> do-					let tmpf = tmp P.</> file+					let tmpf = tmp P.</> P.takeFileName file 					liftIO $ moveFile file tmpf 					ifM (isSymbolicLink <$> liftIO (R.getSymbolicLinkStatus tmpf)) 						( do
Command/AddUrl.hs view
@@ -37,7 +37,12 @@ import qualified System.FilePath.ByteString as P  cmd :: Command-cmd = notBareRepo $ withGlobalOptions [jobsOption, jsonOptions, jsonProgressOption] $+cmd = notBareRepo $ withAnnexOptions +	[ jobsOption+	, jsonOptions+	, jsonProgressOption+	, backendOption+	] $ 	command "addurl" SectionCommon "add urls to annex" 		(paramRepeating paramUrl) (seek <$$> optParser) @@ -191,7 +196,7 @@ downloadRemoteFile addunlockedmatcher r o uri file sz = checkCanAdd o file $ \canadd -> do 	let urlkey = Backend.URL.fromUrl uri sz 	createWorkTreeDirectory (parentDir file)-	ifM (Annex.getState Annex.fast <||> pure (relaxedOption o))+	ifM (Annex.getRead Annex.fast <||> pure (relaxedOption o)) 		( do 			addWorkTree canadd addunlockedmatcher (Remote.uuid r) loguri file urlkey Nothing 			return (Just urlkey)@@ -305,7 +310,7 @@  -} addUrlFile :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> RawFilePath -> Annex (Maybe Key) addUrlFile addunlockedmatcher o url urlinfo file =-	ifM (Annex.getState Annex.fast <||> pure (relaxedOption o))+	ifM (Annex.getRead Annex.fast <||> pure (relaxedOption o)) 		( nodownloadWeb addunlockedmatcher o url urlinfo file 		, downloadWeb addunlockedmatcher o url urlinfo file 		)
Command/CalcKey.hs view
@@ -14,10 +14,11 @@  cmd :: Command cmd = noCommit $ noMessages $ dontCheck repoExists $-	command "calckey" SectionPlumbing -		"calulate key for a file"-		(paramRepeating paramFile)-		(batchable run (pure ()))+	withAnnexOptions [backendOption] $+		command "calckey" SectionPlumbing +			"calulate key for a file"+			(paramRepeating paramFile)+			(batchable run (pure ()))  run :: () -> SeekInput -> String -> Annex Bool run _ _ file = tryNonAsync (genKey ks nullMeterUpdate Nothing) >>= \case
Command/Copy.hs view
@@ -14,7 +14,7 @@ import Annex.NumCopies  cmd :: Command-cmd = withGlobalOptions [jobsOption, jsonOptions, jsonProgressOption, annexedMatchingOptions] $+cmd = withAnnexOptions [jobsOption, jsonOptions, jsonProgressOption, annexedMatchingOptions] $ 	command "copy" SectionCommon 		"copy content of files to/from another repository" 		paramPaths (seek <--< optParser)
Command/Drop.hs view
@@ -22,7 +22,7 @@ import Annex.Notification  cmd :: Command-cmd = withGlobalOptions [jobsOption, jsonOptions, annexedMatchingOptions] $+cmd = withAnnexOptions [jobsOption, jsonOptions, annexedMatchingOptions] $ 	command "drop" SectionCommon 		"remove content of files from repository" 		paramPaths (seek <$$> optParser)@@ -201,7 +201,7 @@ 	-> (Maybe SafeDropProof -> CommandPerform, CommandPerform) 	-> CommandPerform doDrop pcc dropfrom contentlock key afile numcopies mincopies skip preverified check (dropaction, nodropaction) = -	ifM (Annex.getState Annex.force)+	ifM (Annex.getRead Annex.force) 		( dropaction Nothing 		, ifM (checkRequiredContent pcc dropfrom key afile) 			( verifyEnoughCopiesToDrop nolocmsg key 
Command/DropKey.hs view
@@ -13,7 +13,7 @@ import Annex.Content  cmd :: Command-cmd = noCommit $ withGlobalOptions [jsonOptions] $+cmd = noCommit $ withAnnexOptions [jsonOptions] $ 	command "dropkey" SectionPlumbing 		"drops annexed content for specified keys" 		(paramRepeating paramKey)@@ -31,7 +31,7 @@  seek :: DropKeyOptions -> CommandSeek seek o = do-	unlessM (Annex.getState Annex.force) $+	unlessM (Annex.getRead Annex.force) $ 		giveup "dropkey can cause data loss; use --force if you're sure you want to do this" 	case batchOption o of 		NoBatch -> withKeys (commandAction . start) (toDrop o)
Command/DropUnused.hs view
@@ -53,7 +53,7 @@ 	Nothing -> ifM (inAnnex key) 		( droplocal 		, ifM (objectFileExists key)-			( ifM (Annex.getState Annex.force)+			( ifM (Annex.getRead Annex.force) 				( droplocal 				, do 					warning "Annexed object has been modified and dropping it would probably lose the only copy. Run this command with --force if you want to drop it anyway."
Command/ExamineKey.hs view
@@ -20,7 +20,7 @@  cmd :: Command cmd = noCommit $ noMessages $ dontCheck repoExists $ -	withGlobalOptions [jsonOptions] $+	withAnnexOptions [jsonOptions] $ 		command "examinekey" SectionPlumbing  			"prints information from a key" 			(paramRepeating paramKey)
Command/Export.hs view
@@ -44,7 +44,7 @@ import Control.Concurrent  cmd :: Command-cmd = withGlobalOptions [jobsOption, jsonOptions, jsonProgressOption] $+cmd = withAnnexOptions [jobsOption, jsonOptions, jsonProgressOption] $ 	command "export" SectionCommon 		"export a tree of files to a special remote" 		paramTreeish (seek <$$> optParser)@@ -96,7 +96,7 @@ 	db <- openDb (uuid r) 	writeLockDbWhile db $ do 		changeExport r db tree-		unlessM (Annex.getState Annex.fast) $ do+		unlessM (Annex.getRead Annex.fast) $ do 			void $ fillExport r db tree mtbcommitsha 	closeDb db @@ -518,9 +518,7 @@ 				Nothing 					| issymlink -> catKey sha >>= \case 						Just _ -> return (Just ti)-						Nothing-							| issymlink -> excluded-							| otherwise -> return (Just ti)+						Nothing -> excluded 					| otherwise -> return (Just ti) 				Just matcher -> catKey sha >>= \case 					Just k -> checkmatcher matcher k
Command/FilterBranch.hs view
@@ -36,7 +36,7 @@ import qualified System.FilePath.ByteString as P  cmd :: Command-cmd = noMessages $ withGlobalOptions [annexedMatchingOptions] $ +cmd = noMessages $ withAnnexOptions [annexedMatchingOptions] $  	command "filter-branch" SectionMaintenance  		"filter information from the git-annex branch" 		paramPaths (seek <$$> optParser)
Command/Find.hs view
@@ -21,12 +21,12 @@ import Utility.DataUnits  cmd :: Command-cmd = notBareRepo $ withGlobalOptions [annexedMatchingOptions] $ mkCommand $+cmd = notBareRepo $ withAnnexOptions [annexedMatchingOptions] $ mkCommand $ 	command "find" SectionQuery "lists available files" 		paramPaths (seek <$$> optParser)  mkCommand :: Command -> Command-mkCommand = noCommit . noMessages . withGlobalOptions [jsonOptions]+mkCommand = noCommit . noMessages . withAnnexOptions [jsonOptions]  data FindOptions = FindOptions 	{ findThese :: CmdParams
Command/FindRef.hs view
@@ -12,7 +12,7 @@ import qualified Git  cmd :: Command-cmd = withGlobalOptions [annexedMatchingOptions] $ Find.mkCommand $ +cmd = withAnnexOptions [annexedMatchingOptions] $ Find.mkCommand $  	command "findref" SectionPlumbing 		"lists files in a git ref (deprecated)" 		paramRef (seek <$$> Find.optParser)
Command/Fix.hs view
@@ -25,7 +25,7 @@ #endif  cmd :: Command-cmd = noCommit $ withGlobalOptions [annexedMatchingOptions] $+cmd = noCommit $ withAnnexOptions [annexedMatchingOptions] $ 	command "fix" SectionMaintenance 		"fix up links to annexed content" 		paramPaths (withParams seek)
Command/Forget.hs view
@@ -40,7 +40,7 @@ 	let ts = if dropDead o 		then addTransition c ForgetDeadRemotes basets 		else basets-	perform ts =<< Annex.getState Annex.force+	perform ts =<< Annex.getRead Annex.force   where 	ai = ActionItemOther (Just (fromRef Branch.name)) 	si = SeekInput []
Command/FromKey.hs view
@@ -22,7 +22,7 @@ import Network.URI  cmd :: Command-cmd = notBareRepo $ withGlobalOptions [jsonOptions] $+cmd = notBareRepo $ withAnnexOptions [jsonOptions] $ 	command "fromkey" SectionPlumbing "adds a file using a specific key" 		(paramRepeating (paramPair paramKey paramPath)) 		(seek <$$> optParser)@@ -46,7 +46,7 @@ 		-- older way of enabling batch input, does not support BatchNull 		(NoBatch, []) -> seekBatch matcher (BatchFormat BatchLine (BatchKeys False)) 		(NoBatch, ps) -> do-			force <- Annex.getState Annex.force+			force <- Annex.getRead Annex.force 			withPairs (commandAction . start matcher force) ps  seekBatch :: AddUnlockedMatcher -> BatchFormat -> CommandSeek
Command/Fsck.hs view
@@ -51,7 +51,7 @@ import qualified System.FilePath.ByteString as P  cmd :: Command-cmd = withGlobalOptions [jobsOption, jsonOptions, annexedMatchingOptions] $+cmd = withAnnexOptions [jobsOption, jsonOptions, annexedMatchingOptions] $ 	command "fsck" SectionMaintenance 		"find and fix problems" 		paramPaths (seek <$$> optParser)@@ -164,7 +164,7 @@ 			Nothing -> go True Nothing 			Just (Right verification) -> go True (Just (tmpfile, verification)) 			Just (Left _) -> do-				warning "failed to download file from remote"+				warning (decodeBS (actionItemDesc ai) ++ ": failed to download file from remote") 				void $ go True Nothing 				return False 	dispatch (Right False) = go False Nothing@@ -195,7 +195,7 @@ 	getfile tmp = ifM (checkDiskSpace (Just (P.takeDirectory tmp)) key 0 True) 		( ifM (getcheap tmp) 			( return (Just (Right UnVerified))-			, ifM (Annex.getState Annex.fast)+			, ifM (Annex.getRead Annex.fast) 				( return Nothing 				, Just <$> tryNonAsync (getfile' tmp) 				)
Command/FuzzTest.hs view
@@ -181,11 +181,11 @@ runFuzzAction (FuzzDelete (FuzzFile f)) = liftIO $ 	removeWhenExistsWith R.removeLink (toRawFilePath f) runFuzzAction (FuzzMove (FuzzFile src) (FuzzFile dest)) = liftIO $-	rename src dest+	R.rename (toRawFilePath src) (toRawFilePath dest) runFuzzAction (FuzzDeleteDir (FuzzDir d)) = liftIO $ 	removeDirectoryRecursive d runFuzzAction (FuzzMoveDir (FuzzDir src) (FuzzDir dest)) = liftIO $-	rename src dest+	R.rename (toRawFilePath src) (toRawFilePath dest) runFuzzAction (FuzzPause d) = randomDelay d  genFuzzAction :: Annex FuzzAction
Command/Get.hs view
@@ -15,7 +15,7 @@ import qualified Command.Move  cmd :: Command-cmd = withGlobalOptions [jobsOption, jsonOptions, jsonProgressOption, annexedMatchingOptions] $ +cmd = withAnnexOptions [jobsOption, jsonOptions, jsonProgressOption, annexedMatchingOptions] $  	command "get" SectionCommon  		"make content of annexed files available" 		paramPaths (seek <$$> optParser)
Command/Import.hs view
@@ -40,14 +40,15 @@  cmd :: Command cmd = notBareRepo $-	withGlobalOptions opts $+	withAnnexOptions opts $ 		command "import" SectionCommon  			"add a tree of files to the repository" 			(paramPaths ++ "|BRANCH") 			(seek <$$> optParser)   where 	opts =-		[ jobsOption+		[ backendOption+		, jobsOption 		, jsonOptions 		, jsonProgressOption 		-- These options are only used when importing from a@@ -173,13 +174,13 @@ 					Nothing -> importfilechecked ld k 					Just s 						| isDirectory s -> notoverwriting "(is a directory)"-						| isSymbolicLink s -> ifM (Annex.getState Annex.force)+						| isSymbolicLink s -> ifM (Annex.getRead Annex.force) 							( do 								liftIO $ removeWhenExistsWith R.removeLink destfile 								importfilechecked ld k 							, notoverwriting "(is a symlink)" 							)-						| otherwise -> ifM (Annex.getState Annex.force)+						| otherwise -> ifM (Annex.getRead Annex.force) 							( do 								liftIO $ removeWhenExistsWith R.removeLink destfile 								importfilechecked ld k
Command/ImportFeed.hs view
@@ -51,7 +51,7 @@ import Logs  cmd :: Command-cmd = notBareRepo $+cmd = notBareRepo $ withAnnexOptions [backendOption] $ 	command "importfeed" SectionCommon "import files from podcast feeds" 		(paramRepeating paramUrl) (seek <$$> optParser) @@ -135,7 +135,7 @@ 	}  getCache :: Maybe String -> Annex Cache-getCache opttemplate = ifM (Annex.getState Annex.force)+getCache opttemplate = ifM (Annex.getRead Annex.force) 	( ret S.empty S.empty 	, do 		showStart "importfeed" "gathering known urls" (SeekInput [])@@ -246,12 +246,12 @@ 		-- to avoid adding it a second time. 		let quviurl = setDownloader linkurl QuviDownloader 		checkknown mediaurl $ checkknown quviurl $-			ifM (Annex.getState Annex.fast <||> pure (relaxedOption (downloadOptions opts)))+			ifM (Annex.getRead Annex.fast <||> pure (relaxedOption (downloadOptions opts))) 				( addmediafast linkurl mediaurl mediakey 				, downloadmedia linkurl mediaurl mediakey 				)   where-	forced = Annex.getState Annex.force+	forced = Annex.getRead Annex.force  	{- Avoids downloading any items that are already known to be 	 - associated with a file in the annex, unless forced. -}
Command/Info.hs view
@@ -97,7 +97,7 @@ type StatState = StateT StatInfo Annex  cmd :: Command-cmd = noCommit $ withGlobalOptions [jsonOptions, annexedMatchingOptions] $+cmd = noCommit $ withAnnexOptions [jsonOptions, annexedMatchingOptions] $ 	command "info" SectionQuery 		"information about an item or the repository" 		(paramRepeating paramItem) (seek <$$> optParser)@@ -238,7 +238,7 @@  selStats :: [Stat] -> [Stat] -> Annex [Stat] selStats fast_stats slow_stats = do-	fast <- Annex.getState Annex.fast+	fast <- Annex.getRead Annex.fast 	return $ if fast 		then fast_stats 		else fast_stats ++ slow_stats@@ -597,7 +597,7 @@  getDirStatInfo :: InfoOptions -> FilePath -> Annex StatInfo getDirStatInfo o dir = do-	fast <- Annex.getState Annex.fast+	fast <- Annex.getRead Annex.fast 	matcher <- Limit.getMatcher 	(presentdata, referenceddata, numcopiesstats, repodata) <- 		Command.Unused.withKeysFilesReferencedIn dir initial@@ -625,7 +625,7 @@  getTreeStatInfo :: InfoOptions -> Git.Ref -> Annex (Maybe StatInfo) getTreeStatInfo o r = do-	fast <- Annex.getState Annex.fast+	fast <- Annex.getRead Annex.fast 	-- git lstree filenames start with a leading "./" that prevents 	-- matching, and also things like --include are supposed to 	-- match relative to the current directory, which does not make
Command/List.hs view
@@ -22,7 +22,7 @@ import Utility.Tuple  cmd :: Command-cmd = noCommit $ withGlobalOptions [annexedMatchingOptions] $+cmd = noCommit $ withAnnexOptions [annexedMatchingOptions] $ 	command "list" SectionQuery  		"show which remotes contain files" 		paramPaths (seek <$$> optParser)
Command/Lock.hs view
@@ -22,7 +22,7 @@ import qualified Utility.RawFilePath as R 	 cmd :: Command-cmd = withGlobalOptions [jsonOptions, annexedMatchingOptions] $+cmd = withAnnexOptions [jsonOptions, annexedMatchingOptions] $ 	command "lock" SectionCommon 		"undo unlock command" 		paramPaths (withParams seek)@@ -50,7 +50,7 @@ 	go Nothing =  		ifM (isUnmodified key file) 			( cont-			, ifM (Annex.getState Annex.force)+			, ifM (Annex.getRead Annex.force) 				( cont 				, errorModified 				)
Command/Log.hs view
@@ -36,7 +36,7 @@ type Outputter = LogChange -> POSIXTime -> [UUID] -> Annex ()  cmd :: Command-cmd = withGlobalOptions [annexedMatchingOptions] $+cmd = withAnnexOptions [annexedMatchingOptions] $ 	command "log" SectionQuery "shows location log" 		paramPaths (seek <$$> optParser) 
Command/Map.hs view
@@ -52,7 +52,7 @@  	liftIO $ writeFile file (drawMap rs trustmap umap) 	next $-		ifM (Annex.getState Annex.fast)+		ifM (Annex.getRead Annex.fast) 			( runViewer file [] 			, runViewer file 	 			[ ("xdot", [File file])
Command/MetaData.hs view
@@ -25,7 +25,7 @@ import Control.Concurrent  cmd :: Command-cmd = withGlobalOptions [jsonOptions, annexedMatchingOptions] $ +cmd = withAnnexOptions [jsonOptions, annexedMatchingOptions] $  	command "metadata" SectionMetaData 		"sets or gets metadata of a file" 		paramPaths (seek <$$> optParser)
Command/Migrate.hs view
@@ -20,7 +20,7 @@ import Utility.Metered  cmd :: Command-cmd = withGlobalOptions [annexedMatchingOptions] $+cmd = withAnnexOptions [backendOption, annexedMatchingOptions] $ 	command "migrate" SectionUtility  		"switch data to different backend" 		paramPaths (seek <$$> optParser)@@ -50,7 +50,7 @@  start :: MigrateOptions -> SeekInput -> RawFilePath -> Key -> CommandStart start o si file key = do-	forced <- Annex.getState Annex.force+	forced <- Annex.getRead Annex.force 	v <- Backend.getBackend (fromRawFilePath file) key 	case v of 		Nothing -> stop
Command/Mirror.hs view
@@ -17,7 +17,7 @@ import Types.Transfer  cmd :: Command-cmd = withGlobalOptions [jobsOption, jsonOptions, jsonProgressOption, annexedMatchingOptions] $+cmd = withAnnexOptions [jobsOption, jsonOptions, jsonProgressOption, annexedMatchingOptions] $ 	command "mirror" SectionCommon  		"mirror content of files to/from another repository" 		paramPaths (seek <--< optParser)
Command/Move.hs view
@@ -25,7 +25,7 @@ import qualified Data.ByteString.Lazy as L  cmd :: Command-cmd = withGlobalOptions [jobsOption, jsonOptions, jsonProgressOption, annexedMatchingOptions] $+cmd = withAnnexOptions [jobsOption, jsonOptions, jsonProgressOption, annexedMatchingOptions] $ 	command "move" SectionCommon 		"move content of files to/from another repository" 		paramPaths (seek <--< optParser)@@ -118,7 +118,7 @@  toStart' :: Remote -> RemoveWhen -> AssociatedFile -> Key -> ActionItem -> SeekInput -> CommandStart toStart' dest removewhen afile key ai si = do-	fast <- Annex.getState Annex.fast+	fast <- Annex.getRead Annex.fast 	if fast && removewhen == RemoveNever 		then ifM (expectedPresent dest key) 			( stop@@ -334,7 +334,7 @@ 		, unlessforced DropWorse 		)   where-	unlessforced r = ifM (Annex.getState Annex.force)+	unlessforced r = ifM (Annex.getRead Annex.force) 		( return DropAllowed 		, return r 		)
Command/Multicast.hs view
@@ -216,7 +216,7 @@ 		Just k -> void $ logStatusAfter k $ 			getViaTmpFromDisk RetrievalVerifiableKeysSecure AlwaysVerify k (AssociatedFile Nothing) $ \dest -> unVerified $ 				liftIO $ catchBoolIO $ do-					rename f (fromRawFilePath dest)+					R.rename (toRawFilePath f) dest 					return True  -- Under Windows, uftp uses key containers, which are not files on the
Command/ReKey.hs view
@@ -75,7 +75,7 @@ 	ifM (inAnnex oldkey)  		( unlessM (linkKey file oldkey newkey) $ 			giveup "failed creating link from old to new key"-		, unlessM (Annex.getState Annex.force) $+		, unlessM (Annex.getRead Annex.force) $ 			giveup $ fromRawFilePath file ++ " is not available (use --force to override)" 		) 	next $ cleanup file newkey
Command/RegisterUrl.hs view
@@ -13,7 +13,7 @@ import qualified Remote  cmd :: Command-cmd = withGlobalOptions [jsonOptions] $ command "registerurl"+cmd = withAnnexOptions [jsonOptions] $ command "registerurl" 	SectionPlumbing "registers an url for a key" 	(paramPair paramKey paramUrl) 	(seek <$$> optParser)
Command/Reinject.hs view
@@ -16,10 +16,11 @@ import qualified Git  cmd :: Command-cmd = command "reinject" SectionUtility -	"inject content of file back into annex"-	(paramRepeating (paramPair "SRC" "DEST"))-	(seek <$$> optParser)+cmd = withAnnexOptions [backendOption] $+	command "reinject" SectionUtility +		"inject content of file back into annex"+		(paramRepeating (paramPair "SRC" "DEST"))+		(seek <$$> optParser)  data ReinjectOptions = ReinjectOptions 	{ params :: CmdParams
Command/Repair.hs view
@@ -27,7 +27,7 @@  start :: CommandStart start = starting "repair" (ActionItemOther Nothing) (SeekInput []) $ -	next $ runRepair =<< Annex.getState Annex.force+	next $ runRepair =<< Annex.getRead Annex.force  runRepair :: Bool -> Annex Bool runRepair forced = do
Command/Status.hs view
@@ -13,7 +13,7 @@  cmd :: Command cmd = notBareRepo $ noCommit $ noMessages $-	withGlobalOptions [jsonOptions] $+	withAnnexOptions [jsonOptions] $ 		command "status" SectionCommon 			"show the working tree status" 			paramPaths (seek <$$> optParser)
Command/Sync.hs view
@@ -83,7 +83,7 @@ import Data.Char  cmd :: Command-cmd = withGlobalOptions [jobsOption] $+cmd = withAnnexOptions [jobsOption, backendOption] $ 	command "sync" SectionCommon  		"synchronize local repository with remotes" 		(paramRepeating paramRemote) (seek <--< optParser)@@ -324,7 +324,7 @@  syncRemotes' :: [String] -> [Remote] -> Annex [Remote] syncRemotes' ps available = -	ifM (Annex.getState Annex.fast) ( fastest <$> wanted , wanted )+	ifM (Annex.getRead Annex.fast) ( fastest <$> wanted , wanted )   where 	wanted 		| null ps = filterM good (concat $ Remote.byCost available)
Command/TestRemote.hs view
@@ -74,7 +74,7 @@  start :: TestRemoteOptions -> CommandStart start o = starting "testremote" (ActionItemOther (Just (testRemote o))) si $ do-	fast <- Annex.getState Annex.fast+	fast <- Annex.getRead Annex.fast 	cache <- liftIO newRemoteVariantCache 	r <- either giveup (disableExportTree cache) 		=<< Remote.byName' (testRemote o)
Command/Trust.hs view
@@ -33,7 +33,7 @@ 		starting c (ActionItemOther (Just name)) si (perform name u) 	perform name uuid = do 		when (level >= Trusted) $-			unlessM (Annex.getState Annex.force) $+			unlessM (Annex.getRead Annex.force) $ 				giveup $ trustedNeedsForce name 		trustSet uuid level 		when (level == DeadTrusted) $
Command/Unannex.hs view
@@ -20,30 +20,30 @@ import qualified Utility.RawFilePath as R  cmd :: Command-cmd = withGlobalOptions [annexedMatchingOptions] $+cmd = withAnnexOptions [annexedMatchingOptions] $ 	command "unannex" SectionUtility 		"undo accidental add command" 		paramPaths (withParams seek)  seek :: CmdParams -> CommandSeek-seek ps = withFilesInGitAnnex ww seeker =<< workTreeItems ww ps+seek ps = withFilesInGitAnnex ww (seeker False) =<< workTreeItems ww ps   where 	ww = WarnUnmatchLsFiles -seeker :: AnnexedFileSeeker-seeker = AnnexedFileSeeker-	{ startAction = start+seeker :: Bool -> AnnexedFileSeeker+seeker fast = AnnexedFileSeeker+	{ startAction = start fast 	, checkContentPresent = Just True 	, usesLocationLog = False 	} -start :: SeekInput -> RawFilePath -> Key -> CommandStart-start si file key = +start :: Bool -> SeekInput -> RawFilePath -> Key -> CommandStart+start fast si file key =  	starting "unannex" (mkActionItem (key, file)) si $-		perform file key+		perform fast file key -perform :: RawFilePath -> Key -> CommandPerform-perform file key = do+perform :: Bool -> RawFilePath -> Key -> CommandPerform+perform fast file key = do 	Annex.Queue.addCommand [] "rm" 		[ Param "--cached" 		, Param "--force"@@ -58,7 +58,7 @@ 		-- (cached in git). 		Just key' -> do 			cleanupdb-			next $ cleanup file key'+			next $ cleanup fast file key' 		-- If the file is unlocked, it can be unmodified or not and 		-- does not need to be replaced either way. 		Nothing -> do@@ -71,11 +71,11 @@ 		maybe noop Database.Keys.removeInodeCache 			=<< withTSDelta (liftIO . genInodeCache file) -cleanup :: RawFilePath -> Key -> CommandCleanup-cleanup file key = do+cleanup :: Bool -> RawFilePath -> Key -> CommandCleanup+cleanup fast file key = do 	liftIO $ removeFile (fromRawFilePath file) 	src <- calcRepo (gitAnnexLocation key)-	ifM (Annex.getState Annex.fast)+	ifM (pure fast <||> Annex.getRead Annex.fast) 		( do 			-- Only make a hard link if the annexed file does not 			-- already have other hard links pointing at it. This
Command/Uninit.hs view
@@ -8,7 +8,6 @@ module Command.Uninit where  import Command-import qualified Annex import qualified Git import qualified Git.Command import qualified Git.Ref@@ -54,8 +53,7 @@ 		WarnUnmatchWorkTreeItems  		(\(_, f) -> commandAction $ whenAnnexed (startCheckIncomplete . fromRawFilePath) f) 		l-	Annex.changeState $ \s -> s { Annex.fast = True }-	withFilesInGitAnnex ww Command.Unannex.seeker l+	withFilesInGitAnnex ww (Command.Unannex.seeker True) l 	finish   where 	ww = WarnUnmatchLsFiles
Command/Unlock.hs view
@@ -25,7 +25,7 @@ editcmd = mkcmd "edit" "same as unlock"  mkcmd :: String -> String -> Command-mkcmd n d = withGlobalOptions [jsonOptions, annexedMatchingOptions] $+mkcmd n d = withAnnexOptions [jsonOptions, annexedMatchingOptions] $ 	command n SectionCommon d paramPaths (withParams seek)  seek :: CmdParams -> CommandSeek
Command/UnregisterUrl.hs view
@@ -14,7 +14,7 @@ import Command.RegisterUrl (seekBatch, start, optParser, RegisterUrlOptions(..))  cmd :: Command-cmd = withGlobalOptions [jsonOptions] $ command "unregisterurl"+cmd = withAnnexOptions [jsonOptions] $ command "unregisterurl" 	SectionPlumbing "unregisters an url for a key" 	(paramPair paramKey paramUrl) 	(seek <$$> optParser)
Command/Unused.hs view
@@ -77,7 +77,7 @@  checkUnused :: RefSpec -> CommandPerform checkUnused refspec = chain 0-	[ check "" unusedMsg $ findunused =<< Annex.getState Annex.fast+	[ check "" unusedMsg $ findunused =<< Annex.getRead Annex.fast 	, check "bad" staleBadMsg $ staleKeysPrune gitAnnexBadDir False 	, check "tmp" staleTmpMsg $ staleKeysPrune gitAnnexTmpObjectDir True 	]
Command/WhereUsed.hs view
@@ -24,7 +24,7 @@ import qualified Data.ByteString.Lazy as L  cmd :: Command-cmd = noCommit $ withGlobalOptions [annexedMatchingOptions] $+cmd = noCommit $ withAnnexOptions [annexedMatchingOptions] $ 	command "whereused" SectionQuery 		"lists repositories that have file content" 		paramNothing (seek <$$> optParser)
Command/Whereis.hs view
@@ -23,7 +23,7 @@ import qualified Data.Vector as V  cmd :: Command-cmd = noCommit $ withGlobalOptions [jsonOptions, annexedMatchingOptions] $+cmd = noCommit $ withAnnexOptions [jsonOptions, annexedMatchingOptions] $ 	command "whereis" SectionQuery 		"lists repositories that have file content" 		paramPaths (seek <$$> optParser)
Common.hs view
@@ -13,7 +13,7 @@ import System.FilePath as X import System.IO as X hiding (FilePath) import System.Exit as X-import System.PosixCompat.Files as X hiding (fileSize, removeLink)+import System.PosixCompat.Files as X hiding (fileSize, removeLink, rename)  import Utility.Misc as X import Utility.Exception as X
Database/Init.hs view
@@ -45,7 +45,7 @@ 	setAnnexFilePerm tmpdb 	liftIO $ do 		void $ tryIO $ removeDirectoryRecursive (fromRawFilePath dbdir)-		rename (fromRawFilePath tmpdbdir) (fromRawFilePath dbdir)+		R.rename tmpdbdir dbdir  {- Make sure that the database uses WAL mode, to prevent readers  - from blocking writers, and prevent a writer from blocking readers.
Git/FilterProcess.hs view
@@ -162,7 +162,9 @@ 	send b' =  		let (pktline, rest) = encodePktLine b' 		in do-			writePktLine stdout pktline+			if isFlushPkt pktline+				then return ()+				else writePktLine stdout pktline 			case rest of 				Just b'' -> send b'' 				Nothing -> writePktLine stdout flushPkt
Logs/Presence.hs view
@@ -6,7 +6,7 @@  - A line of the log will look like: "date N INFO"  - Where N=1 when the INFO is present, 0 otherwise.  - - - Copyright 2010-2021 Joey Hess <id@joeyh.name>+ - Copyright 2010-2022 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -35,10 +35,13 @@  addLog' :: Annex.Branch.RegardingUUID -> RawFilePath -> LogStatus -> LogInfo -> CandidateVectorClock -> Annex () addLog' ru file logstatus loginfo c = -	Annex.Branch.change ru file $ \b ->+	Annex.Branch.changeOrAppend ru file $ \b -> 		let old = parseLog b 		    line = genLine logstatus loginfo c old-		in buildLog $ compactLog (line : old)+		in if isNewInfo line old+			then Annex.Branch.Append $ buildLog [line]+			else Annex.Branch.Change $ buildLog $+				compactLog (line : old)  {- When a LogLine already exists with the same status and info, but an  - older timestamp, that LogLine is preserved, rather than updating the log
Logs/Presence/Pure.hs view
@@ -1,6 +1,6 @@ {- git-annex presence log, pure operations  -- - Copyright 2010-2019 Joey Hess <id@joeyh.name>+ - Copyright 2010-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -90,6 +90,12 @@  logMap :: [LogLine] -> LogMap logMap = foldr insertNewerLogLine M.empty++{- Check if the info of the given line is not in the list of LogLines. -}+isNewInfo :: LogLine -> [LogLine] -> Bool+isNewInfo l old = not (any issame old)+  where+	issame l' = info l' == info l  insertBetter :: (LogLine -> Bool) -> LogLine -> LogMap -> Maybe LogMap insertBetter betterthan l m
Logs/Web.hs view
@@ -57,7 +57,11 @@  setUrlPresent :: Key -> URLString -> Annex () setUrlPresent key url = do-	us <- getUrls key+	-- Avoid reading the url log when not compacting, for speed.+	us <- ifM (annexAlwaysCompact <$> Annex.getGitConfig)+		( getUrls key+		, pure mempty+		) 	unless (url `elem` us) $ do 		config <- Annex.getGitConfig 		addLog (Annex.Branch.RegardingUUID []) (urlLogFile config key)
Remote/Adb.hs view
@@ -46,6 +46,8 @@ 			(FieldDesc "sometimes needed to specify which Android device to use") 		, yesNoParser ignorefinderrorField (Just False) 			(FieldDesc "ignore adb find errors")+		, yesNoParser oldandroidField (Just False)+			(FieldDesc "support old versions of android (slower)") 		] 	, setup = adbSetup 	, exportSupported = exportIsSupported@@ -62,6 +64,8 @@ ignorefinderrorField :: RemoteConfigField ignorefinderrorField = Accepted "ignorefinderror" +oldandroidField :: RemoteConfigField+oldandroidField = Accepted "oldandroid"  gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote) gen r u rc gc rs = do@@ -305,25 +309,43 @@ 		ImportableContents (mapMaybe mk ls) [] 	Nothing -> giveup "adb find failed"   where-	adbfind = adbShell' serial+	adbfind = adbShell' serial findparams+		(\s -> if oldandroid+			then s ++ ignorefinderrorsh+			else concat+				[ "set -o pipefail; "+				, s+				, "| xargs -0 stat -c " ++ shellEscape statformat ++ " --"+				, ignorefinderrorsh+				]+		)+	+	findparams = 		[ Param "find" 		-- trailing slash is needed, or android's find command 		-- won't recurse into the directory 		, File $ fromAndroidPath adir ++ "/" 		, Param "-type", Param "f"-		, Param "-printf", Param "%p\\0"-		] -		(\s -> concat-			[ "set -o pipefail; "-			, s-			, "| xargs -0 stat -c " ++ shellEscape statformat ++ " --"-			, if ignorefinderror then " || true" else ""-			]-		)+		] ++ if oldandroid+			then +				[ Param "-exec"+				, Param "stat"+				, Param "-c"+				, Param statformat+				, Param "{}"+				, Param ";"+				]+			else +				[ Param "-printf"+				, Param "%p\\0"+				]  	ignorefinderror = fromMaybe False (getRemoteConfigValue ignorefinderrorField c)+	oldandroid = fromMaybe False (getRemoteConfigValue oldandroidField c)  	statformat = adbStatFormat ++ "\t%n"++	ignorefinderrorsh = if ignorefinderror then " || true" else ""  	mk ('S':'T':'\t':l) = 		let (stat, fn) = separate (== '\t') l
Remote/Directory.hs view
@@ -514,11 +514,11 @@ 				checkExportContent ii dir loc 					overwritablecids 					(giveup "unsafe to overwrite file")-					(const $ liftIO $ rename tmpf dest)+					(const $ liftIO $ R.rename tmpf' dest) 				return newcid   where-	dest = fromRawFilePath $ exportPath dir loc-	(destdir, base) = splitFileName dest+	dest = exportPath dir loc+	(destdir, base) = splitFileName (fromRawFilePath dest) 	template = relatedTemplate (base ++ ".tmp")  removeExportWithContentIdentifierM :: IgnoreInodes -> RawFilePath -> Key -> ExportLocation -> [ContentIdentifier] -> Annex ()
Remote/Git.hs view
@@ -609,12 +609,12 @@ 		ensureInitialized 		a `finally` stopCoProcesses -data LocalRemoteAnnex = LocalRemoteAnnex Git.Repo (MVar (Maybe (Annex.AnnexState, Annex.AnnexRead)))+data LocalRemoteAnnex = LocalRemoteAnnex Git.Repo (MVar [(Annex.AnnexState, Annex.AnnexRead)])  {- This can safely be called on a Repo that is not local, but of course  - onLocal will not work if used with the result. -} mkLocalRemoteAnnex :: Git.Repo -> Annex (LocalRemoteAnnex)-mkLocalRemoteAnnex repo = LocalRemoteAnnex repo <$> liftIO (newMVar Nothing)+mkLocalRemoteAnnex repo = LocalRemoteAnnex repo <$> liftIO (newMVar [])  {- Runs an action from the perspective of a local remote.  -@@ -645,10 +645,13 @@  onLocal' :: LocalRemoteAnnex -> Annex a -> Annex a onLocal' (LocalRemoteAnnex repo mv) a = liftIO (takeMVar mv) >>= \case-	Nothing -> do+	[] -> do+		liftIO $ putMVar mv [] 		v <- newLocal repo 		go (v, ensureInitialized >> a)-	Just v -> go (v, a)+	(v:rest) -> do+		liftIO $ putMVar mv rest+		go (v, a)   where 	go ((st, rd), a') = do 		curro <- Annex.getState Annex.output@@ -657,7 +660,9 @@ 		(ret, (st', _rd)) <- liftIO $ act `onException` cache (st, rd) 		liftIO $ cache (st', rd) 		return ret-	cache = putMVar mv . Just+	cache v = do+		l <- takeMVar mv+		putMVar mv (v:l)  {- Faster variant of onLocal.  -
Remote/GitLFS.hs view
@@ -149,7 +149,7 @@ 	(c', _encsetup) <- encryptionSetup c gc 	pc <- either giveup return . parseRemoteConfig c' =<< configParser remote c' 	let failinitunlessforced msg = case ss of-		Init -> unlessM (Annex.getState Annex.force) (giveup msg)+		Init -> unlessM (Annex.getRead Annex.force) (giveup msg) 		Enable _ -> noop 		AutoEnable _ -> noop 	case (isEncrypted pc, Git.GCrypt.urlPrefix `isPrefixOf` url) of
Remote/Helper/Encryptable.hs view
@@ -197,7 +197,7 @@ 		cipher <- liftIO a 		showNote (describeCipher cipher) 		return (storeCipher cipher c', EncryptionIsSetup)-	highRandomQuality = ifM (Annex.getState Annex.fast)+	highRandomQuality = ifM (Annex.getRead Annex.fast) 		( return False 		, case parseHighRandomQuality (fromProposedAccepted <$> M.lookup highRandomQualityField c) of 			Left err -> giveup err
Remote/Rsync.hs view
@@ -47,6 +47,7 @@ import Utility.SshHost import Annex.SpecialRemote.Config import Annex.Verify+import qualified Utility.RawFilePath as R  import qualified Data.Map as M @@ -224,7 +225,7 @@ 	basedest = fromRawFilePath $ Prelude.head (keyPaths k) 	populatedest dest = liftIO $ if canrename 		then do-			rename src dest+			R.rename (toRawFilePath src) (toRawFilePath dest) 			return True 		else createLinkOrCopy (toRawFilePath src) (toRawFilePath dest) 	{- If the key being sent is encrypted or chunked, the file
Remote/S3.hs view
@@ -312,7 +312,7 @@ 		use archiveconfig pc' info 	 	checkexportimportsafe c' info =-		unlessM (Annex.getState Annex.force) $+		unlessM (Annex.getRead Annex.force) $ 			checkexportimportsafe' c' info 	checkexportimportsafe' c' info 		| versioning info = return ()@@ -777,9 +777,11 @@  -  - Note that IA buckets can only created by having a file  - stored in them. So this also takes care of that.+ -+ - Not done for import/export buckets.  -} writeUUIDFile :: ParsedRemoteConfig -> UUID -> S3Info -> S3Handle -> Annex ()-writeUUIDFile c u info h = do+writeUUIDFile c u info h = unless (exportTree c || importTree c) $ do 	v <- checkUUIDFile c u info h 	case v of 		Right True -> noop@@ -794,15 +796,19 @@ 	mkobject = putObject info file (RequestBodyLBS uuidb)  {- Checks if the UUID file exists in the bucket- - and has the specified UUID already. -}+ - and has the specified UUID already.+ -+ - Not done for import/export buckets. -} checkUUIDFile :: ParsedRemoteConfig -> UUID -> S3Info -> S3Handle -> Annex (Either SomeException Bool)-checkUUIDFile c u info h = tryNonAsync $ liftIO $ runResourceT $ do-	resp <- tryS3 $ sendS3Handle h (S3.getObject (bucket info) file)-	case resp of-		Left _ -> return False-		Right r -> do-			v <- AWS.loadToMemory r-			extractFromResourceT (check v)+checkUUIDFile c u info h +	| exportTree c || importTree c = pure (Right False)+	| otherwise = tryNonAsync $ liftIO $ runResourceT $ do+		resp <- tryS3 $ sendS3Handle h (S3.getObject (bucket info) file)+		case resp of+			Left _ -> return False+			Right r -> do+				v <- AWS.loadToMemory r+				extractFromResourceT (check v)   where 	check (S3.GetObjectMemoryResponse _meta rsp) = 		responseStatus rsp == ok200 && responseBody rsp == uuidb
Test.hs view
@@ -82,6 +82,7 @@ import qualified Utility.FileSystemEncoding import qualified Utility.Aeson import qualified Utility.CopyFile+import qualified Utility.MoveFile import qualified Types.Remote #ifndef mingw32_HOST_OS import qualified Remote.Helper.Encryptable@@ -261,6 +262,7 @@ repoTests note numparts = map mk $ sep 	[ testCase "add dup" test_add_dup 	, testCase "add extras" test_add_extras+	, testCase "add moved link" test_add_moved 	, testCase "readonly remote" test_readonly_remote 	, testCase "ignore deleted files" test_ignore_deleted_files 	, testCase "metadata" test_metadata@@ -389,6 +391,17 @@ 		git_annex "unlock" [wormannexedfile] "unlock" 	annexed_present wormannexedfile 	checkbackend wormannexedfile backendWORM++test_add_moved :: Assertion+test_add_moved = intmpclonerepo $ do+	git_annex "get" [annexedfile] "get failed"+	annexed_present annexedfile+	createDirectory subdir+	Utility.MoveFile.moveFile (toRawFilePath annexedfile) (toRawFilePath subfile)+	git_annex "add" [subdir] "add of moved annexed file"+  where+	subdir = "subdir"+	subfile = subdir </> "file"  test_readonly_remote :: Assertion test_readonly_remote =
Types/Command.hs view
@@ -87,8 +87,8 @@ 	-- ^ command line parser 	, cmdinfomod :: forall a. InfoMod a 	-- ^ command-specific modifier for ParserInfo-	, cmdglobaloptions :: [GlobalOption]-	-- ^ additional global options+	, cmdannexoptions :: [AnnexOption]+	-- ^ additional options not parsed by the CommandParser 	, cmdnorepo :: Maybe (Parser (IO ())) 	-- ^used when not in a repo 	}
Types/DeferredParse.hs view
@@ -38,20 +38,20 @@ instance DeferredParseClass [DeferredParse a] where 	finishParse v = mapM finishParse v -type GlobalOption = Parser GlobalSetter+type AnnexOption = Parser AnnexSetter --- Used for global options that can modify Annex state by running+-- Used for options that can modify Annex state by running -- an arbitrary action in it, and can also set up AnnexRead.-data GlobalSetter = GlobalSetter+data AnnexSetter = AnnexSetter 	{ annexStateSetter :: Annex () 	, annexReadSetter :: AnnexRead -> AnnexRead 	} -instance Sem.Semigroup GlobalSetter where-	a <> b = GlobalSetter+instance Sem.Semigroup AnnexSetter where+	a <> b = AnnexSetter 		{ annexStateSetter = annexStateSetter a >> annexStateSetter b 		, annexReadSetter = annexReadSetter b . annexReadSetter a 		} -instance Monoid GlobalSetter where-	mempty = GlobalSetter (return ()) id+instance Monoid AnnexSetter where+	mempty = AnnexSetter (return ()) id
Types/GitConfig.hs view
@@ -82,6 +82,7 @@ 	, annexBloomAccuracy :: Maybe Int 	, annexSshCaching :: Maybe Bool 	, annexAlwaysCommit :: Bool+	, annexAlwaysCompact :: Bool 	, annexCommitMessage :: Maybe String 	, annexMergeAnnexBranches :: Bool 	, annexDelayAdd :: Maybe Int@@ -164,6 +165,7 @@ 	, annexBloomAccuracy = getmayberead (annexConfig "bloomaccuracy") 	, annexSshCaching = getmaybebool (annexConfig "sshcaching") 	, annexAlwaysCommit = getbool (annexConfig "alwayscommit") True+	, annexAlwaysCompact = getbool (annexConfig "alwayscompact") True 	, annexCommitMessage = getmaybe (annexConfig "commitmessage") 	, annexMergeAnnexBranches = getbool (annexConfig "merge-annex-branches") True 	, annexDelayAdd = getmayberead (annexConfig "delayadd")
Upgrade/V9.hs view
@@ -27,7 +27,7 @@ 		( return UpgradeDeferred 		, performUpgrade automatic 		)-	| otherwise = ifM (oldprocessesdanger <&&> (not <$> Annex.getState Annex.force))+	| otherwise = ifM (oldprocessesdanger <&&> (not <$> Annex.getRead Annex.force)) 		( do 			warning $ unlines unsafeupgrade 			return UpgradeDeferred
Utility/Directory.hs view
@@ -16,7 +16,7 @@  import Control.Monad import System.FilePath-import System.PosixCompat.Files hiding (removeLink)+import System.PosixCompat.Files (getSymbolicLinkStatus, isDirectory, isSymbolicLink) import Control.Applicative import System.IO.Unsafe (unsafeInterleaveIO) import Data.Maybe
Utility/FileMode.hs view
@@ -16,7 +16,7 @@ import System.IO import Control.Monad import System.PosixCompat.Types-import System.PosixCompat.Files hiding (removeLink)+import System.PosixCompat.Files (unionFileModes, intersectFileModes, stdFileMode, nullFileMode, setFileCreationMask, groupReadMode, ownerReadMode, ownerWriteMode, ownerExecuteMode, groupWriteMode, groupExecuteMode, otherReadMode, otherWriteMode, otherExecuteMode, fileMode) import Control.Monad.IO.Class import Foreign (complement) import Control.Monad.Catch
Utility/FileSize.hs view
@@ -14,7 +14,7 @@ 	getFileSize', ) where -import System.PosixCompat.Files hiding (removeLink)+import System.PosixCompat.Files (FileStatus, fileSize) import qualified Utility.RawFilePath as R #ifdef mingw32_HOST_OS import Control.Exception (bracket)
Utility/LogFile.hs view
@@ -18,6 +18,7 @@ ) where  import Common+import Utility.RawFilePath  #ifndef mingw32_HOST_OS import System.Posix.Types@@ -36,7 +37,7 @@ 		| num > maxLogs = return () 		| otherwise = whenM (doesFileExist currfile) $ do 			go (num + 1)-			rename currfile nextfile+			rename (toRawFilePath currfile) (toRawFilePath nextfile) 	  where 		currfile = filename num 		nextfile = filename (num + 1)
Utility/Matcher.hs view
@@ -34,6 +34,8 @@  import Common +import Data.Kind+ {- A Token can be an Operation of an arbitrary type, or one of a few  - predefined peices of syntax. -} data Token op = Operation op | And | Or | Not | Open | Close@@ -136,7 +138,7 @@ {- More generic running of a monadic Matcher, with full control over running  - of Operations. Mostly useful in order to match on more than one  - parameter. -}-matchMrun :: forall o (m :: * -> *). Monad m => Matcher o -> (o -> m Bool) -> m Bool+matchMrun :: forall o (m :: Type -> Type). Monad m => Matcher o -> (o -> m Bool) -> m Bool matchMrun m run = go m   where 	go MAny = return True
Utility/RawFilePath.hs view
@@ -89,6 +89,8 @@ setFileMode :: RawFilePath -> FileMode -> IO ()  setFileMode = F.setFileMode . fromRawFilePath +{- Using renamePath rather than the rename provided in unix-compat+ - because of this bug https://github.com/jacobstanley/unix-compat/issues/56-} rename :: RawFilePath -> RawFilePath -> IO ()-rename a b = F.rename (fromRawFilePath a) (fromRawFilePath b)+rename a b = D.renamePath (fromRawFilePath a) (fromRawFilePath b) #endif
Utility/UserInfo.hs view
@@ -21,7 +21,7 @@ import Control.Applicative #endif -import System.PosixCompat+import System.PosixCompat.User import Prelude  {- Current user's home directory.
doc/git-annex-addurl.mdwn view
@@ -136,6 +136,10 @@   Messages that would normally be output to standard error are included in   the json instead. +* `--backend`++  Specifies which key-value backend to use.+ * Also the [[git-annex-common-options]](1) can be used.  # CAVEATS
doc/git-annex-import.mdwn view
@@ -185,6 +185,10 @@    Setting this to "cpus" will run one job per CPU core. +* `--backend`++  Specifies which key-value backend to use for the imported files.+ * `--no-check-gitignore`    Add gitignored files.
doc/git-annex-importfeed.mdwn view
@@ -102,6 +102,10 @@   url to a file that would be ignored. This makes such files be added   despite any ignores. +* `--backend`++  Specifies which key-value backend to use.+ * Also the [[git-annex-common-options]](1) can be used.  # SEE ALSO
doc/git-annex-sync.mdwn view
@@ -167,6 +167,11 @@   resolution. It can also be disabled by setting `annex.resolvemerge`   to false. +* `--backend`++  Specifies which key-value backend to use when adding files, +  or when importing from a special remote. + * `--cleanup`    Removes the local and remote `synced/` branches, which were created
doc/git-annex.mdwn view
@@ -1038,6 +1038,24 @@   This works well in combination with annex.alwayscommit=false,   to gather up a set of changes and commit them with a message you specify. +* `annex.alwayscompact`++  By default, git-annex compacts data it records in the git-annex branch.+  Setting this to false avoids doing that compaction in some cases, which+  can speed up operations that populate the git-annex branch with a lot+  of data. However, when used with operations that overwrite old values in+  the git-annex branch, that may cause the git-annex branch to use more disk+  space, and so slow down reading data from it.++  An example of a command that can be sped up by using +  `-c annex.alwayscompact=false` is `git-annex registerurl --batch`,+  when adding a large number of urls to the same key.++  This option was first supported by git-annex version 10.20220724.+  It is not entirely safe to set this option in a repository that may also+  be used by an older version of git-annex at the same time as a version+  that supports this option.+ * `annex.allowsign`    By default git-annex avoids gpg signing commits that it makes when
git-annex.cabal view
@@ -1,6 +1,6 @@ Name: git-annex-Version: 10.20220624-Cabal-Version: >= 1.10+Version: 10.20220724+Cabal-Version: 1.12 License: AGPL-3 Maintainer: Joey Hess <id@joeyh.name> Author: Joey Hess@@ -294,10 +294,11 @@  custom-setup   Setup-Depends: base (>= 4.11.1.0), split, unix-compat, -    filepath, exceptions, bytestring, directory, IfElse, data-default,+    filepath, exceptions, bytestring, IfElse, data-default,     filepath-bytestring (>= 1.4.2.1.4),     process (>= 1.6.3),     time (>= 1.5.0),+    directory (>= 1.2.7.0),     async, utf8-string, transformers, Cabal  Executable git-annex@@ -319,7 +320,7 @@    unix-compat (>= 0.5),    SafeSemaphore,    async,-   directory (>= 1.2),+   directory (>= 1.2.7.0),    disk-free-space,    filepath,    filepath-bytestring (>= 1.4.2.1.1),@@ -401,7 +402,7 @@    if (os(windows))     Build-Depends:-      Win32 (>= 2.6.1.0),+      Win32 (>= 2.6.1.0 && < 2.12.0.0),       setenv,       process (>= 1.6.2.0),       silently (>= 1.2.5.1)@@ -514,6 +515,60 @@             C-Sources: Utility/libkqueue.c             Includes: Utility/libkqueue.h             Other-Modules: Utility.DirWatcher.Kqueue+  +    if flag(Webapp)+      Build-Depends:+       yesod (>= 1.4.3), +       yesod-static (>= 1.5.1),+       yesod-form (>= 1.4.8),+       yesod-core (>= 1.6.0),+       path-pieces (>= 0.2.1),+       warp (>= 3.2.8),+       warp-tls (>= 3.2.2),+       wai,+       wai-extra,+       blaze-builder,+       clientsession,+       template-haskell,+       shakespeare (>= 2.0.11)+      CPP-Options: -DWITH_WEBAPP+      Other-Modules:+        Command.WebApp+        Assistant.Threads.WebApp+        Assistant.Threads.PairListener+        Assistant.WebApp+        Assistant.WebApp.Common+        Assistant.WebApp.Configurators+        Assistant.WebApp.Configurators.AWS+        Assistant.WebApp.Configurators.Delete+        Assistant.WebApp.Configurators.Edit+        Assistant.WebApp.Configurators.Fsck+        Assistant.WebApp.Configurators.IA+        Assistant.WebApp.Configurators.Local+        Assistant.WebApp.Configurators.Pairing+        Assistant.WebApp.Configurators.Preferences+        Assistant.WebApp.Configurators.Ssh+        Assistant.WebApp.Configurators.Unused+        Assistant.WebApp.Configurators.Upgrade+        Assistant.WebApp.Configurators.WebDAV+        Assistant.WebApp.Control+        Assistant.WebApp.DashBoard+        Assistant.WebApp.Documentation+        Assistant.WebApp.Form+        Assistant.WebApp.Gpg+        Assistant.WebApp.MakeRemote+        Assistant.WebApp.Notifications+        Assistant.WebApp.OtherRepos+        Assistant.WebApp.Page+        Assistant.WebApp.Pairing+        Assistant.WebApp.Repair+        Assistant.WebApp.RepoId+        Assistant.WebApp.RepoList+        Assistant.WebApp.SideBar+        Assistant.WebApp.Types+        Assistant.MakeRepo+        Utility.Yesod+        Utility.WebApp    if flag(Dbus)     if (os(linux))@@ -521,60 +576,6 @@       CPP-Options: -DWITH_DBUS -DWITH_DESKTOP_NOTIFY -DWITH_DBUS_NOTIFICATIONS       Other-Modules: Utility.DBus -  if flag(Webapp)-    Build-Depends:-     yesod (>= 1.4.3), -     yesod-static (>= 1.5.1),-     yesod-form (>= 1.4.8),-     yesod-core (>= 1.6.0),-     path-pieces (>= 0.2.1),-     warp (>= 3.2.8),-     warp-tls (>= 3.2.2),-     wai,-     wai-extra,-     blaze-builder,-     clientsession,-     template-haskell,-     shakespeare (>= 2.0.11)-    CPP-Options: -DWITH_WEBAPP-    Other-Modules:-      Command.WebApp-      Assistant.Threads.WebApp-      Assistant.Threads.PairListener-      Assistant.WebApp-      Assistant.WebApp.Common-      Assistant.WebApp.Configurators-      Assistant.WebApp.Configurators.AWS-      Assistant.WebApp.Configurators.Delete-      Assistant.WebApp.Configurators.Edit-      Assistant.WebApp.Configurators.Fsck-      Assistant.WebApp.Configurators.IA-      Assistant.WebApp.Configurators.Local-      Assistant.WebApp.Configurators.Pairing-      Assistant.WebApp.Configurators.Preferences-      Assistant.WebApp.Configurators.Ssh-      Assistant.WebApp.Configurators.Unused-      Assistant.WebApp.Configurators.Upgrade-      Assistant.WebApp.Configurators.WebDAV-      Assistant.WebApp.Control-      Assistant.WebApp.DashBoard-      Assistant.WebApp.Documentation-      Assistant.WebApp.Form-      Assistant.WebApp.Gpg-      Assistant.WebApp.MakeRemote-      Assistant.WebApp.Notifications-      Assistant.WebApp.OtherRepos-      Assistant.WebApp.Page-      Assistant.WebApp.Pairing-      Assistant.WebApp.Repair-      Assistant.WebApp.RepoId-      Assistant.WebApp.RepoList-      Assistant.WebApp.SideBar-      Assistant.WebApp.Types-      Assistant.MakeRepo-      Utility.Yesod-      Utility.WebApp-   if flag(Pairing)     Build-Depends: network-multicast, network-info     CPP-Options: -DWITH_PAIRING@@ -699,7 +700,7 @@     CmdLine.GitAnnexShell     CmdLine.GitAnnexShell.Checks     CmdLine.GitAnnexShell.Fields-    CmdLine.GlobalSetter+    CmdLine.AnnexSetter     CmdLine.Option     CmdLine.GitRemoteTorAnnex     CmdLine.Seek