git-annex 10.20260421 → 10.20260520
raw patch · 12 files changed
+211/−107 lines, 12 filesdep +crypton-x509-storedep ~crypton-connectiondep ~http-client-tls
Dependencies added: crypton-x509-store
Dependency ranges changed: crypton-connection, http-client-tls
Files
- Annex/Url.hs +29/−7
- Assistant/Install/AutoStart.hs +0/−3
- CHANGELOG +29/−1
- Command/Info.hs +25/−10
- Command/RemoteDaemon.hs +1/−1
- Command/Sync.hs +107/−76
- Command/Unused.hs +1/−1
- P2P/Http/Client.hs +9/−4
- Types/GitConfig.hs +4/−0
- Utility/Env.hs +0/−1
- Utility/MoveFile.hs +2/−0
- git-annex.cabal +4/−3
Annex/Url.hs view
@@ -39,20 +39,24 @@ import Annex.Hook import Utility.Hash (IncrementalVerifier) import Utility.IPAddress-import Network.HTTP.Client.Restricted import Utility.Metered+import Utility.Env import Git.Credential import qualified BuildInfo import Network.Socket import Network.HTTP.Client import Network.HTTP.Client.TLS+import Network.HTTP.Client.Restricted+import Network.Connection import Text.Read import qualified Data.Set as S #if MIN_VERSION_tls(2,0,0) import qualified Network.Connection as NC import qualified Network.TLS as TLS #endif+import Network.Connection.Internal (ConnectionContext(..))+import Data.X509.CertificateStore defaultUserAgent :: U.UserAgent defaultUserAgent = "git-annex/" ++ BuildInfo.packageversion@@ -100,8 +104,9 @@ then U.DownloadWithConduit $ U.DownloadWithCurlRestricted mempty else U.DownloadWithCurl curlopts+ ctx <- mkconnectioncontext manager <- liftIO $ U.newManager $ - avoidtimeout managersettings+ avoidtimeout $ managersettings ctx return (urldownloader, manager) allowedaddrsports -> do addrmatcher <- liftIO $ @@ -122,8 +127,9 @@ if isallowed (addrAddress addr) then Nothing else Just (connectionrestricted addr)- (settings, pr) <- liftIO $ - mkRestrictedManagerSettings r Nothing tlssettings+ ctx <- mkconnectioncontext+ (settings, pr) <- liftIO $+ mkRestrictedManagerSettings r (Just ctx) tlssettings case pr of Nothing -> return () Just ProxyRestricted -> toplevelWarning True@@ -146,10 +152,26 @@ def { TLS.supportedExtendedMainSecret = TLS.AllowEMS } #endif | otherwise = Nothing- managersettings = case tlssettings of- Nothing -> tlsManagerSettings- Just v -> mkManagerSettings v Nothing + managersettings ctx = case tlssettings of+ Nothing -> mkManagerSettingsContext (Just ctx) def Nothing+ Just v -> mkManagerSettingsContext (Just ctx) v Nothing+ + mkconnectioncontext =+ getCAPath >>= \case+ Just p -> liftIO $ mkconnectioncontext' p+ Nothing -> liftIO $ initConnectionContext+ mkconnectioncontext' p = + ConnectionContext . fromMaybe mempty+ <$> readCertificateStore p++ getCAPath = getM id+ [ liftIO (getEnv "GIT_SSL_CAINFO")+ , liftIO (getEnv "GIT_SSL_CAPATH")+ , httpSslCAInfo <$> Annex.getGitConfig+ , httpSslCAPath <$> Annex.getGitConfig+ ]+ -- http-client defailts to timing out a request after 30 seconds -- or so, but some web servers are slower and git-annex has its own -- separate timeout controls, so disable that.
Assistant/Install/AutoStart.hs view
@@ -14,9 +14,6 @@ import Utility.FreeDesktop #ifdef darwin_HOST_OS import Utility.OSX-import Utility.Path-import Utility.SystemDirectory-import Utility.FileSystemEncoding #endif installAutoStart :: String -> OsPath -> IO ()
CHANGELOG view
@@ -1,4 +1,32 @@-git-annex (10.20260420) upstream; urgency=medium+git-annex (10.20260520) upstream; urgency=medium++ * Behavior change: git-annex sync now defaults to syncing content,+ for consistency with push and pull. However, to avoid surprising+ behavior, this only affects repositories that have preferred content+ configured.+ (Use --no-content or configure annex.synccontent to avoid this.)+ * Behavior change to git-annex pull and push's handling of unwanted+ files. While previously both commands dropped unwanted files from+ both the remote and the local repository, now pull only drops unwanted+ files from the local repository, and push only drops unwanted files+ from the remote.+ * info: Report the total size of unused keys found by the last run+ of git-annex unused.+ * push: When pushing to a bare git repository, display git push+ progress before the display of pushed branches.+ * push, pull, assist: Fix behavior of --content to override the+ annex.synccontent configuration.+ * Send git-annex (or other configured) User-Agent when connecting to+ annex+http remotes.+ * Support GIT_SSL_CAINFO, GIT_SSL_CAPATH, http.sslCAPath, and http.sslCAPath+ when connecting to https servers.+ * Linux standalone builds now bundle CA certs. They are used only when+ the system does not have its own CA cert store.+ * Linux standalone build supports using Fedora's CA cert store location.++ -- Joey Hess <id@joeyh.name> Wed, 20 May 2026 09:16:07 -0400++git-annex (10.20260421) upstream; urgency=medium * disableremote: New command. * Fix annexUrl to inherit any password that is set in the remote url.
Command/Info.hs view
@@ -1,6 +1,6 @@ {- git-annex command -- - Copyright 2011-2025 Joey Hess <id@joeyh.name>+ - Copyright 2011-2026 Joey Hess <id@joeyh.name> - - Licensed under the GNU AGPL version 3 or higher. -}@@ -33,6 +33,7 @@ import Logs.UUID import Logs.Trust import Logs.Location+import Logs.Unused import Annex.Branch (UnmergedBranches(..), getUnmergedRefs) import Annex.NumCopies import Git.Config (boolConfig)@@ -293,6 +294,7 @@ global_slow_stats = [ tmp_size , bad_data_size+ , unused_data_size , local_annex_keys , local_annex_size , known_annex_files True@@ -469,11 +471,16 @@ treeDesc False = "tree" tmp_size :: Stat-tmp_size = staleSize "temporary object directory size" gitAnnexTmpObjectDir+tmp_size = staleDirSize "temporary object directory size" gitAnnexTmpObjectDir bad_data_size :: Stat-bad_data_size = staleSize "bad keys size" gitAnnexBadDir+bad_data_size = staleDirSize "bad keys size" gitAnnexBadDir +unused_data_size :: Stat+unused_data_size = staleSize "unused keys size"+ (M.keys <$> readUnusedLog (literalOsPath ""))+ (pure (calcRepo . gitAnnexLocation))+ key_size :: Key -> Stat key_size k = simpleStat "size" $ showSizeKeys $ addKey k emptyKeyInfo @@ -829,11 +836,18 @@ "+ " ++ show (unknownSizeKeys d) ++ " unknown size" -staleSize :: String -> (Git.Repo -> OsPath) -> Stat-staleSize label dirspec = Stat label $ do- keys <- lift $ dirKeys dirspec - onsize =<< sum <$> keysizes keys+staleDirSize :: String -> (Git.Repo -> OsPath) -> Stat+staleDirSize label dirspec = staleSize label (dirKeys dirspec) getpath where+ getpath = do+ dir <- fromRepo dirspec+ return (\k -> pure (dir </> keyFile k))++staleSize :: String -> Annex [Key] -> (Annex (Key -> Annex OsPath)) -> Stat+staleSize label listkeys getpath = Stat label $ do+ keys <- lift listkeys+ onsize =<< sum <$> lift (keysizes keys)+ where onsize 0 = return Nothing onsize size = return $ Just $ let val = do@@ -841,9 +855,10 @@ return $ sizer storageUnits False size in json (++ aside "clean up with git-annex unused") val label keysizes keys = do- dir <- lift $ fromRepo dirspec- liftIO $ forM keys $ \k -> - catchDefaultIO 0 $ getFileSize (dir </> keyFile k)+ getpath' <- getpath+ forM keys $ \k -> do+ p <- getpath' k+ liftIO $ catchDefaultIO 0 $ getFileSize p aside :: String -> String aside s = " (" ++ s ++ ")"
Command/RemoteDaemon.hs view
@@ -12,8 +12,8 @@ import Command import RemoteDaemon.Core import Utility.Daemon-import qualified Annex #ifndef mingw32_HOST_OS+import qualified Annex import Annex.Path import Utility.OpenFd #endif
Command/Sync.hs view
@@ -273,7 +273,6 @@ ] remotes <- mapM (pushToCreate o) =<< syncRemotes (syncWith o)- warnSyncContentTransition o remotes -- Remotes that git can push to and pull from. let gitremotes = filter Remote.gitSyncableRemote remotes -- Remotes that contain annex object content.@@ -290,14 +289,16 @@ , [ mergeAnnex ] ] - content <- shouldSyncContent o+ (content, syncwith) <- shouldSyncContent o+ changehere <- syncwith <$> getUUID+ let pushremotes = filter (syncwith . Remote.uuid) contentremotes when content $ whenM (annexSyncMigrations <$> Annex.getGitConfig) $ Command.Migrate.seekDistributedMigrations True forM_ (filter isImport contentremotes) $- withbranch . importRemote content o+ withbranch . importRemote changehere o forM_ (filter isThirdPartyPopulated contentremotes) $ pullThirdPartyPopulated o @@ -306,7 +307,7 @@ -- repositories, in case that lets content -- be dropped from other repositories. exportedcontent <- withbranch $- seekExportContent (Just o) contentremotes+ seekExportContent (Just o) pushremotes -- Sync content with remotes, including -- importing from import remotes (since@@ -319,6 +320,8 @@ syncedcontent <- withbranch $ seekSyncContent o (filter shouldsynccontent contentremotes)+ (filter shouldsynccontent pushremotes)+ changehere -- Transferring content can take a while, -- and other changes can be pushed to the@@ -736,25 +739,36 @@ -} pushBranch :: Remote -> Maybe Git.Branch -> MessageState -> Git.Repo -> IO Bool pushBranch remote mbranch ms g = do- directpush- annexpush `after` syncpush+ directpushed <- directpush+ annexpush `after` syncpush directpushed where directpush = case mbranch of Just branch -> do- let p = flip Git.Command.gitCreateProcess g $ pushparams- [ Git.fromRef $ Git.Ref.base $ origBranch branch ]+ let p = flip Git.Command.gitCreateProcess g $+ pushparams True+ [ Git.fromRef $ Git.Ref.base $ origBranch branch ] let p' = p { std_err = CreatePipe } bracket (createProcess p') cleanupProcess $ \h -> do filterstderr [] (stderrHandle h) (processHandle h) void $ waitForProcess (processHandle h)- Nothing -> noop+ return True+ Nothing -> return False - syncpush = flip Git.Command.runBool g $ pushparams $ catMaybes- [ (syncrefspec . origBranch) <$> mbranch- , Just $ Git.Branch.forcePush $ syncrefspec Annex.Branch.name- ]+ syncpush directpushed = do+ let p = flip Git.Command.gitCreateProcess g $+ pushparams (not directpushed) $ catMaybes+ [ (syncrefspec . origBranch) <$> mbranch+ , Just $ Git.Branch.forcePush $ syncrefspec Annex.Branch.name+ ]+ -- stderr is relayed through a pipe so that the push+ -- progress is not displayed a second time when the+ -- directpush already displayed push progress.+ let p' = p { std_err = CreatePipe }+ bracket (createProcess p') cleanupProcess $ \h -> do+ relaystderr (stderrHandle h) (processHandle h)+ checkSuccessProcess (processHandle h) - annexpush = void $ tryIO $ flip Git.Command.runQuiet g $ pushparams+ annexpush = void $ tryIO $ flip Git.Command.runQuiet g $ pushparams False [ Git.fromRef $ Git.Ref.base $ Annex.Branch.name ] -- In the default configuration of receive.denyCurrentBranch,@@ -779,11 +793,19 @@ unless (any ("receive.denyCurrentBranch" `isInfixOf`) buf) $ mapM_ (hPutStrLn stderr) (reverse buf) - pushparams branches = catMaybes+ relaystderr herr pid = hGetLineUntilExitOrEOF pid herr >>= \case+ Just l -> do+ hPutStrLn stderr l+ relaystderr herr pid+ Nothing -> return ()++ pushparams forceprogress branches = catMaybes [ Just $ Param "push" , if commandProgressDisabled' ms then Just $ Param "--quiet"- else Nothing+ else if forceprogress+ then Just $ Param "--progress"+ else Nothing , Just $ Param $ Remote.name remote ] ++ map Param branches @@ -833,9 +855,10 @@ - - When concurrency is enabled, files are processed concurrently. -}-seekSyncContent :: SyncOptions -> [Remote] -> CurrBranch -> Annex Bool-seekSyncContent _ [] _ = return False-seekSyncContent o rs currbranch = do+seekSyncContent :: SyncOptions -> [Remote] -> [Remote] -> Bool -> CurrBranch -> Annex Bool+seekSyncContent _ [] _ _ _ = return False+seekSyncContent _ _ [] False _ = return False+seekSyncContent o rs pushrs changehere currbranch = do mvar <- liftIO newEmptyMVar bloom <- case keyOptions o of Just WantAllKeys -> ifM preferredcontentmatchesfilenames@@ -894,7 +917,7 @@ go ebloom mvar af k = do let ai = OnlyActionOn k (ActionItemKey k) startingNoMessage ai $ do- whenM (syncFile o ebloom rs af k) $+ whenM (syncFile o ebloom rs pushrs changehere af k) $ void $ liftIO $ tryPutMVar mvar () next $ return True @@ -907,21 +930,23 @@ {- If it's preferred content, and we don't have it, get it from one of the - listed remotes (preferring the cheaper earlier ones). -- - Send it to each remote that doesn't have it, and for which it's+ - Send it to each pushrs that doesn't have it, and for which it's - preferred content. -- - Drop it locally if it's not preferred content (honoring numcopies).- - - - Drop it from each remote that has it, where it's not preferred content+ - When pulling, drop it locally if it's not preferred content - (honoring numcopies).+ - + - When pushing, drop it from each remote that has it, where it's+ - not preferred content (honoring numcopies). - - Returns True if any file transfers were made. -}-syncFile :: SyncOptions -> Either (Maybe (Bloom Key)) (Key -> Annex ()) -> [Remote] -> AssociatedFile -> Key -> Annex Bool-syncFile o ebloom rs af k = do+syncFile :: SyncOptions -> Either (Maybe (Bloom Key)) (Key -> Annex ()) -> [Remote] -> [Remote] -> Bool -> AssociatedFile -> Key -> Annex Bool+syncFile o ebloom rs pushrs changehere af k = do inhere <- inAnnex k locs <- map Remote.uuid <$> Remote.keyPossibilities (Remote.IncludeIgnored False) k- let (have, lack) = partition (\r -> Remote.uuid r `elem` locs) rs+ let have = filter (\r -> Remote.uuid r `elem` locs) rs+ let lack = filter (\r -> Remote.uuid r `notElem` locs) pushrs got <- anyM id =<< handleget have inhere let inhere' = inhere || got@@ -949,29 +974,32 @@ -- includeCommandAction for drops, -- because a failure to drop does not mean -- the sync failed.- handleDropsFrom locs' rs "unwanted" True k af si []+ handleDropsFrom locs' dropfromrs "unwanted" dropfromhere+ k af si [] callCommandAction return (got || not (null putrs)) where wantget lu have inhere = allM id - [ pure (pullOption o || operationMode o == SatisfyMode)+ [ pure (pullOption o || satisfymode) , pure (not $ null have) , pure (not inhere) , wantGet lu True (Just k) af ]- handleget have inhere = do- lu <- prepareLiveUpdate Nothing k AddingKey- ifM (wantget lu have inhere)- ( return [ get lu have ]- , return []- )+ handleget have inhere+ | changehere = do+ lu <- prepareLiveUpdate Nothing k AddingKey+ ifM (wantget lu have inhere)+ ( return [ get lu have ]+ , return []+ )+ | otherwise = return [] get lu have = includeCommandAction $ starting "get" ai si $ stopUnless (getKey' lu k af have) $ next $ return True wantput lu r- | pushOption o == False && operationMode o /= SatisfyMode = return False+ | pushOption o == False && not satisfymode = return False | Remote.readonly r || remoteAnnexReadOnly (Remote.gitconfig r) = return False | isImport r && not (isExport r) = return False | isExport r && not (exportHasAnnexObjects r) = return False@@ -989,7 +1017,15 @@ | otherwise = return [] put lu dest = includeCommandAction $ Command.Move.toStart' lu dest Command.Move.RemoveNever af k ai si+ + dropfromhere = changehere && (pullOption o || satisfymode) + dropfromrs+ | pushOption o || satisfymode = pushrs+ | otherwise = []+ + satisfymode = operationMode o == SatisfyMode+ ai = mkActionItem (k, af) si = SeekInput [] @@ -1128,48 +1164,43 @@ ai = ActionItemOther (Just (UnquotedString (Remote.name remote))) si = SeekInput [] -shouldSyncContent :: SyncOptions -> Annex Bool+getAnnexSyncContent :: Annex (Maybe Bool)+getAnnexSyncContent = + getGitConfigVal' annexSyncContent >>= return . \case+ HasGlobalConfig (Just c) -> Just c+ HasGitConfig (Just c) -> Just c+ _ -> Nothing++{- Should content be synced at all, and given a UUID, should it be synced+ - with that uuid? -}+shouldSyncContent :: SyncOptions -> Annex (Bool, UUID -> Bool) shouldSyncContent o- | fromMaybe False (noContentOption o) = pure False- | operationMode o == SatisfyMode = pure True- -- For git-annex pull and git-annex push and git-annex assist,- -- annex.syncontent defaults to True unless set- | operationMode o /= SyncMode = annexsynccontent True- | fromMaybe False (contentOption o) || not (null (contentOfOption o)) = pure True- -- For git-annex sync, - -- annex.syncontent defaults to False unless set- | otherwise = annexsynccontent False <||> onlyAnnex o+ | fromMaybe False (noContentOption o) = neversync+ | fromMaybe False (contentOption o) = alwayssync+ | not (null (contentOfOption o)) = alwayssync+ | operationMode o == SatisfyMode = alwayssync+ | operationMode o == SyncMode = + ifM (onlyAnnex o)+ ( alwayssync+ , getAnnexSyncContent >>= \case+ Just b -> syncwhen b+ Nothing -> syncwhenpreferredcontentconfigured+ )+ | otherwise = syncwhen =<< fromMaybe True <$> getAnnexSyncContent where- annexsynccontent d = - getGitConfigVal' annexSyncContent >>= \case- HasGlobalConfig (Just c) -> return c- HasGitConfig (Just c) -> return c- _ -> return d+ syncwhen b = pure (b, const b)+ alwayssync = syncwhen True+ neversync = syncwhen False --- See doc/todo/finish_sync_content_transition.mdwn-warnSyncContentTransition :: SyncOptions -> [Remote] -> Annex ()-warnSyncContentTransition o remotes- | operationMode o /= SyncMode = noop- | isJust (noContentOption o) || isJust (contentOption o) = noop- | not (null (contentOfOption o)) = noop- | otherwise = getGitConfigVal' annexSyncContent >>= \case- HasGlobalConfig (Just _) -> noop- HasGitConfig (Just _) -> noop- _ -> do- m <- preferredContentMap- hereu <- getUUID- when (any (preferredcontentconfigured m) (hereu:map Remote.uuid remotes)) $- showwarning- where- showwarning = earlyWarning $- "git-annex sync will change default behavior in the future to"- <> " sync content with repositories that have"- <> " preferred content configured. If you do not want this to"- <> " sync any content, use --no-content (or -g)"- <> " to prepare for that change."- <> " (Or you can configure annex.synccontent)"- preferredcontentconfigured m u = - maybe False (not . isEmpty . fst) (M.lookup u m)+ {- This handles the special case of git-annex sync defaulting to only+ - syncing content with repositories that have preferred content+ - configured. -}+ syncwhenpreferredcontentconfigured = do+ m <- preferredContentMap+ let checkisconfigured u =+ maybe False (not . isEmpty . fst)+ (M.lookup u m)+ return (True, checkisconfigured) notOnlyAnnex :: SyncOptions -> Annex Bool notOnlyAnnex o = not <$> onlyAnnex o@@ -1179,7 +1210,7 @@ | notOnlyAnnexOption o = pure False | onlyAnnexOption o = pure True | otherwise = getGitConfigVal annexSyncOnlyAnnex- + isExport :: Remote -> Bool isExport = exportTree . Remote.config
Command/Unused.hs view
@@ -150,7 +150,7 @@ unusedMsg' u mheader mtrailer = unlines $ mheader ++ table u ++- ["(To see where this data was previously used, run: git annex whereused --historical --unused"] +++ ["(To see where this data was previously used, run: git annex whereused --historical --unused)"] ++ mtrailer remoteUnusedMsg :: Maybe Remote -> RemoteName -> [(Int, Key)] -> String
P2P/Http/Client.hs view
@@ -94,14 +94,19 @@ case p2pHttpBaseUrl <$> remoteAnnexP2PHttpUrl (gitconfig rmt) of Nothing -> error "internal" Just baseurl -> do- mgr <- httpManager <$> getUrlOptions Nothing- let clientenv = mkClientEnv mgr baseurl+ uo <- getUrlOptions (Just (gitconfig rmt))+ let clientenv = mkClientEnv (httpManager uo) baseurl+ let clientenv' = clientenv+ { makeClientRequest = \u r -> + applyRequest uo+ <$> makeClientRequest clientenv u r+ } ccv <- Annex.getRead Annex.gitcredentialcache Git.CredentialCache cc <- liftIO $ atomically $ readTMVar ccv case M.lookup (Git.CredentialBaseURL credentialbaseurl) cc of- Nothing -> go clientenv Nothing False Nothing versions- Just cred -> go clientenv (Just cred) True (credauth cred) versions+ Nothing -> go clientenv' Nothing False Nothing versions+ Just cred -> go clientenv' (Just cred) True (credauth cred) versions where versions = filter allowedversion allProtocolVersions go clientenv mcred credcached mauth (v:vs) = do
Types/GitConfig.hs view
@@ -165,6 +165,8 @@ , coreSharedRepository :: SharedRepository , coreQuotePath :: QuotePath , receiveDenyCurrentBranch :: DenyCurrentBranch+ , httpSslCAInfo :: Maybe String+ , httpSslCAPath :: Maybe String , gcryptId :: Maybe String , gpgCmd :: GpgCmd , mergeDirectoryRenames :: Maybe String@@ -296,6 +298,8 @@ , coreSharedRepository = getSharedRepository r , coreQuotePath = QuotePath (getbool "core.quotepath" True) , receiveDenyCurrentBranch = getDenyCurrentBranch r+ , httpSslCAInfo = getmaybe "http.sslcainfo"+ , httpSslCAPath = getmaybe "http.sslcapath" , gcryptId = getmaybe "core.gcrypt-id" , gpgCmd = mkGpgCmd (getmaybe "gpg.program") , mergeDirectoryRenames = getmaybe "directoryrenames"
Utility/Env.hs view
@@ -19,7 +19,6 @@ #ifdef mingw32_HOST_OS import Utility.Exception-import Control.Applicative import Data.Maybe import qualified System.Environment as E #else
Utility/MoveFile.hs view
@@ -80,5 +80,7 @@ (Right s) -> return $ isDirectory s #endif +#ifndef mingw32_HOST_OS copyright :: Copyright copyright = author JoeyHess (2022-11)+#endif
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 10.20260421+Version: 10.20260520 Cabal-Version: 1.12 License: AGPL-3 Maintainer: Joey Hess <id@joeyh.name>@@ -232,7 +232,7 @@ edit-distance, resourcet, http-client (>= 0.5.3),- http-client-tls,+ http-client-tls (>= 0.3.2), http-types (>= 0.7), http-conduit (>= 2.3.0), http-client-restricted (>= 0.0.2),@@ -274,7 +274,8 @@ git-lfs (>= 1.2.0), clock (>= 0.3.0), crypton,- crypton-connection,+ crypton-connection (>= 0.4.3),+ crypton-x509-store, tls, servant, servant-server,