git-annex 10.20250102 → 10.20250115
raw patch · 19 files changed
+260/−113 lines, 19 files
Files
- Annex/Branch.hs +6/−8
- Annex/Content.hs +11/−3
- Annex/Content/LowLevel.hs +3/−5
- Annex/Hook.hs +79/−11
- Annex/Init.hs +20/−8
- Annex/Perms.hs +13/−12
- Annex/Url.hs +6/−3
- Backend/VURL.hs +6/−2
- CHANGELOG +30/−0
- CmdLine/GitRemoteAnnex.hs +3/−2
- Command/Log.hs +12/−14
- Command/PreCommit.hs +1/−1
- Git/Config.hs +11/−7
- Git/Hook.hs +4/−4
- Remote/GCrypt.hs +13/−6
- Remote/Git.hs +32/−25
- Remote/WebDAV.hs +3/−1
- Types/GitConfig.hs +6/−0
- git-annex.cabal +1/−1
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>