diff --git a/Annex/Action.hs b/Annex/Action.hs --- a/Annex/Action.hs +++ b/Annex/Action.hs @@ -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 diff --git a/Annex/AutoMerge.hs b/Annex/AutoMerge.hs --- a/Annex/AutoMerge.hs +++ b/Annex/AutoMerge.hs @@ -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) diff --git a/Annex/Concurrent.hs b/Annex/Concurrent.hs --- a/Annex/Concurrent.hs +++ b/Annex/Concurrent.hs @@ -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 } diff --git a/Annex/YoutubeDl.hs b/Annex/YoutubeDl.hs --- a/Annex/YoutubeDl.hs +++ b/Annex/YoutubeDl.hs @@ -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. -- diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -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 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 diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs --- a/Command/ImportFeed.hs +++ b/Command/ImportFeed.hs @@ -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}" diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs --- a/Git/LsFiles.hs +++ b/Git/LsFiles.hs @@ -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~ 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. - diff --git a/Test.hs b/Test.hs --- a/Test.hs +++ b/Test.hs @@ -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 diff --git a/Types/Concurrency.hs b/Types/Concurrency.hs --- a/Types/Concurrency.hs +++ b/Types/Concurrency.hs @@ -22,3 +22,4 @@ data ConcurrencySetting = ConcurrencyCmdLine Concurrency | ConcurrencyGitConfig Concurrency + deriving (Eq) diff --git a/git-annex.cabal b/git-annex.cabal --- a/git-annex.cabal +++ b/git-annex.cabal @@ -1,5 +1,5 @@ Name: git-annex -Version: 8.20211117 +Version: 8.20211123 Cabal-Version: >= 1.10 License: AGPL-3 Maintainer: Joey Hess