git-annex 10.20240731 → 10.20240808

raw patch · 10 files changed

+37/−20 lines, 10 files

Files

Annex.hs +1/−1
Annex/Proxy.hs +0/−1
Annex/Startup.hs +3/−3
CHANGELOG +11/−0
Logs/Cluster.hs +8/−2
Logs/Location.hs +1/−1
P2P/Http/Client.hs +4/−1
P2P/Http/Url.hs +3/−2
Types/GitConfig.hs +5/−8
git-annex.cabal +1/−1

Annex.hs view

@@ -197,7 +197,7 @@ 	, preferredcontentmap :: Maybe (FileMatcherMap Annex) 	, requiredcontentmap :: Maybe (FileMatcherMap Annex) 	, remoteconfigmap :: Maybe (M.Map UUID RemoteConfig)-	, clusters :: Maybe Clusters+	, clusters :: Maybe (Annex Clusters) 	, forcetrust :: TrustMap 	, trustmap :: Maybe TrustMap 	, groupmap :: Maybe GroupMap

Annex/Proxy.hs view

@@ -210,7 +210,6 @@ 	storetofile _ _ n [] = pure n 	storetofile iv h n (b:bs) = do 		writeVerifyChunk iv h b-		B.hPut h b 		storetofile iv h (n - fromIntegral (B.length b)) bs  	proxyget offset af k = withproxytmpfile k $ \tmpfile -> do

Annex/Startup.hs view

@@ -35,10 +35,10 @@  -} startupAnnex :: Annex () startupAnnex = doQuietAction $-	-- Logs.Location needs clusters to be loaded before it is used,-	-- in order for a cluster to be treated as the location of keys+	-- Logs.Location needs this before it is used, in order for a+	-- cluster to be treated as the location of keys 	-- that are located in any of its nodes.-	void loadClusters+	preLoadClusters  startupSignals :: Annex () startupSignals = do

CHANGELOG view

@@ -1,3 +1,14 @@+git-annex (10.20240808) upstream; urgency=medium++  * Remove debug output (to stderr) accidentially included in+    last version.+  * When getting from a P2P HTTP remote, prompt for credentials when+    required, instead of failing.+  * When proxying an upload to a special remote, verify the hash.+  * Avoid loading cluster log at startup.++ -- Joey Hess <id@joeyh.name>  Thu, 08 Aug 2024 15:26:26 -0400+ git-annex (10.20240731) upstream; urgency=medium    * New HTTP API that is equivilant to the P2P protocol.

Logs/Cluster.hs view

@@ -11,6 +11,7 @@ 	module Types.Cluster, 	getClusters, 	loadClusters,+	preLoadClusters, 	recordCluster, ) where @@ -24,8 +25,13 @@ import qualified Data.Set as S  getClusters :: Annex Clusters-getClusters = maybe loadClusters return	=<< Annex.getState Annex.clusters+getClusters = maybe loadClusters id =<< Annex.getState Annex.clusters +{- This works around a module dependency loop. -}+preLoadClusters :: Annex ()+preLoadClusters = Annex.changeState $ \s ->+	s { Annex.clusters = Just loadClusters }+ {- Loads the clusters and caches it for later.  -  - This takes care of removing dead nodes from clusters,@@ -37,5 +43,5 @@ 	dead <- (S.fromList . map ClusterNodeUUID) 		<$> trustGet DeadTrusted 	clusters <- getClustersWith (M.map (`S.difference` dead))-	Annex.changeState $ \s -> s { Annex.clusters = Just clusters }+	Annex.changeState $ \s -> s { Annex.clusters = Just (pure clusters) } 	return clusters

Logs/Location.hs view

@@ -252,4 +252,4 @@ -- Cannot import Logs.Cluster due to a cycle. -- Annex.clusters gets populated when starting up git-annex. getClusters :: Annex Clusters-getClusters = fromMaybe noClusters <$> Annex.getState Annex.clusters+getClusters = maybe (pure noClusters) id =<< Annex.getState Annex.clusters

P2P/Http/Client.hs view

@@ -9,6 +9,7 @@  {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds, TypeApplications #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE CPP #-}  module P2P.Http.Client (@@ -99,7 +100,7 @@ 	versions = filter allowedversion allProtocolVersions 	go clientenv mcred credcached mauth (v:vs) = do 		myuuid <- getUUID-		res <- clientaction clientenv v+		res <- catchclienterror $ clientaction clientenv v 			(B64UUID (uuid rmt)) 			(B64UUID myuuid) 			[]@@ -125,6 +126,8 @@ 			Left clienterror -> Just <$> fallback 					("git-annex HTTP API server returned an unexpected response: " ++ show clienterror) 	go _ _ _ _ [] = return Nothing++	catchclienterror a = a `catch` \(ex :: ClientError) -> pure (Left ex)  	authrequired clientenv vs = do 		cred <- prompt $

P2P/Http/Url.hs view

@@ -11,8 +11,8 @@  import Data.List import Network.URI-import System.FilePath.Posix as P #ifdef WITH_SERVANT+import System.FilePath.Posix as P import Servant.Client (BaseUrl(..), Scheme(..)) import Text.Read #endif@@ -37,13 +37,14 @@ parseP2PHttpUrl us 	| isP2PHttpProtocolUrl us = case parseURI (drop prefixlen us) of 		Nothing -> Nothing-		Just u -> #ifdef WITH_SERVANT+		Just u -> 			case uriScheme u of 				"http:" -> mkbaseurl Http u 				"https:" -> mkbaseurl Https u 				_ -> Nothing #else+		Just _u -> 			Just $ P2PHttpUrl us #endif 	| otherwise = Nothing

Types/GitConfig.hs view

@@ -29,8 +29,6 @@ 	mkRemoteConfigKey, ) where -import Debug.Trace- import Common import qualified Git import qualified Git.Config@@ -495,12 +493,11 @@ 		, remoteAnnexClusterGateway = fromMaybe [] $ 			(mapMaybe (mkClusterUUID . toUUID) . words) 				<$> getmaybe ClusterGatewayField-		, remoteUrl = traceShow (mkRemoteConfigKey remotename (remoteGitConfigKey UrlField)) $-			case Git.Config.getMaybe (mkRemoteConfigKey remotename (remoteGitConfigKey UrlField)) r of-				Just (ConfigValue b)-					| B.null b -> Nothing-					| otherwise -> Just (decodeBS b)-				_ -> Nothing+		, remoteUrl = case Git.Config.getMaybe (mkRemoteConfigKey remotename (remoteGitConfigKey UrlField)) r of+			Just (ConfigValue b)+				| B.null b -> Nothing+				| otherwise -> Just (decodeBS b)+			_ -> Nothing 		, remoteAnnexP2PHttpUrl = 			case Git.Config.getMaybe (mkRemoteConfigKey remotename (remoteGitConfigKey AnnexUrlField)) r of 				Just (ConfigValue b) ->

git-annex.cabal view

@@ -1,5 +1,5 @@ Name: git-annex-Version: 10.20240731+Version: 10.20240808 Cabal-Version: 1.12 License: AGPL-3 Maintainer: Joey Hess <id@joeyh.name>