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 +14/−27
- Annex/AdjustedBranch.hs +1/−1
- Annex/Branch.hs +62/−2
- Annex/BranchState.hs +8/−6
- Annex/CheckIgnore.hs +1/−1
- Annex/Content/LowLevel.hs +1/−1
- Annex/Ingest.hs +1/−1
- Annex/Journal.hs +84/−17
- Annex/Notification.hs +2/−2
- Annex/NumCopies.hs +2/−2
- Annex/Url.hs +1/−1
- Annex/YoutubeDl.hs +1/−1
- Assistant/Install.hs +0/−1
- Assistant/Threads/Watcher.hs +1/−1
- Assistant/Upgrade.hs +2/−2
- Assistant/WebApp/Configurators/Local.hs +2/−1
- Backend.hs +2/−2
- Backend/Hash.hs +1/−1
- CHANGELOG +27/−0
- CmdLine.hs +10/−10
- CmdLine/AnnexSetter.hs +36/−0
- CmdLine/GitAnnex.hs +3/−3
- CmdLine/GitAnnex/Options.hs +70/−58
- CmdLine/GitAnnexShell.hs +10/−10
- CmdLine/GlobalSetter.hs +0/−36
- CmdLine/Option.hs +13/−22
- CmdLine/Seek.hs +2/−2
- Command.hs +4/−4
- Command/Add.hs +6/−5
- Command/AddUrl.hs +8/−3
- Command/CalcKey.hs +5/−4
- Command/Copy.hs +1/−1
- Command/Drop.hs +2/−2
- Command/DropKey.hs +2/−2
- Command/DropUnused.hs +1/−1
- Command/ExamineKey.hs +1/−1
- Command/Export.hs +3/−5
- Command/FilterBranch.hs +1/−1
- Command/Find.hs +2/−2
- Command/FindRef.hs +1/−1
- Command/Fix.hs +1/−1
- Command/Forget.hs +1/−1
- Command/FromKey.hs +2/−2
- Command/Fsck.hs +3/−3
- Command/FuzzTest.hs +2/−2
- Command/Get.hs +1/−1
- Command/Import.hs +5/−4
- Command/ImportFeed.hs +4/−4
- Command/Info.hs +4/−4
- Command/List.hs +1/−1
- Command/Lock.hs +2/−2
- Command/Log.hs +1/−1
- Command/Map.hs +1/−1
- Command/MetaData.hs +1/−1
- Command/Migrate.hs +2/−2
- Command/Mirror.hs +1/−1
- Command/Move.hs +3/−3
- Command/Multicast.hs +1/−1
- Command/ReKey.hs +1/−1
- Command/RegisterUrl.hs +1/−1
- Command/Reinject.hs +5/−4
- Command/Repair.hs +1/−1
- Command/Status.hs +1/−1
- Command/Sync.hs +2/−2
- Command/TestRemote.hs +1/−1
- Command/Trust.hs +1/−1
- Command/Unannex.hs +14/−14
- Command/Uninit.hs +1/−3
- Command/Unlock.hs +1/−1
- Command/UnregisterUrl.hs +1/−1
- Command/Unused.hs +1/−1
- Command/WhereUsed.hs +1/−1
- Command/Whereis.hs +1/−1
- Common.hs +1/−1
- Database/Init.hs +1/−1
- Git/FilterProcess.hs +3/−1
- Logs/Presence.hs +6/−3
- Logs/Presence/Pure.hs +7/−1
- Logs/Web.hs +5/−1
- Remote/Adb.hs +32/−10
- Remote/Directory.hs +3/−3
- Remote/Git.hs +10/−5
- Remote/GitLFS.hs +1/−1
- Remote/Helper/Encryptable.hs +1/−1
- Remote/Rsync.hs +2/−1
- Remote/S3.hs +16/−10
- Test.hs +13/−0
- Types/Command.hs +2/−2
- Types/DeferredParse.hs +7/−7
- Types/GitConfig.hs +2/−0
- Upgrade/V9.hs +1/−1
- Utility/Directory.hs +1/−1
- Utility/FileMode.hs +1/−1
- Utility/FileSize.hs +1/−1
- Utility/LogFile.hs +2/−1
- Utility/Matcher.hs +3/−1
- Utility/RawFilePath.hs +3/−1
- Utility/UserInfo.hs +1/−1
- doc/git-annex-addurl.mdwn +4/−0
- doc/git-annex-import.mdwn +4/−0
- doc/git-annex-importfeed.mdwn +4/−0
- doc/git-annex-sync.mdwn +5/−0
- doc/git-annex.mdwn +18/−0
- git-annex.cabal +61/−60
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