filter-branch working aside from some edge cases

Added a note to man page about what happens to information that is
recorded in the private journal. Since it uses Branch.get, that
information will be copied when options allow. It seemed better to allow
it and document it than not allow it, since the options allow excluding
repositories and so can be used to exclude private repos if desired.

Command/FilterBranch.hs

@@ -22,6 +22,7 @@ import Git.Index
 import Git.Env
 import Git.UpdateIndex
 import qualified Git.LsTree as LsTree
+import qualified Git.Branch as Git
 import Utility.RawFilePath
 
 import qualified Data.Set as S
@@ -107,12 +108,12 @@ seek :: FilterBranchOptions -> CommandSeek
 seek o = withOtherTmp $ \tmpdir -> do
 	let tmpindex = tmpdir P.</> "index"
 	gc <- Annex.getGitConfig
-	r' <- Annex.inRepo $ \r ->
+	tmpindexrepo <- Annex.inRepo $ \r ->
 		addGitEnv r indexEnv (fromRawFilePath tmpindex)
-	withUpdateIndex r' $ \h -> do
+	withUpdateIndex tmpindexrepo $ \h -> do
 		keyinfomatcher <- mkUUIDMatcher (keyInformation o)
-		configmatcher <- mkUUIDMatcher (repoConfig o)
+		repoconfigmatcher <- mkUUIDMatcher (repoConfig o)
-		
+
 		let addtoindex f sha = liftIO $ streamUpdateIndex' h $
 			pureStreamer $ L.fromStrict $ LsTree.formatLsTree $ LsTree.TreeItem
 				{ LsTree.mode = fromTreeItemType TreeFile
@@ -133,12 +134,14 @@ seek o = withOtherTmp $ \tmpdir -> do
 				-- up the sha of the file in the branch.
 				PreserveFile -> addtoindex f =<< hashBlob c
 
+		-- Add information for all keys that are being included,
+		-- filtering out information for repositories that are not
+		-- being included.
 		let addkeyinfo k = startingCustomOutput k $ do
 			forM_ (keyLogFiles gc k) $ \f ->
 				filterbanch keyinfomatcher f
 					=<< Annex.Branch.get f
 			next (return True)
-
 		let seeker = AnnexedFileSeeker
 			{ startAction = \_ _ k -> addkeyinfo k
 			, checkContentPresent = Nothing
@@ -154,7 +157,27 @@ seek o = withOtherTmp $ \tmpdir -> do
 				(withFilesInGitAnnex ww seeker)
 				=<< workTreeItems ww (includeFiles o)
 	
-	-- TODO output commit
+		-- Add repository configs for all repositories that are
+		-- being included.
+		-- TODO need to include configs for sameas remotes
+		forM_ topLevelUUIDBasedLogs $ \f ->
+			filterbanch repoconfigmatcher f
+				=<< Annex.Branch.get f
+
+		-- Add global configs when included.
+		when (includeGlobalConfig o) $
+			forM_ otherTopLevelLogs $ \f -> do
+				c <- Annex.Branch.get f
+				unless (L.null c) $
+					addtoindex f =<< hashBlob c
+
+	-- Commit the temporary index, and output the result.
+	t <- liftIO $ Git.writeTree tmpindexrepo
 	liftIO $ removeWhenExistsWith removeLink tmpindex
+	cmode <- annexCommitMode <$> Annex.getGitConfig
+	cmessage <- Annex.Branch.commitMessage
+	c <- inRepo $ Git.commitTree cmode cmessage [] t
+	-- TODO export.log trees
+	liftIO $ putStrLn (fromRef c)
   where
 	ww = WarnUnmatchLsFiles

Git/Branch.hs

@@ -1,6 +1,6 @@
 {- git branch stuff
  -
- - Copyright 2011 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2021 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -166,7 +166,7 @@ commitCommand' runner commitmode ps = runner $
  -}
 commit :: CommitMode -> Bool -> String -> Branch -> [Ref] -> Repo -> IO (Maybe Sha)
 commit commitmode allowempty message branch parentrefs repo = do
-	tree <- getSha "write-tree" $ pipeReadStrict [Param "write-tree"] repo
+	tree <- writeTree repo
 	ifM (cancommit tree)
 		( do
 			sha <- commitTree commitmode message parentrefs tree repo
@@ -185,6 +185,9 @@ commitAlways :: CommitMode -> String -> Branch -> [Ref] -> Repo -> IO Sha
 commitAlways commitmode message branch parentrefs repo = fromJust
 	<$> commit commitmode True message branch parentrefs repo
 
+writeTree :: Repo -> IO Sha
+writeTree repo = getSha "write-tree" $ pipeReadStrict [Param "write-tree"] repo
+
 commitTree :: CommitMode -> String -> [Ref] -> Ref -> Repo -> IO Sha
 commitTree commitmode message parentrefs tree repo =
 	getSha "commit-tree" $

Logs.hs

@@ -72,13 +72,9 @@ keyLogFiles config k =
 	, chunkLogFile config k
 	] ++ oldurlLogs config k
 
-{- All the log files that do not contain information specific to a key. -}
+{- All uuid-based logs stored in the top of the git-annex branch. -}
-nonKeyLogFiles :: [RawFilePath]
+topLevelUUIDBasedLogs :: [RawFilePath]
-nonKeyLogFiles = concat
+topLevelUUIDBasedLogs = topLevelNewUUIDBasedLogs ++ topLevelOldUUIDBasedLogs
-	[ topLevelNewUUIDBasedLogs
-	, topLevelOldUUIDBasedLogs
-	, otherTopLevelLogs
-	]
 
 {- All the old-format uuid-based logs stored in the top of the git-annex branch. -}
 topLevelOldUUIDBasedLogs :: [RawFilePath]

doc/git-annex-filter-branch.mdwn

@@ -25,6 +25,12 @@ With no options, no information at all will be included from the git-annex
 branch. Use options to specify what to include. All options can be specified
 multiple times.
 
+Note that, when the repository contains information about a private
+repository (due to `annex.private` being set, or `--private` being used
+with [[git-annex-initremote](1)), that private information will be included
+when allowed by the options, even though it is not recorded on the git-annex
+branch.
+
 # OPTIONS
 
 * `path`

doc/git-annex.mdwn

@@ -1014,7 +1014,7 @@ repository, using [[git-annex-config]]. See its man page for a list.)
 * `annex.commitmessage`
 
   When git-annex updates the git-annex branch, it usually makes up
-  its own commit message ("update"), since users rarely look at or
+  its own commit message (eg "update"), since users rarely look at or
   care about changes to that branch. If you do care, you can
   specify this setting by running commands with
   `-c annex.commitmessage=whatever`