diff --git a/Annex/Branch.hs b/Annex/Branch.hs --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -577,10 +577,11 @@ -} run [] = noop run changers = do + config <- Annex.getGitConfig trustmap <- calcTrustMap <$> getStaged trustLog remoteconfigmap <- calcRemoteConfigMap <$> getStaged remoteLog -- partially apply, improves performance - let changers' = map (\c -> c trustmap remoteconfigmap) changers + let changers' = map (\c -> c config trustmap remoteconfigmap) changers fs <- branchFiles forM_ fs $ \f -> do content <- getStaged f diff --git a/Annex/Branch/Transitions.hs b/Annex/Branch/Transitions.hs --- a/Annex/Branch/Transitions.hs +++ b/Annex/Branch/Transitions.hs @@ -22,6 +22,7 @@ import Types.UUID import Types.MetaData import Types.Remote +import Types.GitConfig (GitConfig) import Types.ProposedAccepted import Annex.SpecialRemote.Config @@ -35,7 +36,7 @@ = ChangeFile Builder | PreserveFile -type TransitionCalculator = TrustMap -> M.Map UUID RemoteConfig -> RawFilePath -> L.ByteString -> FileTransition +type TransitionCalculator = GitConfig -> TrustMap -> M.Map UUID RemoteConfig -> RawFilePath -> L.ByteString -> FileTransition getTransitionCalculator :: Transition -> Maybe TransitionCalculator getTransitionCalculator ForgetGitHistory = Nothing @@ -54,7 +55,7 @@ -- is not removed from the remote log, for the same reason the trust log -- is not changed. dropDead :: TransitionCalculator -dropDead trustmap remoteconfigmap f content = case getLogVariety f of +dropDead gc trustmap remoteconfigmap f content = case getLogVariety gc f of Just OldUUIDBasedLog | f == trustLog -> PreserveFile | f == remoteLog -> ChangeFile $ diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs --- a/Annex/Ssh.hs +++ b/Annex/Ssh.hs @@ -98,46 +98,31 @@ {- Returns a filename to use for a ssh connection caching socket, and - parameters to enable ssh connection caching. -} sshCachingInfo :: (SshHost, Maybe Integer) -> Annex (Maybe FilePath, [CommandParam]) -sshCachingInfo (host, port) = go =<< sshCacheDir +sshCachingInfo (host, port) = go =<< sshCacheDir' where - go (Just dir) = + go (Right dir) = liftIO (bestSocketPath $ dir hostport2socket host port) >>= return . \case Nothing -> (Nothing, []) Just socketfile -> (Just socketfile, sshConnectionCachingParams socketfile) -- No connection caching with concurrency is not a good -- combination, so warn the user. - go Nothing = do + go (Left whynocaching) = do Annex.getState Annex.concurrency >>= \case NonConcurrent -> return () - Concurrent {} -> warnnocaching - ConcurrentPerCpu -> warnnocaching + Concurrent {} -> warnnocaching whynocaching + ConcurrentPerCpu -> warnnocaching whynocaching return (Nothing, []) - warnnocaching = do + warnnocaching whynocaching = do warning nocachingwarning - ifM (fromMaybe True . annexSshCaching <$> Annex.getGitConfig) - ( whenM crippledFileSystem $ - warning crippledfswarning - , warning enablecachingwarning - ) + warning whynocaching nocachingwarning = unwords - [ "You have enabled concurrency, but ssh connection caching" - , "is not enabled. This may result in multiple ssh processes" - , "prompting for passwords at the same time." - ] - - crippledfswarning = unwords - [ "This repository is on a crippled filesystem, so unix named" - , "pipes probably don't work, and ssh connection caching" - , "relies on those. One workaround is to set" - , sshSocketDirEnv - , "to point to a directory on a non-crippled filesystem." - , "(Or, disable concurrency.)" + [ "You have enabled concurrency, but git-annex is not able" + , "to use ssh connection caching. This may result in" + , "multiple ssh processes prompting for passwords at the" + , "same time." ] - - enablecachingwarning = - "Enable annex.sshcaching (or disable concurrency) to avoid this problem." {- Given an absolute path to use for a socket file, - returns whichever is shorter of that or the relative path to the same @@ -172,22 +157,37 @@ {- ssh connection caching creates sockets, so will not work on a - crippled filesystem. -} sshCacheDir :: Annex (Maybe FilePath) -sshCacheDir - | BuildInfo.sshconnectioncaching = - ifM (fromMaybe True . annexSshCaching <$> Annex.getGitConfig) - ( ifM crippledFileSystem - ( maybe (return Nothing) usetmpdir =<< gettmpdir - , Just <$> fromRepo gitAnnexSshDir - ) - , return Nothing +sshCacheDir = eitherToMaybe <$> sshCacheDir' + +sshCacheDir' :: Annex (Either String FilePath) +sshCacheDir' = + ifM (fromMaybe BuildInfo.sshconnectioncaching . annexSshCaching <$> Annex.getGitConfig) + ( ifM crippledFileSystem + ( gettmpdir >>= \case + Nothing -> + return (Left crippledfswarning) + Just tmpdir -> + liftIO $ catchMsgIO $ + usetmpdir tmpdir + , Right <$> fromRepo gitAnnexSshDir ) - | otherwise = return Nothing + , return (Left "annex.sshcaching is not set to true") + ) where gettmpdir = liftIO $ getEnv sshSocketDirEnv - usetmpdir tmpdir = liftIO $ catchMaybeIO $ do + + usetmpdir tmpdir = do let socktmp = tmpdir "ssh" createDirectoryIfMissing True socktmp return socktmp + + crippledfswarning = unwords + [ "This repository is on a crippled filesystem, so unix named" + , "pipes probably don't work, and ssh connection caching" + , "relies on those. One workaround is to set" + , sshSocketDirEnv + , "to point to a directory on a non-crippled filesystem." + ] portParams :: Maybe Integer -> [CommandParam] portParams Nothing = [] diff --git a/Assistant/Sync.hs b/Assistant/Sync.hs --- a/Assistant/Sync.hs +++ b/Assistant/Sync.hs @@ -164,7 +164,7 @@ updatemap succeeded failed return failed - push branch remote = Command.Sync.pushBranch remote branch + push branch remote = Command.Sync.pushBranch remote (Just branch) parallelPush :: Git.Repo -> [Remote] -> (Remote -> Git.Repo -> IO Bool)-> Assistant ([Remote], [Remote]) parallelPush g rs a = do diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,24 @@ +git-annex (7.20200219) upstream; urgency=medium + + * Added sync --only-annex, which syncs the git-annex branch and annexed + content but leaves managing the other git branches up to you. + * Added annex.synconlyannex git config setting, which can also be set with + git-annex config to configure sync in all clones of the repo. + * fsck --from remote: Fix a concurrency bug that could make it incorrectly + detect that content in the remote is corrupt, and remove it, resulting in + data loss. + * When git-annex is built with a ssh that does not support ssh connection + caching, default annex.sshcaching to false, but let the user override it. + * Improve warning messages further when ssh connection caching cannot + be used, to clearly state why. + * Avoid throwing fatal errors when asked to write to a readonly + git remote on http. + * Fix support for repositories tuned with annex.tune.branchhash1=true, + including --all not working and git-annex log not displaying anything + for annexed files. + + -- Joey Hess Wed, 19 Feb 2020 12:44:43 -0400 + git-annex (7.20200204) upstream; urgency=medium * Fix build with persistent-template 2.8.0. diff --git a/Command/Fsck.hs b/Command/Fsck.hs --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010-2019 Joey Hess + - Copyright 2010-2020 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -161,6 +161,11 @@ ] ai = mkActionItem (key, afile) withtmp a = do + -- Put it in the gitAnnexTmpObjectDir since that's on a + -- filesystem where object temp files are normally + -- stored. The pid prevents multiple fsck processes + -- contending over the same file. (Multiple threads cannot, + -- because OnlyActionOn is used.) pid <- liftIO getPID t <- fromRepo gitAnnexTmpObjectDir createAnnexDirectory t @@ -541,7 +546,7 @@ runFsck :: Incremental -> ActionItem -> Key -> Annex Bool -> CommandStart runFsck inc ai key a = stopUnless (needFsck inc key) $ - starting "fsck" ai $ do + starting "fsck" (OnlyActionOn key ai) $ do ok <- a when ok $ recordFsckTime inc key diff --git a/Command/Log.hs b/Command/Log.hs --- a/Command/Log.hs +++ b/Command/Log.hs @@ -210,6 +210,7 @@ getGitLog :: [FilePath] -> [CommandParam] -> Annex ([RefChange], IO Bool) getGitLog fs os = do + config <- Annex.getGitConfig (ls, cleanup) <- inRepo $ pipeNullSplit $ [ Param "log" , Param "-z" @@ -220,7 +221,7 @@ [ Param $ Git.fromRef Annex.Branch.fullname , Param "--" ] ++ map Param fs - return (parseGitRawLog (map decodeBL' ls), cleanup) + return (parseGitRawLog config (map decodeBL' ls), cleanup) -- Parses chunked git log --raw output, which looks something like: -- @@ -236,8 +237,8 @@ -- -- The timestamp is not included before all changelines, so -- keep track of the most recently seen timestamp. -parseGitRawLog :: [String] -> [RefChange] -parseGitRawLog = parse epoch +parseGitRawLog :: GitConfig -> [String] -> [RefChange] +parseGitRawLog config = parse epoch where epoch = toEnum 0 :: POSIXTime parse oldts ([]:rest) = parse oldts rest @@ -250,7 +251,7 @@ (tss, cl') -> (parseTimeStamp tss, cl') mrc = do (old, new) <- parseRawChangeLine cl - key <- locationLogFileKey (toRawFilePath c2) + key <- locationLogFileKey config (toRawFilePath c2) return $ RefChange { changetime = ts , oldref = old diff --git a/Command/Merge.hs b/Command/Merge.hs --- a/Command/Merge.hs +++ b/Command/Merge.hs @@ -12,7 +12,7 @@ import qualified Git import qualified Git.Branch import Annex.CurrentBranch -import Command.Sync (prepMerge, mergeLocal, mergeConfig, merge) +import Command.Sync (prepMerge, mergeLocal, mergeConfig, merge, SyncOptions(..)) cmd :: Command cmd = command "merge" SectionMaintenance @@ -41,4 +41,5 @@ mergeBranch :: Git.Ref -> CommandStart mergeBranch r = starting "merge" (ActionItemOther (Just (Git.fromRef r))) $ do currbranch <- getCurrentBranch - next $ merge currbranch mergeConfig def Git.Branch.ManualCommit r + let o = def { notOnlyAnnexOption = True } + next $ merge currbranch mergeConfig o Git.Branch.ManualCommit r diff --git a/Command/PostReceive.hs b/Command/PostReceive.hs --- a/Command/PostReceive.hs +++ b/Command/PostReceive.hs @@ -14,7 +14,7 @@ import Git.Types import Annex.UpdateInstead import Annex.CurrentBranch -import Command.Sync (mergeLocal, prepMerge, mergeConfig) +import Command.Sync (mergeLocal, prepMerge, mergeConfig, SyncOptions(..)) -- This does not need to modify the git-annex branch to update the -- work tree, but auto-initialization might change the git-annex branch. @@ -51,4 +51,5 @@ updateInsteadEmulation :: CommandStart updateInsteadEmulation = do prepMerge - mergeLocal mergeConfig def =<< getCurrentBranch + let o = def { notOnlyAnnexOption = True } + mergeLocal mergeConfig o =<< getCurrentBranch diff --git a/Command/Sync.hs b/Command/Sync.hs --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -1,7 +1,7 @@ {- git-annex command - - Copyright 2011 Joachim Breitner - - Copyright 2011-2019 Joey Hess + - Copyright 2011-2020 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -24,6 +24,7 @@ syncBranch, updateBranches, seekExportContent, + SyncOptions(..), ) where import Command @@ -78,8 +79,10 @@ "synchronize local repository with remotes" (paramRepeating paramRemote) (seek <--< optParser) -data SyncOptions = SyncOptions +data SyncOptions = SyncOptions { syncWith :: CmdParams + , onlyAnnexOption :: Bool + , notOnlyAnnexOption :: Bool , commitOption :: Bool , noCommitOption :: Bool , messageOption :: Maybe String @@ -90,13 +93,26 @@ , contentOfOption :: [FilePath] , cleanupOption :: Bool , keyOptions :: Maybe KeyOptions - , resolveMergeOverride :: ResolveMergeOverride + , resolveMergeOverride :: Bool } -newtype ResolveMergeOverride = ResolveMergeOverride Bool - -instance Default ResolveMergeOverride where - def = ResolveMergeOverride False +instance Default SyncOptions where + def = SyncOptions + { syncWith = [] + , onlyAnnexOption = False + , notOnlyAnnexOption = False + , commitOption = False + , noCommitOption = False + , messageOption = Nothing + , pullOption = False + , pushOption = False + , contentOption = False + , noContentOption = False + , contentOfOption = [] + , cleanupOption = False + , keyOptions = Nothing + , resolveMergeOverride = False + } optParser :: CmdParamsDesc -> Parser SyncOptions optParser desc = SyncOptions @@ -104,6 +120,15 @@ ( metavar desc <> completeRemotes )) + <*> switch + ( long "only-annex" + <> short 'a' + <> help "only sync git-annex branch and annexed file contents" + ) + <*> switch + ( long "not-only-annex" + <> help "sync git branches as well as annex" + ) <*> switch ( long "commit" <> help "commit changes to git" @@ -124,16 +149,16 @@ ) <*> switch ( long "content" - <> help "transfer file contents" + <> help "transfer annexed file contents" ) <*> switch ( long "no-content" - <> help "do not transfer file contents" + <> help "do not transfer annexed file contents" ) <*> many (strOption ( long "content-of" <> short 'C' - <> help "transfer file contents of files in a given location" + <> help "transfer contents of annexed files in a given location" <> metavar paramPath )) <*> switch @@ -141,15 +166,17 @@ <> help "remove synced/ branches from previous sync" ) <*> optional parseAllOption - <*> (ResolveMergeOverride <$> invertableSwitch "resolvemerge" True + <*> invertableSwitch "resolvemerge" True ( help "do not automatically resolve merge conflicts" - )) + ) -- Since prepMerge changes the working directory, FilePath options -- have to be adjusted. instance DeferredParseClass SyncOptions where finishParse v = SyncOptions <$> pure (syncWith v) + <*> pure (onlyAnnexOption v) + <*> pure (notOnlyAnnexOption v) <*> pure (commitOption v) <*> pure (noCommitOption v) <*> pure (messageOption v) @@ -189,12 +216,12 @@ -- These actions cannot be run concurrently. mapM_ includeCommandAction $ concat [ [ commit o ] - , [ withbranch (mergeLocal mergeConfig (resolveMergeOverride o)) ] + , [ withbranch (mergeLocal mergeConfig o) ] , map (withbranch . pullRemote o mergeConfig) gitremotes , [ mergeAnnex ] ] - whenM shouldsynccontent $ do + whenM (shouldSyncContent o) $ do mapM_ (withbranch . importRemote o mergeConfig) importremotes -- Send content to any exports before other @@ -215,13 +242,9 @@ , [ commitAnnex, mergeAnnex ] ] - void $ includeCommandAction $ withbranch pushLocal + void $ includeCommandAction $ withbranch $ pushLocal o -- Pushes to remotes can run concurrently. mapM_ (commandAction . withbranch . pushRemote o) gitremotes - where - shouldsynccontent = pure (contentOption o) - <||> pure (not (null (contentOfOption o))) - <||> (pure (not (noContentOption o)) <&&> getGitConfigVal annexSyncContent) {- Merging may delete the current directory, so go to the top - of the repo. This also means that sync always acts on all files in the @@ -241,14 +264,14 @@ , Git.Merge.MergeUnrelatedHistories ] -merge :: CurrBranch -> [Git.Merge.MergeConfig] -> ResolveMergeOverride -> Git.Branch.CommitMode -> Git.Branch -> Annex Bool -merge currbranch mergeconfig resolvemergeoverride commitmode tomerge = case currbranch of +merge :: CurrBranch -> [Git.Merge.MergeConfig] -> SyncOptions -> Git.Branch.CommitMode -> Git.Branch -> Annex Bool +merge currbranch mergeconfig o commitmode tomerge = case currbranch of (Just b, Just adj) -> mergeToAdjustedBranch tomerge (b, adj) mergeconfig canresolvemerge commitmode (b, _) -> autoMergeFrom tomerge b mergeconfig canresolvemerge commitmode where - canresolvemerge = case resolvemergeoverride of - ResolveMergeOverride True -> getGitConfigVal annexResolveMerge - ResolveMergeOverride False -> return False + canresolvemerge = if resolveMergeOverride o + then getGitConfigVal annexResolveMerge + else return False syncBranch :: Git.Branch -> Git.Branch syncBranch = Git.Ref.underBase "refs/heads/synced" . fromAdjustedBranch @@ -296,8 +319,10 @@ ] return True where - shouldcommit = pure (commitOption o) + shouldcommit = notOnlyAnnex o <&&> + ( pure (commitOption o) <||> (pure (not (noCommitOption o)) <&&> getGitConfigVal annexAutoCommit) + ) commitMsg :: Annex String commitMsg = do @@ -316,14 +341,18 @@ void $ inRepo $ Git.Branch.commit commitmode False commitmessage branch parents return True -mergeLocal :: [Git.Merge.MergeConfig] -> ResolveMergeOverride -> CurrBranch -> CommandStart -mergeLocal mergeconfig resolvemergeoverride currbranch@(Just _, _) = +mergeLocal :: [Git.Merge.MergeConfig] -> SyncOptions -> CurrBranch -> CommandStart +mergeLocal mergeconfig o currbranch = stopUnless (notOnlyAnnex o) $ + mergeLocal' mergeconfig o currbranch + +mergeLocal' :: [Git.Merge.MergeConfig] -> SyncOptions -> CurrBranch -> CommandStart +mergeLocal' mergeconfig o currbranch@(Just _, _) = needMerge currbranch >>= \case Nothing -> stop Just syncbranch -> starting "merge" (ActionItemOther (Just $ Git.Ref.describe syncbranch)) $ - next $ merge currbranch mergeconfig resolvemergeoverride Git.Branch.ManualCommit syncbranch -mergeLocal _ _ (Nothing, madj) = do + next $ merge currbranch mergeconfig o Git.Branch.ManualCommit syncbranch +mergeLocal' _ _ (Nothing, madj) = do b <- inRepo Git.Branch.currentUnsafe needMerge (b, madj) >>= \case Nothing -> stop @@ -348,8 +377,8 @@ syncbranch = syncBranch branch branch' = maybe branch (adjBranch . originalToAdjusted branch) madj -pushLocal :: CurrBranch -> CommandStart -pushLocal b = do +pushLocal :: SyncOptions -> CurrBranch -> CommandStart +pushLocal o b = stopUnless (notOnlyAnnex o) $ do updateBranches b stop @@ -388,16 +417,25 @@ pullRemote o mergeconfig remote branch = stopUnless (pure $ pullOption o && wantpull) $ starting "pull" (ActionItemOther (Just (Remote.name remote))) $ do showOutput - ifM fetch - ( next $ mergeRemote remote branch mergeconfig (resolveMergeOverride o) - , next $ return True + ifM (onlyAnnex o) + ( do + void $ fetch $ map Git.fromRef + [ Annex.Branch.name + , syncBranch $ Annex.Branch.name + ] + next $ return True + , ifM (fetch []) + ( next $ mergeRemote remote branch mergeconfig o + , next $ return True + ) ) where - fetch = do + fetch bs = do repo <- Remote.getRepo remote inRepoWithSshOptionsTo repo (Remote.gitconfig remote) $ - Git.Command.runBool + Git.Command.runBool $ [Param "fetch", Param $ Remote.name remote] + ++ map Param bs wantpull = remoteAnnexPull (Remote.gitconfig remote) importRemote :: SyncOptions -> [Git.Merge.MergeConfig] -> Remote -> CurrBranch -> CommandSeek @@ -412,8 +450,7 @@ then Nothing else Just (asTopFilePath (toRawFilePath s)) Command.Import.seekRemote remote branch subdir - void $ mergeRemote remote currbranch mergeconfig - (resolveMergeOverride o) + void $ mergeRemote remote currbranch mergeconfig o where wantpull = remoteAnnexPull (Remote.gitconfig remote) @@ -422,8 +459,8 @@ - were committed (or pushed changes, if this is a bare remote), - while the synced/master may have changes that some - other remote synced to this remote. So, merge them both. -} -mergeRemote :: Remote -> CurrBranch -> [Git.Merge.MergeConfig] -> ResolveMergeOverride -> CommandCleanup -mergeRemote remote currbranch mergeconfig resolvemergeoverride = ifM isBareRepo +mergeRemote :: Remote -> CurrBranch -> [Git.Merge.MergeConfig] -> SyncOptions -> CommandCleanup +mergeRemote remote currbranch mergeconfig o = ifM isBareRepo ( return True , case currbranch of (Nothing, _) -> do @@ -435,31 +472,36 @@ ) where mergelisted getlist = and <$> - (mapM (merge currbranch mergeconfig resolvemergeoverride Git.Branch.ManualCommit . remoteBranch remote) =<< getlist) + (mapM (merge currbranch mergeconfig o Git.Branch.ManualCommit . remoteBranch remote) =<< getlist) tomerge = filterM (changed remote) branchlist Nothing = [] branchlist (Just branch) = [fromAdjustedBranch branch, syncBranch branch] pushRemote :: SyncOptions -> Remote -> CurrBranch -> CommandStart pushRemote _o _remote (Nothing, _) = stop -pushRemote o remote (Just branch, _) = stopUnless (pure (pushOption o) <&&> needpush) $ - starting "push" (ActionItemOther (Just (Remote.name remote))) $ next $ do - repo <- Remote.getRepo remote - showOutput - ok <- inRepoWithSshOptionsTo repo gc $ - pushBranch remote branch - if ok - then postpushupdate repo - else do - warning $ unwords [ "Pushing to " ++ Remote.name remote ++ " failed." ] - showLongNote "(non-fast-forward problems can be solved by setting receive.denyNonFastforwards to false in the remote's git config)" - return ok +pushRemote o remote (Just branch, _) = do + onlyannex <- onlyAnnex o + let mainbranch = if onlyannex then Nothing else Just branch + stopUnless (pure (pushOption o) <&&> needpush mainbranch) $ + starting "push" (ActionItemOther (Just (Remote.name remote))) $ next $ do + repo <- Remote.getRepo remote + showOutput + ok <- inRepoWithSshOptionsTo repo gc $ + pushBranch remote mainbranch + if ok + then postpushupdate repo + else do + warning $ unwords [ "Pushing to " ++ Remote.name remote ++ " failed." ] + return ok where gc = Remote.gitconfig remote - needpush + needpush mainbranch | remoteAnnexReadOnly gc = return False | not (remoteAnnexPush gc) = return False - | otherwise = anyM (newer remote) [syncBranch branch, Annex.Branch.name] + | otherwise = anyM (newer remote) $ catMaybes + [ syncBranch <$> mainbranch + , Just (Annex.Branch.name) + ] -- Older remotes on crippled filesystems may not have a -- post-receive hook set up, so when updateInstead emulation -- is needed, run post-receive manually. @@ -505,20 +547,18 @@ - But overwriting of data on synced/git-annex can happen, in a race. - The only difference caused by using a forced push in that case is that - the last repository to push wins the race, rather than the first to push. - - - - The sync push will fail to overwrite if receive.denyNonFastforwards is - - set on the remote. -} -pushBranch :: Remote -> Git.Branch -> Git.Repo -> IO Bool -pushBranch remote branch g = directpush `after` annexpush `after` syncpush +pushBranch :: Remote -> Maybe Git.Branch -> Git.Repo -> IO Bool +pushBranch remote mbranch g = directpush `after` annexpush `after` syncpush where - syncpush = flip Git.Command.runBool g $ pushparams - [ Git.Branch.forcePush $ refspec Annex.Branch.name - , refspec $ fromAdjustedBranch branch + syncpush = flip Git.Command.runBool g $ pushparams $ catMaybes + [ Just $ Git.Branch.forcePush $ refspec Annex.Branch.name + , (refspec . fromAdjustedBranch) <$> mbranch ] annexpush = void $ tryIO $ flip Git.Command.runQuiet g $ pushparams [ Git.fromRef $ Git.Ref.base $ Annex.Branch.name ] - directpush = do + directpush = case mbranch of + Nothing -> noop -- Git prints out an error message when this fails. -- In the default configuration of receive.denyCurrentBranch, -- the error message mentions that config setting @@ -529,11 +569,12 @@ -- including the error displayed when -- receive.denyCurrentBranch=updateInstead -- the user -- will want to see that one. - let p = flip Git.Command.gitCreateProcess g $ pushparams - [ Git.fromRef $ Git.Ref.base $ fromAdjustedBranch branch ] - (transcript, ok) <- processTranscript' p Nothing - when (not ok && not ("denyCurrentBranch" `isInfixOf` transcript)) $ - hPutStr stderr transcript + Just branch -> do + let p = flip Git.Command.gitCreateProcess g $ pushparams + [ Git.fromRef $ Git.Ref.base $ fromAdjustedBranch branch ] + (transcript, ok) <- processTranscript' p Nothing + when (not ok && not ("denyCurrentBranch" `isInfixOf` transcript)) $ + hPutStr stderr transcript pushparams branches = [ Param "push" , Param $ Remote.name remote @@ -784,3 +825,18 @@ , Param $ Git.fromRef $ syncBranch $ Git.Ref.base $ Annex.Branch.name ] + +shouldSyncContent :: SyncOptions -> Annex Bool +shouldSyncContent o + | noContentOption o = pure False + | contentOption o || not (null (contentOfOption o)) = pure True + | otherwise = getGitConfigVal annexSyncContent <||> onlyAnnex o + +notOnlyAnnex :: SyncOptions -> Annex Bool +notOnlyAnnex o = not <$> onlyAnnex o + +onlyAnnex :: SyncOptions -> Annex Bool +onlyAnnex o + | notOnlyAnnexOption o = pure False + | onlyAnnexOption o = pure True + | otherwise = getGitConfigVal annexSyncOnlyAnnex diff --git a/Logs.hs b/Logs.hs --- a/Logs.hs +++ b/Logs.hs @@ -1,6 +1,6 @@ {- git-annex log file names - - - Copyright 2013-2019 Joey Hess + - Copyright 2013-2020 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -27,8 +27,8 @@ {- Converts a path from the git-annex branch into one of the varieties - of logs used by git-annex, if it's a known path. -} -getLogVariety :: RawFilePath -> Maybe LogVariety -getLogVariety f +getLogVariety :: GitConfig -> RawFilePath -> Maybe LogVariety +getLogVariety config f | f `elem` topLevelOldUUIDBasedLogs = Just OldUUIDBasedLog | f `elem` topLevelNewUUIDBasedLogs = Just NewUUIDBasedLog | isRemoteStateLog f = Just NewUUIDBasedLog @@ -36,7 +36,7 @@ | isChunkLog f = ChunkLog <$> extLogFileKey chunkLogExt f | isRemoteMetaDataLog f = Just RemoteMetaDataLog | isMetaDataLog f || f `elem` otherLogs = Just OtherLog - | otherwise = PresenceLog <$> firstJust (presenceLogs f) + | otherwise = PresenceLog <$> firstJust (presenceLogs config f) {- All the old-format uuid-based logs stored in the top of the git-annex branch. -} topLevelOldUUIDBasedLogs :: [RawFilePath] @@ -61,10 +61,10 @@ {- All the ways to get a key from a presence log file -} -presenceLogs :: RawFilePath -> [Maybe Key] -presenceLogs f = +presenceLogs :: GitConfig -> RawFilePath -> [Maybe Key] +presenceLogs config f = [ urlLogFileKey f - , locationLogFileKey f + , locationLogFileKey config f ] {- Top-level logs that are neither UUID based nor presence logs. -} @@ -218,8 +218,17 @@ urlLogFileKey = extLogFileKey urlLogExt {- Converts a pathname into a key if it's a location log. -} -locationLogFileKey :: RawFilePath -> Maybe Key -locationLogFileKey path - -- Want only xx/yy/foo.log, not .log files in other places. - | length (splitDirectories (fromRawFilePath path)) /= 3 = Nothing +locationLogFileKey :: GitConfig -> RawFilePath -> Maybe Key +locationLogFileKey config path + | length (splitDirectories (fromRawFilePath path)) /= locationLogFileDepth config = Nothing | otherwise = extLogFileKey ".log" path + +{- Depth of location log files within the git-annex branch. + - + - Normally they are xx/yy/key.log so depth 3. + - The same extension is also used for other logs that + - are not location logs. -} +locationLogFileDepth :: GitConfig -> Int +locationLogFileDepth config = hashlevels + 1 + where + HashLevels hashlevels = branchHashLevels config diff --git a/Logs/Location.hs b/Logs/Location.hs --- a/Logs/Location.hs +++ b/Logs/Location.hs @@ -130,8 +130,10 @@ loggedKeys = loggedKeys' (not <$$> checkDead) loggedKeys' :: (Key -> Annex Bool) -> Annex [Unchecked Key] -loggedKeys' check = mapMaybe (defercheck <$$> locationLogFileKey) - <$> Annex.Branch.files +loggedKeys' check = do + config <- Annex.getGitConfig + mapMaybe (defercheck <$$> locationLogFileKey config) + <$> Annex.Branch.files where defercheck k = Unchecked $ ifM (check k) ( return (Just k) diff --git a/Remote/Git.hs b/Remote/Git.hs --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -432,7 +432,9 @@ return True , return False ) - | Git.repoIsHttp repo = giveup "dropping from http remote not supported" + | Git.repoIsHttp repo = do + warning "dropping from http remote not supported" + return False | otherwise = commitOnCleanup repo r $ do let fallback = Ssh.dropKey repo key P2PHelper.remove (Ssh.runProto r connpool (return False) fallback) key @@ -536,7 +538,9 @@ else P2PHelper.retrieve (\p -> Ssh.runProto r connpool (return (False, UnVerified)) (fallback p)) key file dest meterupdate - | otherwise = giveup "copying from non-ssh, non-http remote not supported" + | otherwise = do + warning "copying from non-ssh, non-http remote not supported" + unVerified (return False) where fallback p = unVerified $ feedprogressback $ \p' -> do oh <- mkOutputHandlerQuiet @@ -649,7 +653,9 @@ (\p -> Ssh.runProto r connpool (return False) (copyremotefallback p)) key file meterupdate - | otherwise = giveup "copying to non-ssh repo not supported" + | otherwise = do + warning "copying to non-ssh repo not supported" + return False where copylocal Nothing = return False copylocal (Just (object, checksuccess)) = do diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs --- a/Types/GitConfig.hs +++ b/Types/GitConfig.hs @@ -80,6 +80,7 @@ , annexAutoCommit :: Configurable Bool , annexResolveMerge :: Configurable Bool , annexSyncContent :: Configurable Bool + , annexSyncOnlyAnnex :: Configurable Bool , annexDebug :: Bool , annexWebOptions :: [String] , annexYoutubeDlOptions :: [String] @@ -151,6 +152,8 @@ getmaybebool (annex "resolvemerge") , annexSyncContent = configurable False $ getmaybebool (annex "synccontent") + , annexSyncOnlyAnnex = configurable False $ + getmaybebool (annex "synconlyannex") , annexDebug = getbool (annex "debug") False , annexWebOptions = getwords (annex "web-options") , annexYoutubeDlOptions = getwords (annex "youtube-dl-options") @@ -230,6 +233,7 @@ mergeGitConfig gitconfig repoglobals = gitconfig { annexAutoCommit = merge annexAutoCommit , annexSyncContent = merge annexSyncContent + , annexSyncOnlyAnnex = merge annexSyncOnlyAnnex , annexResolveMerge = merge annexResolveMerge , annexLargeFiles = merge annexLargeFiles , annexAddUnlocked = merge annexAddUnlocked diff --git a/Upgrade/V2.hs b/Upgrade/V2.hs --- a/Upgrade/V2.hs +++ b/Upgrade/V2.hs @@ -67,16 +67,17 @@ locationLogs :: Annex [(Key, FilePath)] locationLogs = do + config <- Annex.getGitConfig dir <- fromRepo gitStateDir liftIO $ do levela <- dirContents dir levelb <- mapM tryDirContents levela files <- mapM tryDirContents (concat levelb) - return $ mapMaybe islogfile (concat files) + return $ mapMaybe (islogfile config) (concat files) where tryDirContents d = catchDefaultIO [] $ dirContents d - islogfile f = maybe Nothing (\k -> Just (k, f)) $ - locationLogFileKey (toRawFilePath f) + islogfile config f = maybe Nothing (\k -> Just (k, f)) $ + locationLogFileKey config (toRawFilePath f) inject :: FilePath -> FilePath -> Annex () inject source dest = do diff --git a/doc/git-annex-sync.mdwn b/doc/git-annex-sync.mdwn --- a/doc/git-annex-sync.mdwn +++ b/doc/git-annex-sync.mdwn @@ -12,7 +12,7 @@ The sync process involves first committing any local changes to files that have previously been added to the repository, -then fetching and merging the `synced/master` and the `git-annex` branch +then fetching and merging the current branch and the `git-annex` branch from the remote repositories, and finally pushing the changes back to those branches on the remote repositories. You can use standard git commands to do each of those steps by hand, or if you don't want to @@ -21,12 +21,19 @@ The content of annexed objects is not synced by default, but the --content option (see below) can make that also be synchronized. -Note that syncing with a remote will not normally update the remote's working -tree with changes made to the local repository. (Unless it's configured -with receive.denyCurrentBranch=updateInstead.) However, those changes -are pushed to the remote, so they can be merged into its working tree -by running "git annex sync" on the remote. +When using git-annex, often remotes are not bare repositories, because +it's helpful to add remotes for nearby machines that you want +to access the same annexed content. Syncing with a non-bare remote will +not normally update the remote's current branch with changes from the local +repository. (Unless the remote is configured with +receive.denyCurrentBranch=updateInstead.) +To make working with such non-bare remotes easier, sync pushes not only +local `master` to remote `master`, but also to remote `synced/master` (and +similar with other branches). When `git-annex sync` is later run on the +remote, it will merge the `synced/` branches that the repository has +received. + # OPTIONS * `[remote]` @@ -39,9 +46,24 @@ Only sync with the remotes with the lowest annex-cost value configured. +* `--only-annex` `-a`, `--not-only-annex` + + Only sync the git-annex branch and annexed content with remotes, + not other git branches. + + This avoids pulling and pushing other branches, and it avoids committing + any local changes. It's up to you to use regular git commands to do that. + + The `annex.synconlyannex` configuration can be set to true to make + this be the default behavior of `git-annex sync`. To override such + a setting, use `--not-only-annex`. + + When this is combined with --no-content, only the git-annex branch + will be synced. + * `--commit`, `--no-commit` - A commit is done by default (unless annex.autocommit is set to false). + A commit is done by default (unless `annex.autocommit` is set to false). Use --no-commit to avoid committing local changes. @@ -51,8 +73,8 @@ * `--pull`, `--no-pull` - By default, git pulls from remotes and imports from some special remotes. - Use --no-pull to disable all pulling. + By default, syncing pulls from remotes and imports from some special + remotes. Use --no-pull to disable all pulling. When `remote..annex-pull` or `remote..annex-sync` are set to false, pulling is disabled for those remotes, and using @@ -60,7 +82,7 @@ * `--push`, `--no-push` - By default, git pushes changes to remotes and exports to some + By default, syncing pushes changes to remotes and exports to some special remotes. Use --no-push to disable all pushing. When `remote..annex-push` or `remote..annex-sync` are @@ -128,7 +150,7 @@ [[git-annex-resolvemerge]](1) for details.) Use `--no-resolvemerge` to disable this automatic merge conflict - resolution. It can also be disabled by setting annex.resolvemerge + resolution. It can also be disabled by setting `annex.resolvemerge` to false. * `--cleanup` diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -1097,7 +1097,15 @@ * `annex.synccontent` - Set to true to make git-annex sync default to syncing content. + Set to true to make git-annex sync default to syncing annexed content. + + To configure the behavior in all clones of the repository, + this can be set in [[git-annex-config]](1). + +* `annex.synconlyannex` + + Set to true to make git-annex sync default to only sincing the git-annex + branch and annexed content. To configure the behavior in all clones of the repository, this can be set in [[git-annex-config]](1). 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: 7.20200204 +Version: 7.20200219 Cabal-Version: >= 1.8 License: AGPL-3 Maintainer: Joey Hess