Merge branch 'master' into git-remote-annex

Annex/AdjustedBranch.hs

@@ -173,7 +173,7 @@ adjustToSymlink' gitannexlink ti@(TreeItem f _m s) = catKey s >>= \case
 
 -- This is a hidden branch ref, that's used as the basis for the AdjBranch,
 -- since pushes can overwrite the OrigBranch at any time. So, changes
--- are propigated from the AdjBranch to the head of the BasisBranch.
+-- are propagated from the AdjBranch to the head of the BasisBranch.
 newtype BasisBranch = BasisBranch Ref
 
 -- The basis for refs/heads/adjusted/master(unlocked) is
@@ -256,7 +256,7 @@ updateAdjustedBranch adj (AdjBranch currbranch) origbranch
 	| not (adjustmentIsStable adj) = do
 		(b, origheadfile, newheadfile) <- preventCommits $ \commitlck -> do
 			-- Avoid losing any commits that the adjusted branch
-			-- has that have not yet been propigated back to the
+			-- has that have not yet been propagated back to the
 			-- origbranch.
 			_ <- propigateAdjustedCommits' True origbranch adj commitlck
 			
@@ -468,28 +468,39 @@ commitAdjustedTree' treesha (BasisBranch basis) parents =
 			(commitAuthorMetaData basiscommit)
 			(commitCommitterMetaData basiscommit)
 			(mkcommit cmode)
-	mkcommit cmode = Git.Branch.commitTree cmode
+	-- Make sure that the exact message is used in the commit,
+	-- since that message is looked for later.
+	-- After git-annex 10.20240227, it's possible to use
+	-- commitTree instead of this, but this is being kept
+	-- for some time, for compatibility with older versions.
+	mkcommit cmode = Git.Branch.commitTreeExactMessage cmode
 		adjustedBranchCommitMessage parents treesha
 
 {- This message should never be changed. -}
 adjustedBranchCommitMessage :: String
 adjustedBranchCommitMessage = "git-annex adjusted branch"
 
+{- Allow for a trailing newline after the message. -}
+hasAdjustedBranchCommitMessage :: Commit -> Bool
+hasAdjustedBranchCommitMessage c = 
+	dropWhileEnd (\x -> x == '\n' || x == '\r') (commitMessage c) 
+		== adjustedBranchCommitMessage
+
 findAdjustingCommit :: AdjBranch -> Annex (Maybe Commit)
 findAdjustingCommit (AdjBranch b) = go =<< catCommit b
   where
 	go Nothing = return Nothing
 	go (Just c)
-		| commitMessage c == adjustedBranchCommitMessage = return (Just c)
+		| hasAdjustedBranchCommitMessage c = return (Just c)
 		| otherwise = case commitParent c of
 			[p] -> go =<< catCommit p
 			_ -> return Nothing
 
 {- Check for any commits present on the adjusted branch that have not yet
- - been propigated to the basis branch, and propagate them to the basis
+ - been propagated to the basis branch, and propagate them to the basis
  - branch and from there on to the orig branch.
  -
- - After propigating the commits back to the basis branch,
+ - After propagating the commits back to the basis branch,
  - rebase the adjusted branch on top of the updated basis branch.
  -}
 propigateAdjustedCommits :: OrigBranch -> Adjustment -> Annex ()
@@ -540,7 +551,7 @@ propigateAdjustedCommits' warnwhendiverged origbranch adj _commitsprevented =
 		return (Right parent)
 	go origsha parent pastadjcommit (sha:l) = catCommit sha >>= \case
 		Just c
-			| commitMessage c == adjustedBranchCommitMessage ->
+			| hasAdjustedBranchCommitMessage c ->
 				go origsha parent True l
 			| pastadjcommit ->
 				reverseAdjustedCommit parent adj (sha, c) origbranch
@@ -577,7 +588,7 @@ reverseAdjustedCommit commitparent adj (csha, basiscommit) origbranch
 			(commitAuthorMetaData basiscommit)
 			(commitCommitterMetaData basiscommit) $
 				Git.Branch.commitTree cmode
-					(commitMessage basiscommit)
+					[commitMessage basiscommit]
 					[commitparent] treesha
 		return (Right revadjcommit)
 
@@ -631,7 +642,7 @@ data AdjustedClone = InAdjustedClone | NotInAdjustedClone
  - checked out adjusted branch; the origin could have the two branches
  - out of sync (eg, due to another branch having been pushed to the origin's
  - origbranch), or due to a commit on its adjusted branch not having been
- - propigated back to origbranch.
+ - propagated back to origbranch.
  -
  - So, find the adjusting commit on the currently checked out adjusted
  - branch, and use the parent of that commit as the basis, and set the

Annex/AdjustedBranch/Merge.hs

@@ -153,7 +153,8 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm
 			then do
 				cmode <- annexCommitMode <$> Annex.getGitConfig
 				c <- inRepo $ Git.Branch.commitTree cmode
