packages feed

git-annex 10.20250102 → 10.20250115

raw patch · 19 files changed

+260/−113 lines, 19 files

Files

Annex/Branch.hs view
@@ -257,7 +257,7 @@ 			mergeIndex jl refs 		let commitrefs = nub $ fullname:refs 		ifM (handleTransitions jl localtransitions commitrefs)-			( runAnnexHook postUpdateAnnexHook+			( runAnnexHook postUpdateAnnexHook annexPostUpdateCommand 			, do 				ff <- if dirty 					then return False@@ -521,12 +521,10 @@ createMessage = fromMaybe "branch created" <$> getCommitMessage  getCommitMessage :: Annex (Maybe String)-getCommitMessage = do-	config <- Annex.getGitConfig-	case annexCommitMessageCommand config of-		Nothing -> return (annexCommitMessage config)-		Just cmd -> catchDefaultIO (annexCommitMessage config) $-			Just <$> liftIO (readProcess "sh" ["-c", cmd])+getCommitMessage = +	outputOfAnnexHook commitMessageAnnexHook annexCommitMessageCommand+		<|>+	(annexCommitMessage <$> Annex.getGitConfig)  {- Stages the journal, and commits staged changes to the branch. -} commit :: String -> Annex ()@@ -724,7 +722,7 @@ setIndexSha ref = do 	f <- fromRepo gitAnnexIndexStatus 	writeLogFile f $ fromRef ref ++ "\n"-	runAnnexHook postUpdateAnnexHook+	runAnnexHook postUpdateAnnexHook annexPostUpdateCommand  {- Stages the journal into the index, and runs an action that  - commits the index to the branch. Note that the action is run
Annex/Content.hs view
@@ -106,9 +106,7 @@ import Utility.Metered import Utility.HumanTime import Utility.TimeStamp-#ifndef mingw32_HOST_OS import Utility.FileMode-#endif import qualified Utility.RawFilePath as R  import qualified System.FilePath.ByteString as P@@ -512,6 +510,12 @@ moveAnnex :: Key -> AssociatedFile -> RawFilePath -> Annex Bool moveAnnex key af src = ifM (checkSecureHashes' key) 	( do+#ifdef mingw32_HOST_OS+		{- Windows prevents deletion of files that are not+		 - writable, and the file could have such a mode.+		 - So avoid problems with deleting the file, now or later. -}+		void $ liftIO $ tryIO $ allowWrite src+#endif 		withObjectLoc key storeobject 		return True 	, return False@@ -733,7 +737,11 @@ 	 -} 	whenM hasThawHook $ 		void $ tryIO $ thawContent file-		+#ifdef mingw32_HOST_OS+	{- Windows prevents deletion of files that are not writable. -}+	void $ liftIO $ tryIO $ allowWrite file+#endif+ 	cleaner 	cleanObjectDirs file 
Annex/Content/LowLevel.hs view
@@ -10,6 +10,7 @@ module Annex.Content.LowLevel where  import Annex.Common+import Annex.Hook import Logs.Transfer import qualified Annex import Utility.DiskFree@@ -25,11 +26,8 @@  - File may or may not be deleted at the end; caller is responsible for  - making sure it's deleted. -} secureErase :: RawFilePath -> Annex ()-secureErase file = maybe noop go =<< annexSecureEraseCommand <$> Annex.getGitConfig-  where-	go basecmd = void $ liftIO $-		boolSystem "sh" [Param "-c", Param $ gencmd basecmd]-	gencmd = massReplace [ ("%file", shellEscape (fromRawFilePath file)) ]+secureErase = void . runAnnexPathHook "%file"+	secureEraseAnnexHook annexSecureEraseCommand  data LinkedOrCopied = Linked | Copied 
Annex/Hook.hs view
@@ -4,7 +4,7 @@  - git-annex not change, otherwise removing old hooks using an old  - version of the script would fail.  -- - Copyright 2013-2019 Joey Hess <id@joeyh.name>+ - Copyright 2013-2025 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -48,6 +48,24 @@ postUpdateAnnexHook :: Git.Hook postUpdateAnnexHook = Git.Hook "post-update-annex" "" [] +preInitAnnexHook :: Git.Hook+preInitAnnexHook = Git.Hook "pre-init-annex" "" []++freezeContentAnnexHook :: Git.Hook+freezeContentAnnexHook = Git.Hook "freezecontent-annex" "" []++thawContentAnnexHook :: Git.Hook+thawContentAnnexHook = Git.Hook "thawcontent-annex" "" []++secureEraseAnnexHook :: Git.Hook+secureEraseAnnexHook = Git.Hook "secure-erase-annex" "" []++commitMessageAnnexHook :: Git.Hook+commitMessageAnnexHook = Git.Hook "commitmessage-annex" "" []++httpHeadersAnnexHook :: Git.Hook+httpHeadersAnnexHook = Git.Hook "http-headers-annex" "" []+ mkHookScript :: String -> String mkHookScript s = unlines 	[ shebang@@ -69,20 +87,70 @@ 	warning $ UnquotedString $ 		Git.hookName h ++ " hook (" ++ Git.hookFile h r ++ ") " ++ msg -{- Runs a hook. To avoid checking if the hook exists every time,- - the existing hooks are cached. -}-runAnnexHook :: Git.Hook -> Annex ()-runAnnexHook hook = do+{- To avoid checking if the hook exists every time, the existing hooks+ - are cached. -}+doesAnnexHookExist :: Git.Hook -> Annex Bool+doesAnnexHookExist hook = do 	m <- Annex.getState Annex.existinghooks 	case M.lookup hook m of-		Just True -> run-		Just False -> noop+		Just exists -> return exists 		Nothing -> do 			exists <- inRepo $ Git.hookExists hook 			Annex.changeState $ \s -> s 				{ Annex.existinghooks = M.insert hook exists m }-			when exists run+			return exists++runAnnexHook :: Git.Hook -> (GitConfig -> Maybe String) -> Annex ()+runAnnexHook hook commandcfg = runAnnexHook' hook commandcfg >>= \case+	Nothing -> noop+	Just failedcommanddesc -> +		warning $ UnquotedString $ failedcommanddesc ++ " failed"++-- Returns Nothing if the hook or GitConfig command succeeded, or a+-- description of what failed.+runAnnexHook' :: Git.Hook -> (GitConfig -> Maybe String) -> Annex (Maybe String)+runAnnexHook' hook commandcfg = ifM (doesAnnexHookExist hook)+	( runhook+	, runcommandcfg+	)   where-	run = unlessM (inRepo $ Git.runHook hook) $ do-		h <- fromRepo $ Git.hookFile hook-		warning $ UnquotedString $ h ++ " failed"+	runhook = ifM (inRepo $ Git.runHook boolSystem hook [])+		( return Nothing+		, do+			h <- fromRepo (Git.hookFile hook)+			commandfailed h+		)+	runcommandcfg = commandcfg <$> Annex.getGitConfig >>= \case+		Nothing -> return Nothing+		Just command ->+			ifM (liftIO $ boolSystem "sh" [Param "-c", Param command])+				( return Nothing+				, commandfailed $ "git configured command '" ++  command ++ "'"+				)+	commandfailed c = return $ Just c++runAnnexPathHook :: String -> Git.Hook -> (GitConfig -> Maybe String) -> RawFilePath -> Annex Bool+runAnnexPathHook pathtoken hook commandcfg p = ifM (doesAnnexHookExist hook)+	( runhook+	, runcommandcfg+	)+  where+	runhook = inRepo $ Git.runHook boolSystem hook [ File (fromRawFilePath p) ]+	runcommandcfg = commandcfg <$> Annex.getGitConfig >>= \case+		Nothing -> return True+		Just basecmd -> liftIO $+			boolSystem "sh" [Param "-c", Param $ gencmd basecmd]+	gencmd = massReplace [ (pathtoken, shellEscape (fromRawFilePath p)) ]++outputOfAnnexHook :: Git.Hook -> (GitConfig -> Maybe String) -> Annex (Maybe String)+outputOfAnnexHook hook commandcfg = ifM (doesAnnexHookExist hook)+	( runhook+	, runcommandcfg+	)+  where+	runhook = inRepo (Git.runHook runhook' hook [])+	runhook' c ps = Just <$> readProcess c (toCommand ps)+	runcommandcfg = commandcfg <$> Annex.getGitConfig >>= \case+		Nothing -> return Nothing+		Just command -> liftIO $ +			Just <$> readProcess "sh" ["-c", command]
Annex/Init.hs view
@@ -1,6 +1,6 @@ {- git-annex repository initialization  -- - Copyright 2011-2024 Joey Hess <id@joeyh.name>+ - Copyright 2011-2025 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -74,17 +74,29 @@  checkInitializeAllowed :: (InitializeAllowed -> Annex a) -> Annex a checkInitializeAllowed a = guardSafeToUseRepo $ noAnnexFileContent' >>= \case-	Nothing -> do-		checkSqliteWorks-		a InitializeAllowed+	Nothing -> runAnnexHook' preInitAnnexHook annexPreInitCommand >>= \case+		Nothing -> do+			checkSqliteWorks+			a InitializeAllowed+		Just failedcommanddesc -> do+			initpreventedby failedcommanddesc+			notinitialized 	Just noannexmsg -> do-		warning "Initialization prevented by .noannex file (remove the file to override)"+		initpreventedby ".noannex file (remove the file to override)" 		unless (null noannexmsg) $ 			warning (UnquotedString noannexmsg)-		giveup "Not initialized."+		notinitialized+  where+	initpreventedby r = warning $ UnquotedString $+		"Initialization prevented by " ++ r+	notinitialized = giveup "Not initialized."  initializeAllowed :: Annex Bool-initializeAllowed = isNothing <$> noAnnexFileContent'+initializeAllowed = noAnnexFileContent' >>= \case+	Nothing -> runAnnexHook' preInitAnnexHook annexPreInitCommand >>= \case+		Nothing -> return True+		Just _ -> return False+	Just _ -> return False  noAnnexFileContent' :: Annex (Maybe String) noAnnexFileContent' = inRepo $@@ -268,7 +280,7 @@ 	getInitializedVersion >>= maybe needsinit checkUpgrade   where 	needsinit =-		whenM (initializeAllowed <&&> check) $ do+		whenM (check <&&> initializeAllowed) $ do 			initialize startupannex Nothing Nothing 			autoEnableSpecialRemotes remotelist 
Annex/Perms.hs view
@@ -33,6 +33,7 @@ ) where  import Annex.Common+import Annex.Hook import Utility.FileMode import Git import Git.ConfigTypes@@ -340,24 +341,24 @@ 	either throwM return v  hasFreezeHook :: Annex Bool-hasFreezeHook = isJust . annexFreezeContentCommand <$> Annex.getGitConfig+hasFreezeHook = +	(isJust . annexFreezeContentCommand <$> Annex.getGitConfig)+		<||>+	(doesAnnexHookExist freezeContentAnnexHook)  hasThawHook :: Annex Bool-hasThawHook = isJust . annexThawContentCommand <$> Annex.getGitConfig+hasThawHook =+	(isJust . annexThawContentCommand <$> Annex.getGitConfig)+		<||>+	(doesAnnexHookExist thawContentAnnexHook)  freezeHook :: RawFilePath -> Annex ()-freezeHook p = maybe noop go =<< annexFreezeContentCommand <$> Annex.getGitConfig-  where-	go basecmd = void $ liftIO $-		boolSystem "sh" [Param "-c", Param $ gencmd basecmd]-	gencmd = massReplace [ ("%path", shellEscape (fromRawFilePath p)) ]+freezeHook = void . runAnnexPathHook "%path"+	freezeContentAnnexHook annexFreezeContentCommand  thawHook :: RawFilePath -> Annex ()-thawHook p = maybe noop go =<< annexThawContentCommand <$> Annex.getGitConfig-  where-	go basecmd = void $ liftIO $-		boolSystem "sh" [Param "-c", Param $ gencmd basecmd]-	gencmd = massReplace [ ("%path", shellEscape (fromRawFilePath p)) ]+thawHook = void . runAnnexPathHook "%path"+	thawContentAnnexHook annexThawContentCommand  {- Calculate mode to use for a directory from the mode to use for a file.  -
Annex/Url.hs view
@@ -35,6 +35,7 @@ import qualified Annex import qualified Utility.Url as U import qualified Utility.Url.Parse as U+import Annex.Hook import Utility.Hash (IncrementalVerifier) import Utility.IPAddress import Network.HTTP.Client.Restricted@@ -75,9 +76,11 @@ 			<*> pure (Just (\u -> "Configuration of annex.security.allowed-url-schemes does not allow accessing " ++ show u)) 			<*> pure U.noBasicAuth 	-	headers = annexHttpHeadersCommand <$> Annex.getGitConfig >>= \case-		Just cmd -> lines <$> liftIO (readProcess "sh" ["-c", cmd])-		Nothing -> annexHttpHeaders <$> Annex.getGitConfig+	headers =+		outputOfAnnexHook httpHeadersAnnexHook annexHttpHeadersCommand+			>>= \case+				Just output -> pure (lines output)+				Nothing -> annexHttpHeaders <$> Annex.getGitConfig 	 	checkallowedaddr = words . annexAllowedIPAddresses <$> Annex.getGitConfig >>= \case 		["all"] -> do
Backend/VURL.hs view
@@ -31,8 +31,12 @@ 			-- Normally there will always be an key 			-- recorded when a VURL's content is available, 			-- because downloading the content from the web in-			-- the first place records one.-			[] -> return False+			-- the first place records one. But, when the+			-- content is downloaded from some other special+			-- remote that claims an url, that might not be the+			-- case. So, default to True when no key is+			-- recorded.+			[] -> return True 			eks -> do 				let check ek = getbackend ek >>= \case 					Nothing -> pure False
CHANGELOG view
@@ -1,3 +1,33 @@+git-annex (10.20250115) upstream; urgency=medium++  * Improve handing of ssh connection problems during +    remote annex.uuid discovery.+  * log: Support --key, as well as --branch and --unused.+  * Avoid verification error when addurl --verifiable is used+    with an url claimed by a special remote other than the web.+  * Fix installation on Android.+  * Allow enableremote of an existing webdav special remote that has+    read-only access.+  * git-remote-annex: Use enableremote rather than initremote.+  * Windows: Fix permission denied error when dropping files that+    have the readonly attribute set.+  * Added freezecontent-annex and thawcontent-annex hooks that +    correspond to the git configs annex.freezecontent and+    annex.thawcontent.+  * Added secure-erase-annex hook that corresponds to the git config+    annex.secure-erase-command.+  * Added commitmessage-annex hook that corresponds to the git config+    annex.commitmessage-command.+  * Added http-headers-annex hook that corresponds to the git config+    annex.http-headers-command.+  * Added git configs annex.post-update-command and annex.pre-commit-command+    that correspond to the post-update-annex and pre-commit-annex hooks.+  * Added annex.pre-init-command git config and pre-init-annex hook+    that is run before git-annex repository initialization.+  * Linux standalone builds' bundled rsync updated to fix security holes.++ -- Joey Hess <id@joeyh.name>  Wed, 15 Jan 2025 11:39:12 -0400+ git-annex (10.20250102) upstream; urgency=medium    * Added config `url.<base>.annexInsteadOf` corresponding to git's
CmdLine/GitRemoteAnnex.hs view
@@ -586,14 +586,15 @@ 	Nothing -> specialRemoteFromUrl sab inittempremote   where 	-- Initialize a new special remote with the provided configuration-	-- and name.+	-- and name. This actually does a Remote.Enable, because the+	-- special remote has already been initialized somewhere before. 	initremote remotename = do 		let c = M.insert SpecialRemote.nameField (Proposed remotename) $ 			M.delete (Accepted "config-uuid") $ 			specialRemoteConfig cfg 		t <- either giveup return (SpecialRemote.findType c) 		dummycfg <- liftIO dummyRemoteGitConfig-		(c', u) <- Remote.setup t Remote.Init (Just (specialRemoteUUID cfg)) +		(c', u) <- Remote.setup t (Remote.Enable c) (Just (specialRemoteUUID cfg))  			Nothing c dummycfg 			`onException` cleanupremote remotename 		Logs.Remote.configSet u c'
Command/Log.hs view
@@ -46,7 +46,7 @@  data LogOptions = LogOptions 	{ logFiles :: CmdParams-	, allOption :: Bool+	, keyOptions :: Maybe KeyOptions 	, sizesOfOption :: Maybe (DeferredParse UUID) 	, sizesOption :: Bool 	, totalSizesOption :: Bool@@ -62,11 +62,7 @@ optParser :: CmdParamsDesc -> Parser LogOptions optParser desc = LogOptions 	<$> cmdParams desc-	<*> switch-		( long "all"-		<> short 'A'-		<> help "display location log changes to all files"-		)+	<*> optional parseKeyOptions 	<*> optional ((parseUUIDOption <$> strOption 		( long "sizesof" 		<> metavar (paramRemote `paramOr` paramDesc `paramOr` paramUUID)@@ -138,22 +134,24 @@ 		zone <- liftIO getCurrentTimeZone 		outputter <- mkOutputter m zone o <$> jsonOutputEnabled 		let seeker = AnnexedFileSeeker-			{ startAction = const $ start o outputter+			{ startAction = const $ \si file key ->+				start o outputter (si, key, mkActionItem (file, key)) 			, checkContentPresent = Nothing 			-- the way this uses the location log would not be 			-- helped by precaching the current value 			, usesLocationLog = False 			}-		case (logFiles o, allOption o) of-			(fs, False) -> withFilesInGitAnnex ww seeker+		case (logFiles o, keyOptions o) of+			([], Just WantAllKeys) -> +				commandAction (startAll o outputter)+			(fs, ko) -> withKeyOptions ko False+				seeker (commandAction . start o outputter)+				(withFilesInGitAnnex ww seeker) 				=<< workTreeItems ww fs-			([], True) -> commandAction (startAll o outputter)-			(_, True) -> giveup "Cannot specify both files and --all" -start :: LogOptions -> (ActionItem -> SeekInput -> Outputter) -> SeekInput -> RawFilePath -> Key -> CommandStart-start o outputter si file key = do+start :: LogOptions -> (ActionItem -> SeekInput -> Outputter) -> (SeekInput, Key, ActionItem) -> CommandStart+start o outputter (si, key, ai) = do 	(changes, cleanup) <- getKeyLog key (passthruOptions o)-	let ai = mkActionItem (file, key) 	showLogIncremental (outputter ai si) changes 	void $ liftIO cleanup 	stop
Command/PreCommit.hs view
@@ -44,7 +44,7 @@ 	-- files in the worktree won't be populated, so populate them here 	Command.Smudge.updateSmudged (Restage False) 	-	runAnnexHook preCommitAnnexHook+	runAnnexHook preCommitAnnexHook annexPreCommitCommand  	-- committing changes to a view updates metadata 	currentView >>= \case
Git/Config.hs view
@@ -255,9 +255,9 @@  {- Runs a command to get the configuration of a repo,  - and returns a repo populated with the configuration, as well as the raw- - output and the standard error of the command. -}-fromPipe :: Repo -> String -> [CommandParam] -> ConfigStyle -> IO (Either SomeException (Repo, S.ByteString, String))-fromPipe r cmd params st = tryNonAsync $ withCreateProcess p go+ - output and the exit status and standard error of the command. -}+fromPipe :: Repo -> String -> [CommandParam] -> ConfigStyle -> IO (Repo, S.ByteString, ExitCode, String)+fromPipe r cmd params st = withCreateProcess p go   where 	p = (proc cmd $ toCommand params) 		{ std_out = CreatePipe@@ -267,9 +267,13 @@ 		withAsync (getstderr pid herr []) $ \errreader -> do 			val <- S.hGetContents hout 			err <- wait errreader-			forceSuccessProcess p pid-			r' <- store val st r-			return (r', val, err)+			exitcode <- waitForProcess pid+			case exitcode of+				ExitSuccess -> do+					r' <- store val st r+					return (r', val, exitcode, err)+				ExitFailure _ ->+					return (r, val, exitcode, err) 	go _ _ _ _ = error "internal"  	getstderr pid herr c = hGetLineUntilExitOrEOF pid herr >>= \case@@ -278,7 +282,7 @@  {- Reads git config from a specified file and returns the repo populated  - with the configuration. -}-fromFile :: Repo -> FilePath -> IO (Either SomeException (Repo, S.ByteString, String))+fromFile :: Repo -> FilePath -> IO (Repo, S.ByteString, ExitCode, String) fromFile r f = fromPipe r "git" 	[ Param "config" 	, Param "--file"
Git/Hook.hs view
@@ -108,8 +108,8 @@ 		doesFileExist f #endif -runHook :: Hook -> Repo -> IO Bool-runHook h r = do+runHook :: (FilePath -> [CommandParam] -> IO a) -> Hook -> [CommandParam] -> Repo -> IO a+runHook runner h ps r = do 	let f = hookFile h r-	(c, ps) <- findShellCommand f-	boolSystem c ps+	(c, cps) <- findShellCommand f+	runner c (cps ++ ps)
Remote/GCrypt.hs view
@@ -22,7 +22,6 @@ import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import qualified System.FilePath.ByteString as P-import Control.Exception import Data.Default  import Annex.Common@@ -59,7 +58,6 @@ import Logs.Remote import Utility.Gpg import Utility.SshHost-import Utility.Tuple import Utility.Directory.Create import Messages.Progress import Types.ProposedAccepted@@ -508,16 +506,25 @@ getGCryptId fast r gc 	| Git.repoIsLocal r || Git.repoIsLocalUnknown r = extract <$> 		liftIO (catchMaybeIO $ Git.Config.read r)-	| not fast = extract . liftM fst3 <$> getM (eitherToMaybe <$>)-		[ Ssh.onRemote NoConsumeStdin r (\f p -> liftIO (Git.Config.fromPipe r f p Git.Config.ConfigList), return (Left $ giveup "configlist failed")) "configlist" [] []-		, getConfigViaRsync r gc+	| not fast = extract <$> getM id+		[ Ssh.onRemote NoConsumeStdin r (configpipe, return Nothing) "configlist" [] []+		, getconfig $ getConfigViaRsync r gc 		] 	| otherwise = return (Nothing, r)   where 	extract Nothing = (Nothing, r) 	extract (Just r') = (fromConfigValue <$> Git.Config.getMaybe coreGCryptId r', r') -getConfigViaRsync :: Git.Repo -> RemoteGitConfig -> Annex (Either SomeException (Git.Repo, S.ByteString, String))+	configpipe f p = getconfig $ liftIO $ +		Git.Config.fromPipe r f p Git.Config.ConfigList++	getconfig a = do+		(r', _, exitcode, _) <- a+		if exitcode == ExitSuccess+			then return (Just r')+			else return Nothing++getConfigViaRsync :: Git.Repo -> RemoteGitConfig -> Annex (Git.Repo, S.ByteString, ExitCode, String) getConfigViaRsync r gc = do 	let (rsynctransport, rsyncurl, _) = rsyncTransport r gc 	opts <- rsynctransport
Remote/Git.hs view
@@ -278,14 +278,25 @@ 	| Git.repoIsSsh r = storeUpdatedRemote $ do 		v <- Ssh.onRemote NoConsumeStdin r 			( pipedconfig Git.Config.ConfigList autoinit (Git.repoDescribe r)-			, return (Left "configlist failed")+			, error "internal" 			) 			"configlist" [] configlistfields 		case v of 			Right r' 				| haveconfig r' -> return r'-				| otherwise -> configlist_failed-			Left _ -> configlist_failed+				| otherwise -> do+					configlist_failed+					return r+			Left exitcode -> do+				-- ssh exits 255 when there was an error+				-- connecting to the remote server.+				if exitcode /= ExitFailure 255 +					then do+						configlist_failed+						return r+					else do+						warning $ UnquotedString $ "Unable to connect to repository " ++ Git.repoDescribe r ++ " to get its annex.uuid configuration."+						return r 	| Git.repoIsHttp r = storeUpdatedRemote geturlconfig 	| Git.GCrypt.isEncrypted r = handlegcrypt =<< getConfigMaybe (remoteAnnexConfig r "uuid") 	| Git.repoIsUrl r = do@@ -298,31 +309,35 @@ 	haveconfig = not . M.null . Git.config  	pipedconfig st mustincludeuuuid configloc cmd params = do-		v <- liftIO $ Git.Config.fromPipe r cmd params st-		case v of-			Right (r', val, _err) -> do+		(r', val, exitcode, _err) <- liftIO $ +			Git.Config.fromPipe r cmd params st+		if exitcode == ExitSuccess+			then do 				unless (isUUIDConfigured r' || val == mempty || not mustincludeuuuid) $ do 					warning $ UnquotedString $ "Failed to get annex.uuid configuration of repository " ++ Git.repoDescribe r 					warning $ UnquotedString $ "Instead, got: " ++ show val 					warning "This is unexpected; please check the network transport!" 				return $ Right r'-			Left l -> do+			else do 				warning $ UnquotedString $ "Unable to parse git config from " ++ configloc-				return $ Left (show l)+				return $ Left exitcode  	geturlconfig = Url.withUrlOptionsPromptingCreds $ \uo -> do 		let url = Git.repoLocation r ++ "/config" 		v <- withTmpFile "git-annex.tmp" $ \tmpfile h -> do 			liftIO $ hClose h 			Url.download' nullMeterUpdate Nothing url tmpfile uo >>= \case-				Right () -> pipedconfig Git.Config.ConfigNullList-					False url "git"-					[ Param "config"-					, Param "--null"-					, Param "--list"-					, Param "--file"-					, File tmpfile-					]+				Right () ->+					pipedconfig Git.Config.ConfigNullList+						False url "git"+						[ Param "config"+						, Param "--null"+						, Param "--list"+						, Param "--file"+						, File tmpfile+						] >>= return . \case+							Right r' -> Right r'+							Left exitcode -> Left $ "git config exited " ++ show exitcode 				Left err -> return (Left err) 		case v of 			Right r' -> do@@ -342,15 +357,7 @@ 				warning $ UnquotedString $ url ++ " " ++ err 				return r -	{- Is this remote just not available, or does-	 - it not have git-annex-shell?-	 - Find out by trying to fetch from the remote. -}-	configlist_failed = case Git.remoteName r of-		Nothing -> return r-		Just n -> do-			whenM (inRepo $ Git.Command.runBool [Param "fetch", Param "--quiet", Param n]) $ do-				set_ignore "does not have git-annex installed" True-			return r+	configlist_failed = set_ignore "does not have git-annex installed" True 	 	set_ignore msg longmessage = do 		case Git.remoteName r of
Remote/WebDAV.hs view
@@ -137,7 +137,9 @@ 	(c', encsetup) <- encryptionSetup c gc 	pc <- either giveup return . parseRemoteConfig c' =<< configParser remote c' 	creds <- maybe (getCreds pc gc u) (return . Just) mcreds-	testDav url creds+	case ss of+		Init -> testDav url creds+		_ -> noop 	gitConfigSpecialRemote u c' [("webdav", "true")] 	c'' <- setRemoteCredPair ss encsetup pc gc (davCreds u) creds 	return (c'', u)
Types/GitConfig.hs view
@@ -97,6 +97,9 @@ 	, annexAlwaysCompact :: Bool 	, annexCommitMessage :: Maybe String 	, annexCommitMessageCommand :: Maybe String+	, annexPreInitCommand :: Maybe String+	, annexPreCommitCommand :: Maybe String+	, annexPostUpdateCommand :: Maybe String 	, annexMergeAnnexBranches :: Bool 	, annexDelayAdd :: Maybe Int 	, annexHttpHeaders :: [String]@@ -190,6 +193,9 @@ 	, annexAlwaysCompact = getbool (annexConfig "alwayscompact") True 	, annexCommitMessage = getmaybe (annexConfig "commitmessage") 	, annexCommitMessageCommand = getmaybe (annexConfig "commitmessage-command")+	, annexPreInitCommand = getmaybe (annexConfig "pre-init-command")+	, annexPreCommitCommand = getmaybe (annexConfig "pre-commit-command")+	, annexPostUpdateCommand = getmaybe (annexConfig "post-update-command") 	, annexMergeAnnexBranches = getbool (annexConfig "merge-annex-branches") True 	, annexDelayAdd = getmayberead (annexConfig "delayadd") 	, annexHttpHeaders = getlist (annexConfig "http-headers")
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 10.20250102+Version: 10.20250115 Cabal-Version: 1.12 License: AGPL-3 Maintainer: Joey Hess <id@joeyh.name>