git-annex 8.20211117 → 8.20211123
raw patch · 10 files changed
+140/−88 lines, 10 files
Files
- Annex/Action.hs +1/−8
- Annex/AutoMerge.hs +30/−18
- Annex/Concurrent.hs +30/−20
- Annex/YoutubeDl.hs +1/−1
- CHANGELOG +11/−0
- Command/ImportFeed.hs +41/−34
- Git/LsFiles.hs +22/−4
- Test.hs +2/−2
- Types/Concurrency.hs +1/−0
- git-annex.cabal +1/−1
Annex/Action.hs view
@@ -13,7 +13,6 @@ startup, shutdown, stopCoProcesses,- stopNonConcurrentSafeCoProcesses, ) where import qualified Data.Map as M@@ -85,14 +84,8 @@ {- Stops all long-running child processes, including git query processes. -} stopCoProcesses :: Annex () stopCoProcesses = do- stopNonConcurrentSafeCoProcesses- emptyTransferrerPool--{- Stops long-running child processes that use handles that are not safe- - for multiple threads to access at the same time. -}-stopNonConcurrentSafeCoProcesses :: Annex ()-stopNonConcurrentSafeCoProcesses = do catFileStop checkAttrStop hashObjectStop checkIgnoreStop+ emptyTransferrerPool
Annex/AutoMerge.hs view
@@ -137,7 +137,7 @@ (fs, cleanup) <- inRepo (LsFiles.unmerged [top]) srcmap <- if inoverlay then pure M.empty- else inodeMap $ pure (map LsFiles.unmergedFile fs, return True)+ else inodeMap $ pure (concatMap getunmergedfiles fs, return True) (mergedks, mergedfs) <- unzip <$> mapM (resolveMerge' srcmap us them inoverlay) fs let mergedks' = concat mergedks let mergedfs' = catMaybes mergedfs@@ -160,6 +160,11 @@ cleanConflictCruft mergedks' mergedfs' unstagedmap showLongNote "Merge conflict was automatically resolved; you may want to examine the result." return merged+ where+ getunmergedfiles u = catMaybes+ [ Just (LsFiles.unmergedFile u)+ , LsFiles.unmergedSiblingFile u+ ] resolveMerge' :: InodeMap -> Maybe Git.Ref -> Git.Ref -> Bool -> LsFiles.Unmerged -> Annex ([Key], Maybe FilePath) resolveMerge' _ Nothing _ _ _ = return ([], Nothing)@@ -177,7 +182,7 @@ unless inoverlay $ unless (islocked LsFiles.valUs) $ liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath file)- | otherwise -> do+ | otherwise -> resolveby [keyUs, keyThem] $ -- Only resolve using symlink when both -- were locked, otherwise use unlocked -- pointer.@@ -185,13 +190,12 @@ if islocked LsFiles.valUs && islocked LsFiles.valThem then makesymlink keyUs file else makepointer keyUs file (combinedmodes)- return ([keyUs, keyThem], Just file) -- Our side is annexed file, other side is not. -- Make the annexed file into a variant file and graft in the -- other file/directory as it was. (Just keyUs, Nothing) -> resolveby [keyUs] $ do graftin them file LsFiles.valThem LsFiles.valThem LsFiles.valUs- makevariantannexlink keyUs LsFiles.valUs + makevariantannexlink keyUs LsFiles.valUs -- Our side is not annexed file, other side is. (Nothing, Just keyThem) -> resolveby [keyThem] $ do graftin us file LsFiles.valUs LsFiles.valUs LsFiles.valThem@@ -200,6 +204,7 @@ (Nothing, Nothing) -> return ([], Nothing) where file = fromRawFilePath $ LsFiles.unmergedFile u+ sibfile = fromRawFilePath <$> LsFiles.unmergedSiblingFile u getkey select = case select (LsFiles.unmergedSha u) of@@ -256,21 +261,27 @@ graftin b item selectwant selectwant' selectunwant = do Annex.Queue.addUpdateIndex =<< fromRepo (UpdateIndex.lsSubTree b item)+ + let replacefile isexecutable = case selectwant' (LsFiles.unmergedSha u) of+ Nothing -> noop+ Just sha -> replaceWorkTreeFile item $ \tmp -> do+ c <- catObject sha+ liftIO $ L.writeFile tmp c+ when isexecutable $+ liftIO $ void $ tryIO $ + modifyFileMode (toRawFilePath tmp) $+ addModes executeModes -- Update the work tree to reflect the graft. unless inoverlay $ case (selectwant (LsFiles.unmergedTreeItemType u), selectunwant (LsFiles.unmergedTreeItemType u)) of- -- Symlinks are never left in work tree when- -- there's a conflict with anything else.- -- So, when grafting in a symlink, we must create it: (Just TreeSymlink, _) -> do case selectwant' (LsFiles.unmergedSha u) of Nothing -> noop Just sha -> do link <- catSymLinkTarget sha replacewithsymlink item link- -- And when grafting in anything else vs a symlink,- -- the work tree already contains what we want.- (_, Just TreeSymlink) -> noop+ (Just TreeFile, Just TreeSymlink) -> replacefile False+ (Just TreeExecutable, Just TreeSymlink) -> replacefile True _ -> ifM (liftIO $ doesDirectoryExist item) -- a conflict between a file and a directory -- leaves the directory, so since a directory@@ -278,23 +289,24 @@ ( noop -- probably a file with conflict markers is -- in the work tree; replace with grafted- -- file content- , case selectwant' (LsFiles.unmergedSha u) of- Nothing -> noop- Just sha -> replaceWorkTreeFile item $ \tmp -> do- c <- catObject sha- liftIO $ L.writeFile tmp c+ -- file content (this is needed when+ -- the annexed file is unlocked)+ , replacefile False ) resolveby ks a = do- {- Remove conflicted file from index so merge can be resolved. -}+ {- Remove conflicted file from index so merge can be resolved.+ - If there's a sibling conflicted file, remove it too. -} Annex.Queue.addCommand [] "rm" [ Param "--quiet" , Param "-f" , Param "--cached" , Param "--" ]- [file]+ (catMaybes [Just file, sibfile])+ liftIO $ maybe noop+ (removeWhenExistsWith R.removeLink . toRawFilePath)+ sibfile void a return (ks, Just file)
Annex/Concurrent.hs view
@@ -17,6 +17,7 @@ import Annex.Action import Types.Concurrency import Types.CatFileHandles+import Annex.CatFile import Annex.CheckAttr import Annex.CheckIgnore @@ -32,18 +33,31 @@ { Annex.concurrency = f NonConcurrent } setConcurrency' c f = do- cfh <- getState Annex.catfilehandles- cfh' <- case cfh of- CatFileHandlesNonConcurrent _ -> liftIO catFileHandlesPool- CatFileHandlesPool _ -> pure cfh- cah <- mkConcurrentCheckAttrHandle c- cih <- mkConcurrentCheckIgnoreHandle c- Annex.changeState $ \s -> s- { Annex.concurrency = f c- , Annex.catfilehandles = cfh'- , Annex.checkattrhandle = Just cah- , Annex.checkignorehandle = Just cih- }+ oldc <- Annex.getState Annex.concurrency+ case oldc of+ ConcurrencyCmdLine NonConcurrent -> fromnonconcurrent+ ConcurrencyGitConfig NonConcurrent -> fromnonconcurrent+ _+ | oldc == newc -> return ()+ | otherwise ->+ Annex.changeState $ \s -> s+ { Annex.concurrency = newc+ }+ where+ newc = f c+ fromnonconcurrent = do+ catFileStop+ checkAttrStop+ checkIgnoreStop+ cfh <- liftIO catFileHandlesPool+ cah <- mkConcurrentCheckAttrHandle c+ cih <- mkConcurrentCheckIgnoreHandle c+ Annex.changeState $ \s -> s+ { Annex.concurrency = newc+ , Annex.catfilehandles = cfh+ , Annex.checkattrhandle = Just cah+ , Annex.checkignorehandle = Just cih+ } {- Allows forking off a thread that uses a copy of the current AnnexState - to run an Annex action.@@ -87,14 +101,10 @@ , Annex.errcounter = 0 } -{- Merges the passed AnnexState into the current Annex state.- - Also closes various handles in it. -}+{- Merges the passed AnnexState into the current Annex state. -} mergeState :: AnnexState -> Annex () mergeState st = do- rd <- Annex.getRead id- st' <- liftIO $ (fst . snd)- <$> run (st, rd) stopNonConcurrentSafeCoProcesses- forM_ (M.toList $ Annex.cleanupactions st') $+ forM_ (M.toList $ Annex.cleanupactions st) $ uncurry addCleanupAction- Annex.Queue.mergeFrom st'- changeState $ \s -> s { errcounter = errcounter s + errcounter st' }+ Annex.Queue.mergeFrom st+ changeState $ \s -> s { errcounter = errcounter s + errcounter st }
Annex/YoutubeDl.hs view
@@ -46,7 +46,7 @@ ] -- Runs youtube-dl in a work directory, to download a single media file--- from the url. Reutrns the path to the media file in the work directory.+-- from the url. Returns the path to the media file in the work directory. -- -- Displays a progress meter as youtube-dl downloads. --
CHANGELOG view
@@ -1,3 +1,14 @@+git-annex (8.20211123) upstream; urgency=medium++ * Bugfix: When -J was enabled, getting files could leak an+ ever-growing number of git cat-file processes.+ * Support git's new "ort" resolver, which became the default in git 2.34.0,+ and broke the test suite and automatic merge resolution of a conflict+ between an annexed file and a non-annexed file.+ * importfeed: Display url before starting youtube-dl download.++ -- Joey Hess <id@joeyh.name> Tue, 23 Nov 2021 15:19:16 -0400+ git-annex (8.20211117) upstream; urgency=medium * filter-process: New command that can make git add/checkout faster when
Command/ImportFeed.hs view
@@ -130,7 +130,7 @@ getCache opttemplate = ifM (Annex.getState Annex.force) ( ret S.empty S.empty , do- showStart "importfeed" "checking known urls" (SeekInput [])+ showStart "importfeed" "gathering known urls" (SeekInput []) (us, is) <- knownItems showEndOk ret (S.fromList us) (S.fromList is)@@ -184,8 +184,12 @@ Url.download nullMeterUpdate Nothing url f performDownload :: AddUnlockedMatcher -> ImportFeedOptions -> Cache -> ToDownload -> Annex Bool-performDownload addunlockedmatcher opts cache todownload = case location todownload of- Enclosure url -> checkknown url $+performDownload = performDownload' False++performDownload' :: Bool -> AddUnlockedMatcher -> ImportFeedOptions -> Cache -> ToDownload -> Annex Bool+performDownload' started addunlockedmatcher opts cache todownload = case location todownload of+ Enclosure url -> checkknown url $ do+ starturl url rundownload url (takeWhile (/= '?') $ takeExtension url) $ \f -> do let f' = fromRawFilePath f r <- Remote.claimingUrl url@@ -256,28 +260,25 @@ feedFile (template cache) todownload extension case dest of Nothing -> return True- Just f -> do- showStartOther "addurl" (Just url) (SeekInput [])- getter (toRawFilePath f) >>= \case- Just ks- -- Download problem.- | null ks -> do- showEndFail- checkFeedBroken (feedurl todownload)- | otherwise -> do- forM_ ks $ \key ->- ifM (annexGenMetaData <$> Annex.getGitConfig)- ( addMetaData key $ extractMetaData todownload- , addMetaData key $ minimalMetaData todownload- )- showEndOk- return True- -- Was not able to add anything,- -- but not because of a download - -- problem.- Nothing -> do+ Just f -> getter (toRawFilePath f) >>= \case+ Just ks+ -- Download problem.+ | null ks -> do showEndFail- return False+ checkFeedBroken (feedurl todownload)+ | otherwise -> do+ forM_ ks $ \key ->+ ifM (annexGenMetaData <$> Annex.getGitConfig)+ ( addMetaData key $ extractMetaData todownload+ , addMetaData key $ minimalMetaData todownload+ )+ showEndOk+ return True+ -- Was not able to add anything, but not+ -- because of a download problem.+ Nothing -> do+ showEndFail+ return False {- Find a unique filename to save the url to. - If the file exists, prefixes it with a number.@@ -305,9 +306,10 @@ ) downloadmedia linkurl mediaurl mediakey- | rawOption (downloadOptions opts) = downloadlink+ | rawOption (downloadOptions opts) = downloadlink False | otherwise = ifM (youtubeDlSupported linkurl) ( do+ starturl linkurl r <- withTmpWorkDir mediakey $ \workdir -> do dl <- youtubeDl linkurl (fromRawFilePath workdir) nullMeterUpdate case dl of@@ -323,28 +325,33 @@ -- youtube-dl didn't support it, so -- download it as if the link were -- an enclosure.- Right Nothing -> Just <$> downloadlink+ Right Nothing -> Just <$> downloadlink True Left msg -> do warning $ linkurl ++ ": " ++ msg return Nothing return (fromMaybe False r)- , downloadlink+ , downloadlink False ) where- downloadlink = checkRaw Nothing (downloadOptions opts) $- performDownload addunlockedmatcher opts cache todownload+ downloadlink started' = checkRaw Nothing (downloadOptions opts) $+ performDownload' started' addunlockedmatcher opts cache todownload { location = Enclosure linkurl } addmediafast linkurl mediaurl mediakey = ifM (pure (not (rawOption (downloadOptions opts))) <&&> youtubeDlSupported linkurl)- ( rundownload linkurl ".m" $ \f ->- checkCanAdd (downloadOptions opts) f $ \canadd -> do- addWorkTree canadd addunlockedmatcher webUUID mediaurl f mediakey Nothing- return (Just [mediakey])- , performDownload addunlockedmatcher opts cache todownload+ ( do+ starturl linkurl+ rundownload linkurl ".m" $ \f ->+ checkCanAdd (downloadOptions opts) f $ \canadd -> do+ addWorkTree canadd addunlockedmatcher webUUID mediaurl f mediakey Nothing+ return (Just [mediakey])+ , performDownload' started addunlockedmatcher opts cache todownload { location = Enclosure linkurl } )++ starturl u = unless started $+ showStartOther "addurl" (Just u) (SeekInput []) defaultTemplate :: String defaultTemplate = "${feedtitle}/${itemtitle}${extension}"
Git/LsFiles.hs view
@@ -5,6 +5,8 @@ - Licensed under the GNU AGPL version 3 or higher. -} +{-# LANGUAGE OverloadedStrings #-}+ module Git.LsFiles ( Options(..), inRepo,@@ -236,7 +238,14 @@ { unmergedFile :: RawFilePath , unmergedTreeItemType :: Conflicting TreeItemType , unmergedSha :: Conflicting Sha- }+ , unmergedSiblingFile :: Maybe RawFilePath+ -- ^ Normally this is Nothing, because a+ -- merge conflict is represented as a single file with two+ -- stages. However, git resolvers sometimes choose to stage+ -- two files, one for each side of the merge conflict. In such a case,+ -- this is used for the name of the second file, which is related+ -- to the first file. (Eg, "foo" and "foo~ref")+ } deriving (Show) {- Returns a list of the files in the specified locations that have - unresolved merge conflicts.@@ -246,7 +255,7 @@ - 1 = old version, can be ignored - 2 = us - 3 = them- - If a line is omitted, that side removed the file.+ - If line 2 or 3 is omitted, that side removed the file. -} unmerged :: [RawFilePath] -> Repo -> IO ([Unmerged], IO Bool) unmerged l repo = guardSafeForLsFiles repo $ do@@ -265,7 +274,7 @@ , ifile :: RawFilePath , itreeitemtype :: Maybe TreeItemType , isha :: Maybe Sha- }+ } deriving (Show) parseUnmerged :: String -> Maybe InternalUnmerged parseUnmerged s@@ -296,16 +305,25 @@ { unmergedFile = ifile i , unmergedTreeItemType = Conflicting treeitemtypeA treeitemtypeB , unmergedSha = Conflicting shaA shaB+ , unmergedSiblingFile = if ifile sibi == ifile i+ then Nothing+ else Just (ifile sibi) } findsib templatei [] = ([], removed templatei) findsib templatei (l:ls)- | ifile l == ifile templatei = (ls, l)+ | ifile l == ifile templatei || issibfile templatei l = (ls, l) | otherwise = (l:ls, removed templatei) removed templatei = templatei { isus = not (isus templatei) , itreeitemtype = Nothing , isha = Nothing }+ -- foo~<ref> are unmerged sibling files of foo+ -- Some versions or resolvers of git stage the sibling files,+ -- other versions or resolvers do not.+ issibfile x y = (ifile x <> "~") `S.isPrefixOf` ifile y+ && isus x || isus y+ && not (isus x && isus y) {- Gets the InodeCache equivilant information stored in the git index. -
Test.hs view
@@ -64,6 +64,7 @@ import qualified Annex.CatFile import qualified Annex.Path import qualified Annex.VectorClock+import qualified Annex.VariantFile import qualified Annex.AdjustedBranch import qualified Annex.View import qualified Annex.View.ViewedFile@@ -1369,12 +1370,11 @@ checkmerge "r2" r2 conflictor = "conflictor" subfile = conflictor </> "subfile"- variantprefix = conflictor ++ ".variant" checkmerge what d = do doesDirectoryExist (d </> conflictor) @? (d ++ " conflictor directory missing") l <- getDirectoryContents d- let v = filter (variantprefix `isPrefixOf`) l+ let v = filter (Annex.VariantFile.variantMarker `isInfixOf`) l not (null v) @? (what ++ " conflictor variant file missing in: " ++ show l ) length v == 1
Types/Concurrency.hs view
@@ -22,3 +22,4 @@ data ConcurrencySetting = ConcurrencyCmdLine Concurrency | ConcurrencyGitConfig Concurrency+ deriving (Eq)
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 8.20211117+Version: 8.20211123 Cabal-Version: >= 1.10 License: AGPL-3 Maintainer: Joey Hess <id@joeyh.name>