-					("Merged " ++ fromRef tomerge) [adjmergecommit]
+					["Merged " ++ fromRef tomerge]
+					[adjmergecommit]
 					(commitTree currentcommit)
 				inRepo $ Git.Branch.update "updating adjusted branch" currbranch c
 				propigateAdjustedCommits origbranch adj

Annex/Branch.hs

@@ -945,9 +945,9 @@ rememberTreeishLocked treeish graftpoint jl = do
 	addedt <- inRepo $ Git.Tree.graftTree treeish graftpoint origtree
 	cmode <- annexCommitMode <$> Annex.getGitConfig
 	c <- inRepo $ Git.Branch.commitTree cmode
-		"graft" [branchref] addedt
+		["graft"] [branchref] addedt
 	c' <- inRepo $ Git.Branch.commitTree cmode
-		"graft cleanup" [c] origtree
+		["graft cleanup"] [c] origtree
 	inRepo $ Git.Branch.update' fullname c'
 	-- The tree in c' is the same as the tree in branchref,
 	-- and the index was updated to that above, so it's safe to

Annex/ExternalAddonProcess.hs

@@ -1,6 +1,6 @@
 {- External addon processes for special remotes and backends.
  -
- - Copyright 2013-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2024 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -33,16 +33,16 @@ data ExternalAddonStartError
 	= ProgramNotInstalled String
 	| ProgramFailure String
 
-startExternalAddonProcess :: String -> ExternalAddonPID -> Annex (Either ExternalAddonStartError ExternalAddonProcess)
-startExternalAddonProcess basecmd pid = do
+startExternalAddonProcess :: String -> [CommandParam] -> ExternalAddonPID -> Annex (Either ExternalAddonStartError ExternalAddonProcess)
+startExternalAddonProcess basecmd ps pid = do
 	errrelayer <- mkStderrRelayer
 	g <- Annex.gitRepo
 	cmdpath <- liftIO $ searchPath basecmd
 	liftIO $ start errrelayer g cmdpath
   where
 	start errrelayer g cmdpath = do
-		(cmd, ps) <- maybe (pure (basecmd, [])) findShellCommand cmdpath
-		let basep = (proc cmd (toCommand ps))
+		(cmd, cmdps) <- maybe (pure (basecmd, [])) findShellCommand cmdpath
+		let basep = (proc cmd (toCommand (cmdps ++ ps)))
 			{ std_in = CreatePipe
 			, std_out = CreatePipe
 			, std_err = CreatePipe

Annex/Import.hs

@@ -86,7 +86,7 @@ data ImportCommitConfig = ImportCommitConfig
 	{ importCommitTracking :: Maybe Sha
 	-- ^ Current commit on the remote tracking branch.
 	, importCommitMode :: Git.Branch.CommitMode
-	, importCommitMessage :: String
+	, importCommitMessages :: [String]
 	}
 
 {- Buils a commit for an import from a special remote.
@@ -251,7 +251,7 @@ buildImportCommit' remote importcommitconfig mtrackingcommit imported@(History t
 
 	mkcommit parents tree = inRepo $ Git.Branch.commitTree
 		(importCommitMode importcommitconfig)
-		(importCommitMessage importcommitconfig)
+		(importCommitMessages importcommitconfig)
 		parents
 		tree
 

Annex/Init.hs

@@ -267,7 +267,7 @@ autoInitialize' check remotelist = getInitializedVersion >>= maybe needsinit che
 			initialize Nothing Nothing
 			autoEnableSpecialRemotes remotelist
 
-{- Checks if a repository is initialized. Does not check version for ugrade. -}
+{- Checks if a repository is initialized. Does not check version for upgrade. -}
 isInitialized :: Annex Bool
 isInitialized = maybe Annex.Branch.hasSibling (const $ return True) =<< getVersion
 

Annex/Locations.hs

@@ -131,7 +131,7 @@ import qualified Utility.RawFilePath as R
  - trailing path separator. Most code does not rely on that, but a few
  - things do. 
  -
- - Everything else should not end in a trailing path sepatator. 
+ - Everything else should not end in a trailing path separator. 
  -
  - Only functions (with names starting with "git") that build a path
  - based on a git repository should return full path relative to the git

Annex/RemoteTrackingBranch.hs

@@ -46,7 +46,7 @@ setRemoteTrackingBranch tb commit =
  -
  - The second parent of the merge commit is the past history of the
  - RemoteTrackingBranch as imported from a remote. When importing a
- - history of trees from a remote, commits can be sythesized from
+ - history of trees from a remote, commits can be synthesized from
  - them, but such commits won't have the same sha due to eg date differing.
  - But since we know that the second parent consists entirely of such
  - import commits, they can be reused when updating the
@@ -77,7 +77,7 @@ makeRemoteTrackingBranchMergeCommit' commitsha importedhistory treesha = do
 	cmode <- annexCommitMode <$> Annex.getGitConfig
 	inRepo $ Git.Branch.commitTree
 			cmode
-			"remote tracking branch"
+			["remote tracking branch"]
 			[commitsha, importedhistory]
 			treesha
 

Annex/Ssh.hs

@@ -407,7 +407,7 @@ fromSshOptionsEnv = map Param . lines
 {- Enables ssh caching for git push/pull to a particular
  - remote git repo. (Can safely be used on non-ssh remotes.)
  -
- - Also propigates any configured ssh-options.
+ - Also propagates any configured ssh-options.
  -
  - Like inRepo, the action is run with the local git repo.
  - But here it's a modified version, with gitEnv to set GIT_SSH=git-annex,

Annex/View.hs

@@ -387,7 +387,7 @@ prop_view_roundtrips (AssociatedFile Nothing) _ _ = True
 prop_view_roundtrips (AssociatedFile (Just f)) metadata visible = or
 	[ B.null (P.takeFileName f) && B.null (P.takeDirectory f)
 	, viewTooLarge view
-	, all hasfields (viewedFiles view (viewedFileFromReference' Nothing) (fromRawFilePath f) metadata)
+	, all hasfields (viewedFiles view (viewedFileFromReference' Nothing Nothing) (fromRawFilePath f) metadata)
 	]
   where
 	view = View (Git.Ref "foo") $
@@ -577,7 +577,7 @@ updateView view madj = do
 			cmode <- annexCommitMode <$> Annex.getGitConfig
 			let msg = "updated " ++ fromRef (branchView view madj)
 			let parent = catMaybes [oldcommit]
-			inRepo (Git.Branch.commitTree cmode msg parent newtree)
+			inRepo (Git.Branch.commitTree cmode [msg] parent newtree)
 		else return Nothing
 
 {- Diff between currently checked out branch and staged changes, and

Annex/View/ViewedFile.hs

@@ -1,6 +1,6 @@
 {- filenames (not paths) used in views
  -
- - Copyright 2014-2023 Joey Hess <id@joeyh.name>
+ - Copyright 2014-2024 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -19,6 +19,7 @@ module Annex.View.ViewedFile (
 
 import Annex.Common
 import Utility.QuickCheck
+import Backend.Utilities (maxExtensions)
 
 import qualified Data.ByteString as S
 
@@ -37,10 +38,12 @@ type MkViewedFile = FilePath -> ViewedFile
  - So, from dir/subdir/file.foo, generate file_%dir%subdir%.foo
  -}
 viewedFileFromReference :: GitConfig -> MkViewedFile
-viewedFileFromReference g = viewedFileFromReference' (annexMaxExtensionLength g)
+viewedFileFromReference g = viewedFileFromReference'
+	(annexMaxExtensionLength g)
+	(annexMaxExtensions g)
 
-viewedFileFromReference' :: Maybe Int -> MkViewedFile
-viewedFileFromReference' maxextlen f = concat $
+viewedFileFromReference' :: Maybe Int -> Maybe Int -> MkViewedFile
+viewedFileFromReference' maxextlen maxextensions f = concat $
 	[ escape (fromRawFilePath base')
 	, if null dirs then "" else "_%" ++ intercalate "%" (map escape dirs) ++ "%"
 	, escape $ fromRawFilePath $ S.concat extensions'
@@ -51,11 +54,12 @@ viewedFileFromReference' maxextlen f = concat $
 	(base, extensions) = case maxextlen of
 		Nothing -> splitShortExtensions (toRawFilePath basefile')
 		Just n -> splitShortExtensions' (n+1) (toRawFilePath basefile')
-	{- Limit to two extensions maximum. -}
+	{- Limit number of extensions. -}
+	maxextensions' = fromMaybe maxExtensions maxextensions
 	(base', extensions')
-		| length extensions <= 2 = (base, extensions)
+		| length extensions <= maxextensions' = (base, extensions)
 		| otherwise = 
-			let (es,more) = splitAt 2 (reverse extensions)
+			let (es,more) = splitAt maxextensions' (reverse extensions)
 			in (base <> mconcat (reverse more), reverse es)
 	{- On Windows, if the filename looked like "dir/c:foo" then
 	 - basefile would look like it contains a drive letter, which will
@@ -101,7 +105,8 @@ prop_viewedFile_roundtrips tf
 	-- Relative filenames wanted, not directories.
 	| any (isPathSeparator) (end f ++ beginning f) = True
 	| isAbsolute f || isDrive f = True
-	| otherwise = dir == dirFromViewedFile (viewedFileFromReference' Nothing f)
+	| otherwise = dir == dirFromViewedFile 
+		(viewedFileFromReference' Nothing Nothing f)
   where
 	f = fromTestableFilePath tf
 	dir = joinPath $ beginning $ splitDirectories f

Annex/YoutubeDl.hs

@@ -372,7 +372,7 @@ youtubePlaylist' url cmd = withTmpFile "yt-dlp" $ \tmpfile h -> do
 				<$> B.readFile tmpfile
 			return $ case partitionEithers v of
 				((parserr:_), _) -> 
-					Left $ "yt-dlp json parse errror: " ++ parserr
+					Left $ "yt-dlp json parse error: " ++ parserr
 				([], r) -> Right r
 		else return $ Left $ if null outerr
 			then "yt-dlp failed"