packages feed

git-annex 10.20260717 → 10.20260901

raw patch · 35 files changed

+527/−149 lines, 35 filesdep ~magicdep ~warp

Dependency ranges changed: magic, warp

Files

Annex/FileMatcher.hs view
@@ -67,7 +67,7 @@ checkFileMatcher' :: LiveUpdate -> GetFileMatcher -> OsPath -> Annex Bool -> Annex Bool checkFileMatcher' lu getmatcher file notconfigured = do 	matcher <- getmatcher file-	checkMatcher matcher Nothing afile lu S.empty notconfigured d+	checkMatcher matcher Nothing afile lu mempty notconfigured d   where 	afile = AssociatedFile (Just file) 	-- checkMatcher will never use this, because afile is provided.@@ -287,7 +287,7 @@  checkAddUnlockedMatcher :: LiveUpdate -> AddUnlockedMatcher -> MatchInfo -> Annex Bool checkAddUnlockedMatcher lu (AddUnlockedMatcher matcher) mi = -	checkMatcher' matcher mi lu S.empty+	checkMatcher' matcher mi lu mempty  simply :: MatchFiles Annex -> ParseResult (MatchFiles Annex) simply = Right . Operation@@ -342,7 +342,7 @@ 				(groupwanted mygroups) 			| otherwise = unknownmatcher 		mygroups = fromMaybe S.empty (u `M.lookup` groupsByUUID groupmap)-		groupwanted s = case M.elems $ M.filterWithKey (\k _ -> S.member k s) groupwantedmap of+		groupwanted s = case filter (not . null) $ M.elems $ M.filterWithKey (\k _ -> S.member k s) groupwantedmap of 			[pc] -> Just pc 			_ -> Nothing
Annex/Import.hs view
@@ -499,11 +499,11 @@ buildImportTreesHistory converttree basetree msubdir history hdl = S.fromList 	<$> mapM (\ic -> buildImportTreesGeneric' converttree basetree msubdir ic hdl) history -canImportKeys :: Remote -> Bool -> Bool+canImportKeys :: Remote -> Bool -> Annex Bool canImportKeys remote importcontent =-	importcontent || isJust (Remote.importKey ia)+	pure (importcontent) <||> (isJust <$> Remote.importKey ia)   where-	ia = Remote.exportImportActions remote+	ia = Remote.importActions remote  -- Result of an import.  data ImportResult t@@ -671,7 +671,7 @@ 	-> ImportableContentsChunkable Annex (ContentIdentifier, ByteSize) 	-> Annex (ImportResult (ImportableContentsChunkable Annex (Either Sha Key))) importKeys remote importtreeconfig importcontent thirdpartypopulated importablecontents = do-	unless (canImportKeys remote importcontent) $+	unlessM (canImportKeys remote importcontent) $ 		giveup "This remote does not support importing without downloading content." 	-- This map is used to remember content identifiers that 	-- were just imported, before they have necessarily been@@ -807,7 +807,7 @@ 			return (Right job) 	 	thirdpartypopulatedimport db (loc, (cid, sz)) = -		case Remote.importKey (Remote.exportImportActions remote) of+		Remote.importKey (Remote.importActions remote) >>= \case 			Nothing -> return Nothing 			Just importkey -> 				tryNonAsync (importkey loc cid sz nullMeterUpdate) >>= \case@@ -823,20 +823,21 @@ 	importordownload cidmap (loc, (cid, sz)) largematcher = do 		f <- locworktreefile loc 		matcher <- largematcher f+		let usedownload = dodownload cidmap (loc, (cid, sz)) f matcher+		let useimport = doimport cidmap (loc, (cid, sz)) f matcher 		-- When importing a key is supported, always use it rather 		-- than downloading and retrieving a key, to avoid 		-- generating trees with different keys for the same content.-		let act = if importcontent-			then case Remote.importKey (Remote.exportImportActions remote) of-				Nothing -> dodownload+		if importcontent+			then Remote.importKey (Remote.importActions remote) >>= \case+				Nothing -> usedownload 				Just _ -> if Utility.Matcher.introspect matchNeedsFileContent (fst matcher)-					then dodownload-					else doimport-			else doimport-		act cidmap (loc, (cid, sz)) f matcher+					then usedownload+					else useimport+			else useimport  	doimport cidmap (loc, (cid, sz)) f matcher =-		case Remote.importKey (Remote.exportImportActions remote) of+		Remote.importKey (Remote.importActions remote) >>= \case 			Nothing -> error "internal" -- checked earlier 			Just importkey -> do 				when (Utility.Matcher.introspect matchNeedsFileContent (fst matcher)) $
Annex/NumCopies.hs view
@@ -213,7 +213,7 @@ 	let nhave = numCopiesCount have 	explain (ActionItemTreeFile file) $ Just $ UnquotedString $ 		"has " ++ show nhave ++ " " ++ pluralCopies nhave ++ -		", and the configured annex.numcopies is " ++ show needed+		", and the configured annex.numcopies is " ++ show (fromNumCopies needed) 	return $ numCopiesCheck'' have vs needed  numCopiesCheck'' :: [UUID] -> (Int -> Int -> v) -> NumCopies -> v
Annex/Wanted.hs view
@@ -19,11 +19,11 @@  {- Check if a file is preferred content for the local repository. -} wantGet :: LiveUpdate -> Bool -> Maybe Key -> AssociatedFile -> Annex Bool-wantGet lu d key file = isPreferredContent lu Nothing S.empty key file d+wantGet lu d key file = isPreferredContent lu Nothing mempty key file d  {- Check if a file is preferred content for a repository. -} wantGetBy :: LiveUpdate -> Bool -> Maybe Key -> AssociatedFile -> UUID -> Annex Bool-wantGetBy lu d key file to = isPreferredContent lu (Just to) S.empty key file d+wantGetBy lu d key file to = isPreferredContent lu (Just to) mempty key file d  {- Check if a file is not preferred or required content, and can be  - dropped. When a UUID is provided, checks for that repository.@@ -46,8 +46,8 @@ checkDrop :: (LiveUpdate -> Maybe UUID -> AssumeNotPresent -> Maybe Key -> AssociatedFile -> Bool -> Annex Bool) -> LiveUpdate -> Bool -> Maybe UUID -> Maybe Key -> AssociatedFile -> (Maybe [AssociatedFile]) -> Annex (Maybe AssociatedFile) checkDrop checker lu d from key file others = do 	u <- maybe getUUID (pure . id) from-	let s = S.singleton u-	let checker' f = checker lu (Just u) s key f d+	let notpresent = AssumeNotPresent (S.singleton u)+	let checker' f = checker lu (Just u) notpresent key f d 	ifM (checker' file) 		( return (Just file) 		, do
CHANGELOG view
@@ -1,3 +1,42 @@+git-annex (10.20260901) upstream; urgency=medium++  * Behavior change: drop --auto --from a remote does not any longer +    try to drop content that is not known to be present on the remote.+    This avoids unncessary work and makes it consistent with the behavior+    of git-annex sync and push.+  * External special remote protocol extended to support IMPORTKEY.+  * git-annex-remote-internetarchive supports --no-content imports.+  * diffdriver: Avoid crashing when git passes an (undocumented) 8th+    parameter.+  * The preferred content groupwanted expression will no longer+    consider a groupwanted expression of "" to be set, which allows+    another group's groupwanted expression to be used instead.+  * Fixed buggy handling of preferred content+    "balanced=groupname:lackingcopies"+  * Expand preferred content "lackingcopies" and "approxlackingcopies"+    expression syntax to support "groupname:number"+  * Expand preferred content "copies", "lackingcopies", and+    "approxlackingcopies" expression syntax to support group limits which+    can include/exclude multiple groups. Eg+    "copies=archive+backup-offsite=3"+  * Also expanded --lackingcopies, --approxlackingcopies, and --copies+    with the same syntax.+  * Expand preferred content "balanced", "fullybalanced", +    "sizebalanced" and "fullysizebalanced" expression syntax to support+    group limits as well. Eg+    "balanced=backup:lackingcopies=archive-offsite"+  * importfeed: Fix reporting and logging of problems with feeds.+  * importfeed: When adding an url, indicate which feed it is from.+  * Fix reversion in 8.20200226 that broke git-annex benchmark --databases+  * Remove the ParallelBuild cabal flag and add cabal.project that+    enables parallel build by default with ghc 9.8+ and cabal-install 3.12.+  * NoLLMDependencies: Update for warp and magic.+  * git-annex.cabal: Pin magic to 1.1 avoiding build failure on Windows+    with newer version.+  * stack.yaml: Update to lts-24.52++ -- Joey Hess <id@joeyh.name>  Tue, 01 Sep 2026 11:25:45 -0400+ git-annex (10.20260717) upstream; urgency=medium    * External special remote protocol extended to support import.
Command/DiffDriver.hs view
@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2014-2023 Joey Hess <id@joeyh.name>+ - Copyright 2014-2026 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -88,6 +88,10 @@ 			, rNewHex = new_hex 			, rNewMode = new_mode 			}+	-- git documents 7 parameters, but there can be an additional parameter+	-- containing a similarity index description.+	mk (path:old_file:old_hex:old_mode:new_file:new_hex:new_mode:_:[]) =+		mk (path:old_file:old_hex:old_mode:new_file:new_hex:new_mode:[]) 	mk (unmergedpath:[]) = UnmergedReq { rPath = unmergedpath } 	mk _ = badopts
Command/Drop.hs view
@@ -90,7 +90,7 @@ 		stopUnless (wantdrop lu) $ 			case from of 				Nothing -> startLocal lu pcc afile ai si numcopies mincopies key [] ud-				Just remote -> startRemote lu pcc afile ai si numcopies mincopies key ud remote+				Just remote -> startRemote' (autoMode o) lu pcc afile ai si numcopies mincopies key ud remote   where 	remoteuuid = Remote.uuid <$> from 	wantdrop lu@@ -110,8 +110,11 @@ 		performLocal lu pcc key afile numcopies mincopies preverified ud  startRemote :: LiveUpdate -> PreferredContentChecked -> AssociatedFile -> ActionItem -> SeekInput -> NumCopies -> MinCopies -> Key -> DroppingUnused -> Remote -> CommandStart-startRemote lu pcc afile ai si numcopies mincopies key ud remote = do-	fast <- Annex.getRead Annex.fast+startRemote = startRemote' False++startRemote' :: Bool -> LiveUpdate -> PreferredContentChecked -> AssociatedFile -> ActionItem -> SeekInput -> NumCopies -> MinCopies -> Key -> DroppingUnused -> Remote -> CommandStart+startRemote' automode lu pcc afile ai si numcopies mincopies key ud remote = do+	fast <- if automode then pure True else Annex.getRead Annex.fast 	if fast 		then do 			remotes <- Remote.keyPossibilities (Remote.IncludeIgnored True) key
Command/Fsck.hs view
@@ -395,7 +395,7 @@ 	go requiredlocs = do 		presentlocs <- S.fromList <$> loggedLocations key 		missinglocs <- filterM-			(\u -> isRequiredContent NoLiveUpdate (Just u) S.empty (Just key) afile False)+			(\u -> isRequiredContent NoLiveUpdate (Just u) mempty (Just key) afile False) 			(S.toList $ S.difference requiredlocs presentlocs) 		if null missinglocs 			then return True
Command/ImportFeed.hs view
@@ -172,10 +172,13 @@ 	parse tmpf = liftIO (parseFeedFromFile' tmpf) >>= \case 		Nothing -> debugfeedcontent tmpf "parsing the feed failed" 		Just f -> do-			case decodeBS $ fromFeedText $ getFeedTitle f of-				"" -> noop-				t -> showNote (UnquotedString ('"' : t ++ "\""))-			case findDownloads url f of+			let feedtitle = '"' : decodeBS (fromFeedText $ getFeedTitle f) ++ "\""+			unless (null feedtitle) $+				showNote (UnquotedString feedtitle)+			let feeddesc = if null feedtitle+				then url+				else feedtitle+			case findDownloads url f feeddesc of 				[] -> debugfeedcontent tmpf "bad feed content; no enclosures to download" 				l -> do 					record (Just (Just l))@@ -202,6 +205,7 @@  data ToDownload = ToDownload 	{ feedurl :: URLString+	, feeddescription :: String 	, location :: DownloadLocation 	, itemid :: Maybe B.ByteString 	-- Either the parsed or unparsed date.@@ -240,8 +244,8 @@ 	ai = ActionItemOther (Just "gathering known urls") 	si = SeekInput [] -findDownloads :: URLString -> Feed -> [ToDownload]-findDownloads u f = catMaybes $ map mk (feedItems f)+findDownloads :: URLString -> Feed -> String -> [ToDownload]+findDownloads u f feeddesc = catMaybes $ map mk (feedItems f)   where 	mk i = case getItemEnclosure i of 		Just (enclosureurl, _, _) ->@@ -253,6 +257,7 @@ 			Nothing -> Nothing 	mk' i l = ToDownload 		{ feedurl = u+		, feeddescription = feeddesc 		, location = l 		, itemid = case getItemId i of 			Just (_, iid) -> Just (fromFeedText iid)@@ -412,7 +417,7 @@ 				| null ks -> do 					broken <- checkFeedBroken (feedurl todownload) 					when broken $-						void $ feedProblem url "download failed"+						void $ feedProblem (feedurl todownload) "download failed" 					liftIO $ atomically $ putTMVar cv broken 					next $ return False 				| otherwise -> do@@ -468,9 +473,11 @@ 		(go `onException` recordfailure)   where 	recordfailure = do-		void $ feedProblem url "download failed"+		void $ feedProblem (feedurl todownload) "download failed" 		liftIO $ atomically $ tryPutTMVar cv False 	go = do+		showNote $ UnquotedString $+			"from " ++ feeddescription todownload 		maybeAddJSONField "url" url 		a @@ -582,6 +589,7 @@ 		iurl <- youtube_url i 		return $ ToDownload 			{ feedurl = url+			, feeddescription = url 			, location = MediaLink iurl 			, itemid = Just (encodeBS iurl) 			, itempubdate =
Command/MatchExpression.hs view
@@ -14,7 +14,6 @@ import Logs.Group  import qualified Data.Map as M-import qualified Data.Set as S  cmd :: Command cmd = noCommit $@@ -90,7 +89,7 @@ 			, liftIO exitFailure 			)   where-	checkmatcher matcher = checkMatcher' matcher (matchinfo o) NoLiveUpdate S.empty+	checkmatcher matcher = checkMatcher' matcher (matchinfo o) NoLiveUpdate mempty  bail :: String -> IO a bail s = do
Command/Sync.hs view
@@ -627,8 +627,8 @@ 		Nothing -> noop 		Just b -> do 			let (branch, subdir) = splitRemoteAnnexTrackingBranchSubdir b-			if canImportKeys remote importcontent-				then do+			ifM (canImportKeys remote importcontent)+				( do 					addunlockedmatcher <- addUnlockedMatcher 					Command.Import.seekRemote remote branch subdir importcontent (CheckGitIgnore True) addunlockedmatcher [] 					-- Importing generates a branch@@ -638,7 +638,8 @@ 					-- mergeing it. 					mc <- mergeConfig True 					void $ mergeRemote remote currbranch mc o-				else warning $ UnquotedString $ "Cannot import from " ++ Remote.name remote ++ " when not syncing content."+				, warning $ UnquotedString $ "Cannot import from " ++ Remote.name remote ++ " when not syncing content."+				)   where 	wantpull = remoteAnnexPull (Remote.gitconfig remote) @@ -651,10 +652,12 @@ pullThirdPartyPopulated :: SyncOptions -> Remote -> CommandSeek pullThirdPartyPopulated o remote 	| not (pullOption o) || not wantpull = noop-	| not (canImportKeys remote False) = noop-	| otherwise = void $ includeCommandAction $ starting "list" ai si $-		Command.Import.listContents' remote ImportTree (CheckGitIgnore False) go+	| otherwise = +		whenM (canImportKeys remote False)+			start   where+	start = void $ includeCommandAction $ starting "list" ai si $+		Command.Import.listContents' remote ImportTree (CheckGitIgnore False) go 	go (Just importable) = importChanges remote ImportTree False True importable >>= \case 		ImportFinished postexportlogupdate imported -> do 			(_t, updatestate) <- recordImportTree remote ImportTree Nothing imported postexportlogupdate
Database/Benchmark.hs view
@@ -11,6 +11,7 @@ module Database.Benchmark (benchmarkDbs) where  import Annex.Common+import Annex.Tmp import Types.Benchmark #ifdef WITH_BENCHMARK import qualified Database.Keys.SQL as SQL@@ -30,18 +31,21 @@  benchmarkDbs :: CriterionMode -> Integer -> Annex () #ifdef WITH_BENCHMARK-benchmarkDbs mode n = withTmpDirIn (literalOsPath ".") (literalOsPath "benchmark") $ \tmpdir -> do-	db <- benchDb tmpdir n-	liftIO $ runMode mode-		[ bgroup "keys database"-			[ getAssociatedFilesHitBench db-			, getAssociatedFilesMissBench db-			, getAssociatedKeyHitBench db-			, getAssociatedKeyMissBench db-			, addAssociatedFileOldBench db-			, addAssociatedFileNewBench db+benchmarkDbs mode n = withOtherTmp $ \othertmpdir -> do+		withTmpDirIn othertmpdir (literalOsPath "benchmark") go+  where+	go tmpdir = do+		db <- benchDb tmpdir n+		liftIO $ runMode mode+			[ bgroup "keys database"+				[ getAssociatedFilesHitBench db+				, getAssociatedFilesMissBench db+				, getAssociatedKeyHitBench db+				, getAssociatedKeyMissBench db+				, addAssociatedFileOldBench db+				, addAssociatedFileNewBench db+				] 			]-		] #else benchmarkDbs _ = giveup "not built with criterion, cannot benchmark" #endif@@ -68,15 +72,17 @@  addAssociatedFileOldBench :: BenchDb -> Benchmark addAssociatedFileOldBench (BenchDb h num _) = bench ("addAssociatedFile to (old)") $ nfIO $ do-	n <- getStdRandom (randomR (1,num))-	SQL.addAssociatedFile (keyN n) (fileN n) (SQL.WriteHandle h)+	forM_ [1..num] $ \_ -> do+		n <- getStdRandom (randomR (1,num))+		SQL.addAssociatedFile (keyN n) (fileN n) (SQL.WriteHandle h) 	H.flushDbQueue h  addAssociatedFileNewBench :: BenchDb -> Benchmark addAssociatedFileNewBench (BenchDb h num mv) = bench ("addAssociatedFile to (new)") $ nfIO $ do 	n <- takeMVar mv-	putMVar mv (n+1)-	SQL.addAssociatedFile (keyN n) (fileN (num+n)) (SQL.WriteHandle h)+	putMVar mv (n+num)+	forM_ [n..n+num] $ \n' ->+		SQL.addAssociatedFile (keyN n) (fileN (num+n')) (SQL.WriteHandle h) 	H.flushDbQueue h  populateAssociatedFiles :: H.DbQueue -> Integer -> IO ()
+ Git/Config/Url.hs view
@@ -0,0 +1,167 @@+{- git-config http.<url>.* handling+ -+ - Copyright 2026 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++{-# LANGUAGE OverloadedStrings #-}++module Git.Config.Url (+	getHttpConfig,+	httpConfigKeys,+	prop_httpConfigKeys_sane,+) where++import qualified Data.Map as M+import Network.URI+import Data.Function++import Common+import Git+import Git.Types+import Utility.Glob++{- Gets any per-url settings from the git config for a http.foo ConfigKey.+ -+ - If there are non, falls back to the non-url-spcecific config, if any,+ - or the provided fallback value.+ -+ - See git-config(1)'s documentation of http.<url>.* for the details.+ -}+getHttpConfig :: ConfigKey -> ConfigValue -> URI -> Repo -> ConfigValue+getHttpConfig key fallback url repo = fromMaybe fallback $+	case httpConfigKeys key url (config repo) of+		[] -> Nothing+		(k:_) -> M.lookup k (config repo)++{- Gets any per-url config keys for a non-url-specific input+ - http.foo ConfigKey that match the provided url.+ -+ - The list is ordered by decreasing precedance and includes the input+ - ConfigKey at the end when it's part of the RepoConfig.+ -}+httpConfigKeys :: ConfigKey -> URI -> RepoConfig -> [ConfigKey]+httpConfigKeys nonurlspecifickey@(ConfigKey key) urltomatch c =+	let l = map fst +		$ reverse $ sortBy precedence +		$ mapMaybe matching (M.keys c)+	in if M.member nonurlspecifickey c+		then l ++ [nonurlspecifickey]+		else l+  where+	httpprefix = "http."+	keysuffix = case decodeBS key of+		('h':'t':'t':'p':'.':rest) -> '.' : rest+		v -> v+	httpprefixlen = length httpprefix+	keysuffixlen = length keysuffix++	extracturlfromkey = parseURI +		. reverse . drop keysuffixlen . reverse +		. drop httpprefixlen++	precedence (_k1, u1) (_k2, u2) =+		(compare `on` (length . uriPath)) u1 u2+			<> (compare `on` (uriUserInfo <$$> uriAuthority)) u1 u2+	+	matching k@(ConfigKey ck) = +		let sk = decodeBS ck+		in if httpprefix `isPrefixOf` sk && keysuffix `isSuffixOf` sk && k /= nonurlspecifickey+			then do+				u <- extracturlfromkey sk+				let same f = f u == f urltomatch+				if same uriScheme+					&& (same (uriRegName <$$> uriAuthority)+						|| subdomainwildcardmatch u)+					&& same getportordefault+					&& (same uriPath+						|| pathslashprefix u)+					&& (same getusername+						|| getusername u == Nothing)+					then Just (k, u)+					else Nothing+			else Nothing+	+	getportordefault u = do+		a <- uriAuthority u+		if null (uriPort a)+			then case uriScheme u of+				"http:" -> return ":80"+				"https:" -> return ":443"+				_ -> Nothing+			else return (uriPort a)++	getusername u = do+		a <- uriAuthority u+		let (user, _pass) = break (== ':') (uriUserInfo a)+		let username = fst (break (== '@') user)+		if null username+			then Nothing+			else return username++	pathslashprefix u = +		let p = if "/" `isSuffixOf` uriPath u+			then uriPath u+			else uriPath u ++ "/"+		in p `isPrefixOf` uriPath urltomatch++	subdomainwildcardmatch u =+		subdomainwildcardmatch' (uridomains u) (uridomains urltomatch)+	+	subdomainwildcardmatch' [] [] = True+	subdomainwildcardmatch' [] _ = False+	subdomainwildcardmatch' _ [] = False+	subdomainwildcardmatch' (a:as) (b:bs)+		| a == b = subdomainwildcardmatch' as bs+		| otherwise =+			let g = compileGlob a CaseInsensitive (GlobFilePath False)+			in if matchGlob g b+				then subdomainwildcardmatch' as bs+				else False++	uridomains u = case uriRegName <$> uriAuthority u of+		Nothing -> []+		Just d -> splitc '.' d++prop_httpConfigKeys_sane :: Bool+prop_httpConfigKeys_sane = and prop_httpConfigKeys_tests++prop_httpConfigKeys_tests :: [Bool]+prop_httpConfigKeys_tests =+	[ httpConfigKeys (ConfigKey "http.foo") u c ==+		[ "http.http://user@example.com/foo/bar.foo"+		, "http.http://example.com/foo/bar.foo"+		, "http.http://example.com/foo.foo"+		, "http.http://example.com.foo"+		, "http.foo"+		]+	, httpConfigKeys (ConfigKey "http.bar") u c ==+		[ "http.http://*.com.bar" ]+	, httpConfigKeys (ConfigKey "http.baz") u c ==+		[ "http.http://example.com:80.baz" ]+	, httpConfigKeys (ConfigKey "http.baz") uwithport c ==+		[ "http.http://example.com:8080.baz" ]+	]+  where+	u = fromMaybe (error "internal") $ +		parseURI "http://user:password@example.com/foo/bar/"+	uwithport = fromMaybe (error "internal") $ +		parseURI "http://user:password@example.com:8080/foo/bar/"+	c = M.fromList $ map (\k -> (ConfigKey k, ConfigValue "dummy value"))+		[ "http.foo"+		, "http.http://example.co.foo"+		, "http.http://example.com.foo"+		, "https.http://example.com.foo"+		, "http.http://example.com/fo.foo"+		, "http.http://example.com/foo.foo"+		, "http.http://example.com/foo/ba.foo"+		, "http.http://example.com/foo/bar.foo"+		, "http.http://user@example.com/foo/bar.foo"+		, "http.http://nonmatchingexample.com.foo"+		, "http.http://*.bar"+		, "http.http://*.com.bar"+		, "http.http://example.com:80.baz"+		, "http.http://example.com:443.baz"+		, "http.http://example.com:8080.baz"+		]
Git/Credential.hs view
@@ -19,7 +19,6 @@  import qualified Data.Map as M import Network.URI-import Network.HTTP.Types import Network.HTTP.Types.Header import Control.Concurrent.STM
Limit.hs view
@@ -1,6 +1,6 @@ {- user-specified limits on files to act on  -- - 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.  -}@@ -67,7 +67,7 @@ 	run matcher i = do 		(match, desc) <- runWriterT $ 			Utility.Matcher.matchMrun' matcher $ \o ->-				matchAction o NoLiveUpdate S.empty i+				matchAction o NoLiveUpdate mempty i 		explain (mkActionItem i) $ UnquotedString <$> 			Utility.Matcher.describeMatchResult 				(\o -> matchDesc o . Just) desc@@ -333,14 +333,14 @@ 		, matchNegationUnstable = False 		, matchDesc = "in" =? s 		}-	checkinuuid u notpresent key+	checkinuuid u (AssumeNotPresent notpresent) key 		| null date = do 			us <- Remote.keyLocations key 			return $ u `elem` us && u `S.notMember` notpresent 		| otherwise = do 			us <- loggedLocationsHistorical (RefDate date) key 			return $ u `elem` us-	checkinhere notpresent key+	checkinhere (AssumeNotPresent notpresent) key 		| S.null notpresent = inAnnex key 		| otherwise = do 			u <- getUUID@@ -415,8 +415,10 @@ 	[v, n] -> case parsetrustspec v of 		Just checker -> go n $ checktrust checker 		Nothing -> go n $ checkgroup (toGroup v)-	[n] -> go n $ const $ return True-	_ -> Left "bad value for copies"+	_ -> case splitc '=' want of+		[gl, n] -> go n $ checkgrouplimit (parseGroupLimit gl)+		[n] -> go n $ const $ return True+		_ -> Left "bad value for copies"   where 	go num good = case readish num of 		Nothing -> Left "bad number for copies"@@ -431,12 +433,15 @@ 			, matchNegationUnstable = False 			, matchDesc = "copies" =? want 			}-	go' n good notpresent key = do+	go' n good (AssumeNotPresent notpresent) key = do 		us <- filter (`S.notMember` notpresent) 			<$> (filterM good =<< Remote.keyLocations key) 		return $ numCopiesCount us >= n 	checktrust checker u = checker <$> lookupTrust u 	checkgroup g u = S.member g <$> lookupGroups u+	checkgrouplimit gl u = do+		m <- uuidsByGroup <$> groupMap+		return (checkGroupLimit gl m u) 	parsetrustspec s 		| "+" `isSuffixOf` s = (<=) <$> readTrustLevel (beginning s) 		| otherwise = (==) <$> readTrustLevel s@@ -446,7 +451,7 @@ addLackingCopies desc approx = addLimit . limitLackingCopies desc approx  limitLackingCopies :: String -> Bool -> MkLimit Annex-limitLackingCopies desc approx want = case readish want of+limitLackingCopies desc approx want = case readish numwant of 	Just needed -> Right $ MatchFiles 		{ matchAction = const $ \notpresent mi -> flip checkKey mi $ 			go mi needed notpresent@@ -460,13 +465,25 @@ 		} 	Nothing -> Left "bad value for number of lacking copies"   where-	go mi needed notpresent key =-		limitCheckNumCopies approx mi notpresent key vs+	go mi needed notpresent key = case (groupwant, grouplimit) of+		(Nothing, []) -> check (const True)+		(Just g, _) -> do+			s <- groupUUIDs g <$> groupMap+			check (`S.member` s)+		(Nothing, gl) -> do+			m <- uuidsByGroup <$> groupMap+			check (checkGroupLimit gl m) 	  where+		check uuidp = limitCheckNumCopies approx mi notpresent uuidp key vs 		vs nhave numcopies' = numcopies' - nhave >= needed+	(groupwant, grouplimit, numwant) = case splitc ':' want of+		(g:n:[]) -> (Just (toGroup g), [], n)+		_ -> case splitc '=' want of+			(gl:n:[]) -> (Nothing, parseGroupLimit gl, n)+			_ -> (Nothing, [], want) -limitCheckNumCopies :: Bool -> MatchInfo -> AssumeNotPresent -> Key -> (Int -> Int -> v) -> Annex v-limitCheckNumCopies approx mi notpresent key vs = do+limitCheckNumCopies :: Bool -> MatchInfo -> AssumeNotPresent -> (UUID -> Bool) -> Key -> (Int -> Int -> v) -> Annex v+limitCheckNumCopies approx mi (AssumeNotPresent notpresent) uuidp key vs = do 	numcopies <- if approx 		then approxNumCopies 		else case mi of@@ -474,7 +491,7 @@ 				matchFile fi 			MatchingInfo {} -> approxNumCopies 			MatchingUserInfo {} -> approxNumCopies-	us <- filter (`S.notMember` notpresent)+	us <- filter (\u -> uuidp u && u `S.notMember` notpresent) 		<$> (trustExclude UnTrusted =<< Remote.keyLocations key) 	return $ numCopiesCheck'' us vs numcopies   where@@ -547,9 +564,8 @@  limitInAllGroup :: Annex GroupMap -> MkLimit Annex limitInAllGroup getgroupmap groupname = Right $ MatchFiles-	{ matchAction = const $ \notpresent mi -> do-		m <- getgroupmap-		let want = fromMaybe S.empty $ M.lookup (toGroup groupname) $ uuidsByGroup m+	{ matchAction = const $ \(AssumeNotPresent notpresent) mi -> do+		want <- groupUUIDs (toGroup groupname) <$> getgroupmap 		if S.null want 			then return True 			-- optimisation: Check if a wanted uuid is notpresent.@@ -579,7 +595,7 @@ limitOnlyInGroup getgroupmap groupname = Right $ MatchFiles 	{ matchAction = const $ \notpresent mi -> do 		m <- getgroupmap-		let want = fromMaybe S.empty $ M.lookup (toGroup groupname) $ uuidsByGroup m+		let want = groupUUIDs (toGroup groupname) m 		if S.null want 			then return False 			else checkKey (check notpresent want) mi@@ -592,7 +608,7 @@ 	, matchDesc = "onlyingroup" =? groupname 	}   where-	check notpresent want key = do+	check (AssumeNotPresent notpresent) want key = do 		locs <- S.fromList <$> Remote.keyLocations key 		let present = locs `S.difference` notpresent 		return $ not (S.null $ present `S.intersection` want)@@ -604,34 +620,47 @@ 	limitBalanced' "balanced" fullybalanced mu groupname   limitBalanced' :: String -> MatchFiles Annex -> Maybe UUID -> MkLimit Annex-limitBalanced' termname fullybalanced mu groupname = do-	let checknumcopies = ":lackingcopies" `isSuffixOf` groupname-	enoughcopies <- if checknumcopies-		then limitLackingCopies termname False "1"-		else limitCopies $ if ':' `elem` groupname-			then groupname-			else groupname ++ ":1"-	let checkenoughcopies = if checknumcopies then id else not+limitBalanced' termname fullybalanced mu want = do+	limitcopies <- if checklackingcopies+		then limitLackingCopies termname False wantlackingcopies+		else limitCopies $ if ':' `elem` want+			then want+			else want ++ ":1" 	let present = limitPresent mu-	let combo f = f present || f fullybalanced || f enoughcopies-	Right $ MatchFiles-		{ matchAction = \lu a i ->-			ifM (Annex.getRead Annex.rebalance)-				( matchAction fullybalanced lu a i-				, matchAction present lu a i <||>-					((checkenoughcopies <$> matchAction enoughcopies lu a i)-						<&&> matchAction fullybalanced lu a i+	let combo f = f present || f fullybalanced || f limitcopies+	let matchaction lu a i =+		let match f = matchAction f lu a i+		in ifM (Annex.getRead Annex.rebalance)+			( match fullybalanced+			, if checklackingcopies+				then match present <||>+					(match limitcopies+						<&&> match fullybalanced 					)-				)+				else match present <||>+					((not <$> match limitcopies)+						<&&> match fullybalanced+					)+			)+	Right $ MatchFiles+		{ matchAction = matchaction 		, matchNeedsFileName = combo matchNeedsFileName 		, matchNeedsFileContent = combo matchNeedsFileContent 		, matchNeedsKey = combo matchNeedsKey 		, matchNeedsLocationLog = combo matchNeedsLocationLog 		, matchNeedsLiveRepoSize = True 		, matchNegationUnstable = combo matchNegationUnstable-		, matchDesc = termname =? groupname+		, matchDesc = termname =? want 		}-+  where+	(checklackingcopies, wantlackingcopies) = +		case splitc ':' want of+			[g, want']+				| want' == "lackingcopies" -> (True, "1")+				| "lackingcopies="` isPrefixOf` want' ->+					let (_, sgrouplimit) = break (== '=') want'+					in (True, drop 1 sgrouplimit ++ "+" ++ g ++ "=1")+			_ -> (False, "")  limitFullyBalanced :: Maybe UUID -> Annex GroupMap -> MkLimit Annex limitFullyBalanced = limitFullyBalanced' "fullybalanced"@@ -682,9 +711,19 @@ 		[g] -> go g (Right 1) 		[g, n] 			| n == "lackingcopies" -> go g $ -				Left $ \mi notpresent key -> -					let vs nhave numcopies = numcopies - nhave-					in limitCheckNumCopies False mi notpresent key vs+				Left $ \mi notpresent key -> do+					s <- getgids g <$> groupMap+					let others = flip S.notMember s+					calcnumcopiesneeded mi notpresent key others+			| "lackingcopies="` isPrefixOf` n -> go g $+				Left $ \mi notpresent key -> do+					m <- groupMap+					let s = getgids g m+					let (_, sgrouplimit) = break (== '=') n+					let gl = parseGroupLimit (drop 1 sgrouplimit)+					let others = \u -> u `S.notMember` s+						&& checkGroupLimit gl (uuidsByGroup m) u+					calcnumcopiesneeded mi notpresent key others 			| otherwise -> maybe 				(Left $ "bad number for " ++ termname) 				(go g . Right)@@ -693,7 +732,12 @@   where 	go s n = limitFullyBalanced''' filtercandidates termname mu 		getgroupmap (toGroup s) n want+	getgids = groupUUIDs . toGroup +	calcnumcopiesneeded mi notpresent key others =+		let calc nothers numcopies = numcopies - nothers+		in limitCheckNumCopies False mi notpresent others key calc+ limitFullyBalanced''' 	:: (Int -> Key -> S.Set UUID -> Annex (S.Set UUID)) 	-> String@@ -705,8 +749,7 @@ limitFullyBalanced''' filtercandidates termname mu getgroupmap g getn want = Right $ MatchFiles 	{ matchAction = \lu notpresent mi -> flip checkKey mi $ \key -> do 		gm <- getgroupmap-		let groupmembers = fromMaybe S.empty $-			M.lookup g (uuidsByGroup gm)+		let groupmembers = groupUUIDs g gm 		n <- case getn of 			Right n -> pure n 			Left a -> a mi notpresent key@@ -964,3 +1007,30 @@  (=?) :: String -> String -> (Maybe Bool -> Utility.Matcher.MatchDesc) k =? v = matchDescSimple (k ++ "=" ++ v)++data GroupLimit+	= GroupInclude Group+	| GroupExclude Group+	deriving (Show)++parseGroupLimit :: String -> [GroupLimit]+parseGroupLimit = go GroupInclude+  where+	go b s = case break (\c -> c == '+' || c == '-') s of+		("", "") -> []+		("", ('+':s')) -> go GroupInclude s'+		("", ('-':s')) -> go GroupExclude s'+		(groupname, s') -> b (toGroup groupname) : go GroupInclude s'++checkGroupLimit :: Ord t => [GroupLimit] -> M.Map Group (S.Set t) -> t -> Bool+checkGroupLimit gl m u = +	let (includes, excludes) = partition fst (map decompose gl)+	in (any member includes || null includes) && not (any member excludes)+  where+	decompose (GroupInclude g) = (True, g)+	decompose (GroupExclude g) = (False, g)++	member (_, g) = +		case M.lookup g m of+			Nothing -> False+			Just s -> u `S.member` s
Remote/Adb.hs view
@@ -101,7 +101,7 @@ 		, importActions = importUnsupported 		, exportImportActions = ExportImportActions 			{ listImportableOrExportedContents = listImportableOrExportedContentsM serial adir c-			, importKey = Nothing+			, importKeyWithContentIdentifier = pure Nothing 			, retrieveExportWithContentIdentifier = retrieveExportWithContentIdentifierM serial adir 			, storeExportWithContentIdentifier = storeExportWithContentIdentifierM serial adir 			, removeExportWithContentIdentifier = removeExportWithContentIdentifierM serial adir
Remote/Borg.hs view
@@ -98,7 +98,8 @@ 		, importActions = importUnsupported 		, exportImportActions = ExportImportActions 			{ listImportableOrExportedContents = listImportableOrExportedContentsM u borgrepo c-			, importKey = Just ThirdPartyPopulated.importKey+			, importKeyWithContentIdentifier = pure $ +				Just ThirdPartyPopulated.importKey 			, retrieveExportWithContentIdentifier = retrieveExportWithContentIdentifierM borgrepo 			, checkPresentExportWithContentIdentifier = checkPresentExportWithContentIdentifierM borgrepo 			-- This remote is thirdPartyPopulated, so these
Remote/Directory.hs view
@@ -119,7 +119,8 @@ 			, importActions = importUnsupported 			, exportImportActions = ExportImportActions 				{ listImportableOrExportedContents = listImportableOrExportedContentsM ii dir-				, importKey = Just (importKeyM ii dir)+				, importKeyWithContentIdentifier = pure $ +					Just (importKeyWithContentIdentifierM ii dir) 				, retrieveExportWithContentIdentifier = retrieveExportWithContentIdentifierM ii dir cow 				, storeExportWithContentIdentifier = storeExportWithContentIdentifierM ii dir cow fastcopy 				, removeExportWithContentIdentifier = removeExportWithContentIdentifierM ii dir@@ -432,8 +433,8 @@ 				let ic' = replaceInode 0 ic 				in ContentIdentifier (encodeBS (showInodeCache ic')) -importKeyM :: IgnoreInodes -> OsPath -> ExportLocation -> ContentIdentifier -> ByteSize -> MeterUpdate -> Annex (Maybe Key)-importKeyM ii dir loc cid _sz p = do+importKeyWithContentIdentifierM :: IgnoreInodes -> OsPath -> ExportLocation -> ContentIdentifier -> ByteSize -> MeterUpdate -> Annex (Maybe Key)+importKeyWithContentIdentifierM ii dir loc cid _sz p = do 	backend <- chooseBackend f 	k <- fst <$> genKey ks p backend 	currcid <- liftIO $ mkContentIdentifier ii absf
Remote/External.hs view
@@ -129,6 +129,7 @@ 		let importactions = if importsupported 			then ImportActions 				{ listImportableContents = listImportableContentsM external+				, importKey = importKeyM external 				, retrieveImport = retrieveImportM external gc 				, checkPresentImport = checkPresentImportM external gc 				}@@ -612,6 +613,32 @@ 	go _ _ UNSUPPORTED_REQUEST = result Nothing 	go _ _ _ = Nothing +importKeyM+	:: External+	-> Annex (Maybe (ImportLocation -> ContentIdentifier -> ByteSize -> MeterUpdate -> Annex (Maybe Key)))+importKeyM external = +	withExternalState external $ \st ->+		return $ if importKeyExtensionEnabled (externalExtensions st)+			then Just go+			else Nothing+  where+	go loc cid sz p =+		handleRequestImport' external loc (IMPORTKEY sz cid) Nothing $ \case+			IMPORTKEY_SUCCESS k ->+				result (Just k)+			IMPORTKEY_FAILURE err ->+				giveup err+			IMPORTKEY_SKIP ->+				result Nothing+			DELEGATE ps -> Just $ do+				delegate <- getDelegateRemote external ps+				importKey (importActions delegate) >>= \case+					Just a -> Result <$> a loc cid sz p+					Nothing -> giveup "IMPORTKEY delegated to a special remote that does not support it"+			UNSUPPORTED_REQUEST ->+				giveup "IMPORTKEY not implemented by external special remote, but it claimed to support it"+			_ -> Nothing+ {- Sends a Request to the external remote, and waits for it to generate  - a Response. That is fed into the responsehandler, which should return  - the action to run for it (or Nothing if there's a protocol error).@@ -990,25 +1017,25 @@ 	liftIO (atomically $ takeTMVar (externalAsync external)) >>= \case 		UncheckedExternalAsync -> do 			(st, extensions) <- startExternal' external-				`onException` store UncheckedExternalAsync+				`onException` storeasync UncheckedExternalAsync 			if asyncExtensionEnabled extensions 				then do 					annexrunner <- Annex.makeRunner 					relay <- liftIO $ runRelayToExternalAsync external st annexrunner 					st' <- liftIO $ asyncRelayExternalState relay-					store (ExternalAsync relay)+					storeasync (ExternalAsync relay) 					return st' 				else do-					store NoExternalAsync+					storeasync NoExternalAsync 					return st 		v@NoExternalAsync -> do-			store v+			storeasync v 			fst <$> startExternal' external 		v@(ExternalAsync relay) -> do-			store v+			storeasync v 			liftIO $ asyncRelayExternalState relay   where-	store = liftIO . atomically . putTMVar (externalAsync external)+	storeasync = liftIO . atomically . putTMVar (externalAsync external)  startExternal' :: External -> Annex (ExternalState, ExtensionList) startExternal' external = do@@ -1040,9 +1067,10 @@ 				, externalPrepared = pv 				, externalConfig = cv 				, externalConfigChanges = ccv+				, externalExtensions = ExtensionList [] 				} 			extensions <- startproto st-			return (st, extensions)+			return (st { externalExtensions = extensions }, extensions)   where 	(externalcmd, externalparams) = case externalProgram external of 		ExternalType t -> ("git-annex-remote-" ++ t, [])
Remote/External/AsyncExtension.hs view
@@ -53,6 +53,7 @@ 			, externalPrepared = externalPrepared st 			, externalConfig = externalConfig st 			, externalConfigChanges = externalConfigChanges st+			, externalExtensions = externalExtensions st 			}  type ReceiveQueue = TBMChan String
Remote/External/Types.hs view
@@ -18,6 +18,7 @@ 	ExtensionList(..), 	supportedExtensionList, 	asyncExtensionEnabled,+	importKeyExtensionEnabled, 	ExternalAsync(..), 	ExternalAsyncRelay(..), 	Proto.parseMessage,@@ -109,6 +110,7 @@ 	, externalPrepared :: TMVar PrepareStatus 	, externalConfig :: TMVar ParsedRemoteConfig 	, externalConfigChanges :: TMVar (RemoteConfig -> RemoteConfig)+	, externalExtensions :: ExtensionList 	}  type PID = Int@@ -124,6 +126,7 @@ 	, "UNAVAILABLERESPONSE" 	, "TRANSFER-RETRIEVE-URL" 	, "CHECKPRESENT-URL"+	, importKeyExtension 	, "DELEGATE" 	, asyncExtension 	]@@ -134,6 +137,12 @@ asyncExtensionEnabled :: ExtensionList -> Bool asyncExtensionEnabled l = asyncExtension `elem` fromExtensionList l +importKeyExtension :: String+importKeyExtension = "IMPORTKEY"++importKeyExtensionEnabled :: ExtensionList -> Bool+importKeyExtensionEnabled l = importKeyExtension `elem` fromExtensionList l+ -- When the async extension is in use, a single external process -- is started and used for all requests. data ExternalAsync@@ -198,6 +207,7 @@ 	| IMPORT ImportLocation 	| RETRIEVEIMPORT FilePath 	| CHECKPRESENTIMPORT SafeKey+	| IMPORTKEY Size ContentIdentifier 	deriving (Show)  -- Does PREPARE need to have been sent before this request?@@ -269,6 +279,11 @@ 		[ "CHECKPRESENTIMPORT" 		, Proto.serialize key 		]+	formatMessage (IMPORTKEY size cid) = Proto.mkMessage+		[ "IMPORTKEY"+		, Proto.serialize size+		, Proto.serialize cid+		]  -- Responses the external remote can make to requests. data Response@@ -318,6 +333,9 @@ 	| RETRIEVEIMPORT_SUCCESS 	| RETRIEVEIMPORT_FAILURE ErrorMsg 	| RETRIEVEIMPORT_URL URLString+	| IMPORTKEY_SUCCESS Key+	| IMPORTKEY_FAILURE ErrorMsg+	| IMPORTKEY_SKIP 	| DELEGATE [String] 	| UNSUPPORTED_REQUEST 	deriving (Show)@@ -369,6 +387,9 @@ 	parseCommand "RETRIEVEIMPORT-SUCCESS" = Proto.parse0 RETRIEVEIMPORT_SUCCESS 	parseCommand "RETRIEVEIMPORT-FAILURE" = Proto.parse1 RETRIEVEIMPORT_FAILURE 	parseCommand "RETRIEVEIMPORT-URL" = Proto.parse1 RETRIEVEIMPORT_URL+	parseCommand "IMPORTKEY-SUCCESS" = Proto.parse1 IMPORTKEY_SUCCESS+	parseCommand "IMPORTKEY-FAILURE" = Proto.parse1 IMPORTKEY_FAILURE+	parseCommand "IMPORTKEY-SKIP" = Proto.parse0 IMPORTKEY_SKIP 	parseCommand "DELEGATE" = Proto.parseList DELEGATE 	parseCommand "UNSUPPORTED-REQUEST" = Proto.parse0 UNSUPPORTED_REQUEST 	parseCommand _ = Proto.parseFail
Remote/Helper/ExportImport.hs view
@@ -58,6 +58,7 @@ instance HasImportUnsupported (ImportActions Annex) where 	importUnsupported = ImportActions 		{ listImportableContents = nope+		, importKey = nope 		, retrieveImport = nope 		, checkPresentImport = \_ _ -> return False 		}@@ -74,7 +75,7 @@ instance HasExportImportUnsupported (ExportImportActions Annex) where 	exportImportUnsupported = ExportImportActions 		{ listImportableOrExportedContents = nope-		, importKey = Nothing+		, importKeyWithContentIdentifier = pure Nothing 		, retrieveExportWithContentIdentifier = nope 		, storeExportWithContentIdentifier = nope 		, removeExportWithContentIdentifier = nope@@ -332,6 +333,7 @@ 	-- more strongly. 	importActionsForExportImport ciddbv = ImportActions 		{ listImportableContents = listImportableOrExportedContents (exportImportActions r)+		, importKey = importKeyWithContentIdentifier (exportImportActions r) 		, retrieveImport = retrieveExportWithContentIdentifier (exportImportActions r) 		, checkPresentImport = checkPresentExportImport ciddbv 		}
Remote/Rsync.hs view
@@ -114,6 +114,7 @@ 				} 			, importActions = ImportActions 				{ listImportableContents = listImportableContentsM o+				, importKey = pure Nothing 				, retrieveImport = retrieveImportM o 				, checkPresentImport = checkPresentImportExportM o 				}
Remote/S3.hs view
@@ -244,7 +244,7 @@ 			, importActions = importUnsupported 			, exportImportActions = ExportImportActions                                 { listImportableOrExportedContents = listImportableOrExportedContentsS3 hdl this info c-				, importKey = Nothing+				, importKeyWithContentIdentifier = pure Nothing                                 , retrieveExportWithContentIdentifier = retrieveExportWithContentIdentifierS3 hdl this rs info                                 , storeExportWithContentIdentifier = storeExportWithContentIdentifierS3 hdl this rs info magic                                 , removeExportWithContentIdentifier = removeExportWithContentIdentifierS3 hdl this rs info
Remote/WebDAV.hs view
@@ -417,12 +417,12 @@  data DavHandle = DavHandle DAVContext DavUser DavPass URLString -type DavHandleVar = TVar (Either (Annex (Either String DavHandle)) (Either String DavHandle))+type DavHandleVar = TMVar (Either (Annex (Either String DavHandle)) (Either String DavHandle))  {- Prepares a DavHandle for later use. Does not connect to the server or do  - anything else expensive. -} mkDavHandleVar :: ParsedRemoteConfig -> RemoteGitConfig -> UUID -> Annex DavHandleVar-mkDavHandleVar c gc u = liftIO $ newTVarIO $ Left $ do+mkDavHandleVar c gc u = liftIO $ newTMVarIO $ Left $ do 	mcreds <- getCreds c gc u 	case (mcreds, configUrl c) of 		(Just (user, pass), Just baseurl) -> do@@ -431,12 +431,16 @@ 			return (Right h) 		_ -> return $ Left "webdav credentials not available" +{- Concurrent actions are allowed to run at the same time with the same+ - DavHandle, so any use of eg setDepth will affect other actions. -} withDavHandle :: DavHandleVar -> (DavHandle -> Annex a) -> Annex a-withDavHandle hv a = liftIO (readTVarIO hv) >>= \case-	Right hdl -> either giveup a hdl+withDavHandle hv a = liftIO (atomically (takeTMVar hv)) >>= \case+	Right hdl -> do+		liftIO $ atomically $ putTMVar hv (Right hdl)+		either giveup a hdl 	Left mkhdl -> do 		hdl <- mkhdl-		liftIO $ atomically $ writeTVar hv (Right hdl)+		liftIO $ atomically $ putTMVar hv (Right hdl) 		either giveup a hdl  goDAV :: DavHandle -> DAVT IO a -> IO a
Test.hs view
@@ -38,6 +38,7 @@ import qualified Git.Ref import qualified Git.LsTree import qualified Git.FilePath+import qualified Git.Config.Url #ifndef mingw32_HOST_OS import qualified Annex.Locations import qualified Git.Bundle@@ -196,6 +197,7 @@ 	, testProperty "prop_viewedFile_rountrips" Annex.View.ViewedFile.prop_viewedFile_roundtrips 	, testProperty "prop_standardGroups_parse" Logs.PreferredContent.prop_standardGroups_parse 	, testProperty "prop_balanced_stable" Annex.Balanced.prop_balanced_stable+	, testProperty "prop_httpConfigKeys_sane" Git.Config.Url.prop_httpConfigKeys_sane 	] ++ map (uncurry testProperty) combos   where 	combos = concat
Types/FileMatcher.hs view
@@ -1,10 +1,12 @@ {- git-annex file matcher types  -- - Copyright 2013-2023 Joey Hess <id@joeyh.name>+ - Copyright 2013-2026 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE GeneralizedNewtypeDeriving #-}+ module Types.FileMatcher where  import Types.UUID (UUID)@@ -83,7 +85,8 @@  type MkLimit a = String -> Either String (MatchFiles a) -type AssumeNotPresent = S.Set UUID+newtype AssumeNotPresent = AssumeNotPresent (S.Set UUID)+	deriving (Semigroup, Monoid)  data MatchFiles a = MatchFiles  	{ matchAction :: LiveUpdate -> AssumeNotPresent -> MatchInfo -> a Bool
Types/Group.hs view
@@ -1,6 +1,6 @@ {- git-annex repo groups  -- - Copyright 2012-2024 Joey Hess <id@joeyh.name>+ - Copyright 2012-2026 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -10,7 +10,8 @@ 	fromGroup, 	toGroup, 	GroupMap(..),-	emptyGroupMap+	emptyGroupMap,+	groupUUIDs ) where  import Types.UUID@@ -19,9 +20,10 @@  import qualified Data.Map as M import qualified Data.Set as S-import qualified Data.ByteString as S+import qualified Data.ByteString as BS+import Data.Maybe -newtype Group = Group S.ByteString+newtype Group = Group BS.ByteString 	deriving (Eq, Ord, Show, Read)  fromGroup :: Group -> String@@ -38,3 +40,6 @@  emptyGroupMap :: GroupMap emptyGroupMap = GroupMap M.empty M.empty M.empty++groupUUIDs :: Group -> GroupMap -> S.Set UUID+groupUUIDs g = fromMaybe S.empty . M.lookup g . uuidsByGroup
Types/Remote.hs view
@@ -387,8 +387,11 @@ 	-- file stored on the remote is the content of an annex object, 	-- and return its Key, or Nothing if it is not. 	---	-- Throws exception on failure to access the remote.-	, importKey :: Maybe (ImportLocation -> ContentIdentifier -> ByteSize -> MeterUpdate -> a (Maybe Key))+	-- The outer action should only check if the remote supports+	-- this, and return the inner action if so.+	-- The returned action throws exception on failure to access the+	-- remote.+	, importKeyWithContentIdentifier :: a (Maybe (ImportLocation -> ContentIdentifier -> ByteSize -> MeterUpdate -> a (Maybe Key))) 	-- Retrieves a file from the remote. Ensures that the file 	-- it retrieves has one of the requested ContentIdentifiers. 	--@@ -470,6 +473,13 @@ 	-- not need to uniquely identify content. 	-- Eg, a mtime is sufficient. 	{ listImportableContents :: a (Maybe (ImportableContentsChunkable a (ContentIdentifier, ByteSize)))+	-- Like importKeyWithContentIdentifier, but does not need to+	-- guarantee that the file on the remote still has the same+	-- content that it did when listImportableContents returned+	-- the ContentIdentifier. The ContentIdentifier is still+	-- provided so that information in it can be used to generate the+	-- key.+	, importKey :: a (Maybe (ImportLocation -> ContentIdentifier -> ByteSize -> MeterUpdate -> a (Maybe Key))) 	-- Like retrieveExportWithContentIdentifier, but does not 	-- need to guarantee that the file it retrieves has one 	-- of the requested ContentIdentifiers.
Utility/Url.hs view
@@ -55,8 +55,9 @@ import qualified Utility.FileIO as F  import Network.URI-import Network.HTTP.Types-import Network.HTTP.Types.Header (hAcceptEncoding, hContentDisposition, hContentRange)+import Network.HTTP.Types.Status+import Network.HTTP.Types.Method+import Network.HTTP.Types.Header import qualified System.FilePath.Posix as UrlPath import qualified Data.CaseInsensitive as CI import qualified Data.ByteString as B
+ cabal.project view
@@ -0,0 +1,4 @@+packages:+  .+jobs: $ncpus+semaphore: True
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 10.20260717+Version: 10.20260901 Cabal-Version: 1.12 License: AGPL-3 Maintainer: Joey Hess <id@joeyh.name>@@ -37,6 +37,7 @@   stack.yaml   stack-botan.yaml   stack-NoLLMDependencies.yaml+  cabal.project   README   CHANGELOG   NEWS@@ -160,11 +161,6 @@ Flag Production   Description: Enable production build (slower build; faster binary) -Flag ParallelBuild-  Description: Enable building in parallel-  Default: False-  Manual: True- Flag Botan   Description: Build with the Botan C++ library for faster hashing   Default: False@@ -311,7 +307,9 @@     Build-Depends:      base (>= 4.18.2.1 && < 4.23),      ram (< 0.21.0),-     persistent (>= 2.13.3) && (< 2.15.0.0)+     persistent (>= 2.13.3) && (< 2.15.0.0),+     warp (< 3.4.11),+     magic (<= 1.1)   else     Build-Depends:      base (>= 4.18.2.1 && < 5),@@ -328,9 +326,6 @@   else     GHC-Options: -O0 -  if flag(ParallelBuild)-    GHC-Options: -j-   -- Avoid linking with unused dynamic libraries.   if os(linux) || os(freebsd)     GHC-Options: -optl-Wl,--as-needed@@ -539,7 +534,7 @@     CPP-Options: -DWITH_TORRENTPARSER    if flag(MagicMime)-    Build-Depends: magic+    Build-Depends: magic (<= 1.1)     CPP-Options: -DWITH_MAGICMIME    if flag(Benchmark)@@ -844,6 +839,7 @@     Git.Command     Git.Command.Batch     Git.Config+    Git.Config.Url     Git.ConfigTypes     Git.Construct     Git.Credential
stack-NoLLMDependencies.yaml view
@@ -2,7 +2,6 @@   git-annex:     NoLLMDependencies: true     production: true-    parallelbuild: true     assistant: true     torrentparser: true     magicmime: false@@ -19,12 +18,14 @@     pkg-config: false packages: - '.'-resolver: lts-24.26+resolver: lts-24.52 extra-deps: - aws-0.25.2 - file-io-0.2.0 - blake3-0.3-- xxhash-ffi-0.3.1 - ram-0.20.1 - persistent-2.14.6.3 - persistent-sqlite-2.13.3.0+- yesod-form-1.7.9.2+- yesod-static-1.6.1.2+- magic-1.1
stack-botan.yaml view
@@ -2,7 +2,6 @@   git-annex:     NoLLMDependencies: false     production: true-    parallelbuild: true     assistant: true     torrentparser: true     magicmime: false@@ -19,11 +18,11 @@     pkg-config: false packages: - '.'-resolver: lts-24.26+resolver: lts-24.52 extra-deps: - aws-0.25.2 - file-io-0.2.0 - botan-low-0.2.0.1 - botan-bindings-0.3.0.0 - blake3-0.3-- xxhash-ffi-0.3.1+- magic-1.1
stack.yaml view
@@ -2,7 +2,6 @@   git-annex:     NoLLMDependencies: false     production: true-    parallelbuild: true     assistant: true     torrentparser: true     magicmime: false@@ -19,9 +18,9 @@     pkg-config: false packages: - '.'-resolver: lts-24.26+resolver: lts-24.52 extra-deps: - aws-0.25.2 - file-io-0.2.0 - blake3-0.3-- xxhash-ffi-0.3.1+- magic-1.1