packages feed

git-annex 10.20241202 → 10.20250102

raw patch · 29 files changed

+165/−197 lines, 29 filesdep ~aesondep ~awsdep ~base

Dependency ranges changed: aeson, aws, base, clock, dlist, feed, persistent-template, process, socks, tasty, time

Files

Annex/Import.hs view
@@ -107,9 +107,10 @@ 	:: Remote 	-> ImportTreeConfig 	-> ImportCommitConfig+	-> AddUnlockedMatcher 	-> Imported 	-> Annex (Maybe Ref)-buildImportCommit remote importtreeconfig importcommitconfig imported =+buildImportCommit remote importtreeconfig importcommitconfig addunlockedmatcher imported = 	case importCommitTracking importcommitconfig of 		Nothing -> go Nothing 		Just trackingcommit -> inRepo (Git.Ref.tree trackingcommit) >>= \case@@ -117,7 +118,7 @@ 			Just _ -> go (Just trackingcommit)   where 	go trackingcommit = do-		(importedtree, updatestate) <- recordImportTree remote importtreeconfig imported+		(importedtree, updatestate) <- recordImportTree remote importtreeconfig (Just addunlockedmatcher) imported 		buildImportCommit' remote importcommitconfig trackingcommit importedtree >>= \case 			Just finalcommit -> do 				updatestate@@ -132,10 +133,11 @@ recordImportTree 	:: Remote 	-> ImportTreeConfig+	-> Maybe AddUnlockedMatcher 	-> Imported 	-> Annex (History Sha, Annex ())-recordImportTree remote importtreeconfig imported = do-	importedtree@(History finaltree _) <- buildImportTrees basetree subdir imported+recordImportTree remote importtreeconfig addunlockedmatcher imported = do+	importedtree@(History finaltree _) <- buildImportTrees basetree subdir addunlockedmatcher imported 	return (importedtree, updatestate finaltree)   where 	basetree = case importtreeconfig of@@ -177,7 +179,7 @@ 			} 		return oldexport -	-- downloadImport takes care of updating the location log+	-- importKeys takes care of updating the location log 	-- for the local repo when keys are downloaded, and also updates 	-- the location log for the remote for keys that are present in it. 	-- That leaves updating the location log for the remote for keys@@ -283,11 +285,12 @@ buildImportTrees 	:: Ref 	-> Maybe TopFilePath+	-> Maybe AddUnlockedMatcher 	-> Imported 	-> Annex (History Sha)-buildImportTrees basetree msubdir (ImportedFull imported) = -	buildImportTreesGeneric convertImportTree basetree msubdir imported-buildImportTrees basetree msubdir (ImportedDiff (LastImportedTree oldtree) imported) = do+buildImportTrees basetree msubdir addunlockedmatcher (ImportedFull imported) = +	buildImportTreesGeneric (convertImportTree addunlockedmatcher) basetree msubdir imported+buildImportTrees basetree msubdir addunlockedmatcher (ImportedDiff (LastImportedTree oldtree) imported) = do 	importtree <- if null (importableContents imported) 		then pure oldtree 		else applydiff@@ -312,7 +315,7 @@ 			oldtree 	 	mktreeitem (loc, DiffChanged v) = -		Just <$> mkImportTreeItem msubdir loc v+		Just <$> mkImportTreeItem addunlockedmatcher msubdir loc v 	mktreeitem (_, DiffRemoved) =  		pure Nothing @@ -320,17 +323,26 @@ 		 	isremoved (_, v) = v == DiffRemoved -convertImportTree :: Maybe TopFilePath -> [(ImportLocation, Either Sha Key)] -> Annex Tree-convertImportTree msubdir ls = -	treeItemsToTree <$> mapM (uncurry $ mkImportTreeItem msubdir) ls+convertImportTree :: Maybe AddUnlockedMatcher -> Maybe TopFilePath -> [(ImportLocation, Either Sha Key)] -> Annex Tree+convertImportTree maddunlockedmatcher msubdir ls = +	treeItemsToTree <$> mapM (uncurry $ mkImportTreeItem maddunlockedmatcher msubdir) ls -mkImportTreeItem :: Maybe TopFilePath -> ImportLocation -> Either Sha Key -> Annex TreeItem-mkImportTreeItem msubdir loc v = case v of-	Right k -> do-		relf <- fromRepo $ fromTopFilePath topf-		symlink <- calcRepo $ gitAnnexLink relf k-		linksha <- hashSymlink symlink-		return $ TreeItem treepath (fromTreeItemType TreeSymlink) linksha+mkImportTreeItem :: Maybe AddUnlockedMatcher -> Maybe TopFilePath -> ImportLocation -> Either Sha Key -> Annex TreeItem+mkImportTreeItem maddunlockedmatcher msubdir loc v = case v of+	Right k -> case maddunlockedmatcher of+		Nothing -> mklink k+		Just addunlockedmatcher -> do+			objfile <- calcRepo (gitAnnexLocation k)+			let mi = MatchingFile FileInfo+				{ contentFile = objfile+				, matchFile = getTopFilePath topf+				, matchKey = Just k+				}+			ifM (checkAddUnlockedMatcher NoLiveUpdate addunlockedmatcher mi)+				( mkpointer k+				, mklink k+				)+				 	Left sha ->  		return $ TreeItem treepath (fromTreeItemType TreeFile) sha   where@@ -338,6 +350,13 @@ 	treepath = asTopFilePath lf 	topf = asTopFilePath $ 		maybe lf (\sd -> getTopFilePath sd P.</> lf) msubdir+	mklink k = do+		relf <- fromRepo $ fromTopFilePath topf+		symlink <- calcRepo $ gitAnnexLink relf k+		linksha <- hashSymlink symlink+		return $ TreeItem treepath (fromTreeItemType TreeSymlink) linksha+	mkpointer k = TreeItem treepath (fromTreeItemType TreeFile)+		<$> hashPointerFile k  {- Builds a history of git trees using ContentIdentifiers.  -@@ -604,8 +623,8 @@  - generates Keys without downloading.  -  - Generates either a Key or a git Sha, depending on annex.largefiles.- - But when importcontent is False, it cannot match on annex.largefiles- - (or generate a git Sha), so always generates Keys.+ - But when importcontent is False, it cannot generate a git Sha, + - so always generates Keys.  -  - Supports concurrency when enabled.  -
Annex/Perms.hs view
@@ -278,7 +278,7 @@ {- Blocks writing to the directory an annexed file is in, to prevent the  - file accidentally being deleted. However, if core.sharedRepository  - is set, this is not done, since the group must be allowed to delete the- - file without eing able to thaw the directory.+ - file without being able to thaw the directory.  -} freezeContentDir :: RawFilePath -> Annex () freezeContentDir file = do
CHANGELOG view
@@ -1,3 +1,27 @@+git-annex (10.20250102) upstream; urgency=medium++  * Added config `url.<base>.annexInsteadOf` corresponding to git's+    `url.<base>.pushInsteadOf`, to configure the urls to use for accessing+    the git-annex repositories on a server without needing to configure+    remote.name.annexUrl in each repository.+  * Work around git hash-object --stdin-paths's odd stripping of carriage+    return from the end of the line (some windows infection), avoiding+    crashing when the repo contains a filename ending in a carriage return.+  * Document that settting preferred content to "" is the same as the+    default unset behavior.+  * sync: Avoid misleading warning about future preferred content+    transition when preferred content is set to "".+  * Honor annex.addunlocked configuration when importing a tree from a+    special remote.+  * Removed the i386ancient standalone tarball build for linux, which+    was increasingly unable to support new git-annex features.+  * Removed support for building with ghc older than 9.0.2,+    and with older versions of haskell libraries than are in current Debian+    stable.+  * stack.yaml: Update to lts-23.2.++ -- Joey Hess <id@joeyh.name>  Thu, 02 Jan 2025 12:31:58 -0400+ git-annex (10.20241202) upstream; urgency=medium    * add: Consistently treat files in a dotdir as dotfiles, even
@@ -2,7 +2,7 @@ Source: native package  Files: *-Copyright: © 2010-2024 Joey Hess <id@joeyh.name>+Copyright: © 2010-2025 Joey Hess <id@joeyh.name> License: AGPL-3+  Files: Assistant/WebApp.hs Assistant/WebApp/* templates/* static/*@@ -20,7 +20,7 @@  Files: Command/Sync.hs Copyright: © Joachim Breitner <mail@joachim-breitner.de>-           © 2011-2020 Joey Hess <id@joeyh.name>+           © 2011-2024 Joey Hess <id@joeyh.name> License: AGPL-3+  Files: Command/List.hs@@ -43,7 +43,7 @@ License: AGPL-3+  Files: Utility/*-Copyright: 2012-2022 Joey Hess <id@joeyh.name>+Copyright: 2012-2025 Joey Hess <id@joeyh.name> License: BSD-2-clause  Files: doc/logo* */favicon.ico standalone/osx/git-annex.app/Contents/Resources/git-annex.icns
Command/Import.hs view
@@ -147,8 +147,10 @@ 		(pure Nothing) 		(Just <$$> inRepo . toTopFilePath . toRawFilePath) 		(importToSubDir o)+	addunlockedmatcher <- addUnlockedMatcher 	seekRemote r (importToBranch o) subdir (importContent o)  		(checkGitIgnoreOption o)+		addunlockedmatcher 		(messageOption o)  startLocal :: ImportOptions -> AddUnlockedMatcher -> GetFileMatcher -> DuplicateMode -> (RawFilePath, RawFilePath) -> CommandStart@@ -322,8 +324,8 @@ 	verifyEnoughCopiesToDrop [] key Nothing Nothing needcopies mincopies [] preverified tocheck 		(const yes) no -seekRemote :: Remote -> Branch -> Maybe TopFilePath -> Bool -> CheckGitIgnore -> [String] -> CommandSeek-seekRemote remote branch msubdir importcontent ci importmessages = do+seekRemote :: Remote -> Branch -> Maybe TopFilePath -> Bool -> CheckGitIgnore -> AddUnlockedMatcher -> [String] -> CommandSeek+seekRemote remote branch msubdir importcontent ci addunlockedmatcher importmessages = do 	importtreeconfig <- case msubdir of 		Nothing -> return ImportTree 		Just subdir ->@@ -337,7 +339,7 @@ 	trackingcommit <- fromtrackingbranch Git.Ref.sha 	cmode <- annexCommitMode <$> Annex.getGitConfig 	let importcommitconfig = ImportCommitConfig trackingcommit cmode importmessages'-	let commitimport = commitRemote remote branch tb trackingcommit importtreeconfig importcommitconfig+	let commitimport = commitRemote remote branch tb trackingcommit importtreeconfig importcommitconfig addunlockedmatcher  	importabletvar <- liftIO $ newTVarIO Nothing 	void $ includeCommandAction (listContents remote importtreeconfig ci importabletvar)@@ -383,10 +385,10 @@ 			, err 			] -commitRemote :: Remote -> Branch -> RemoteTrackingBranch -> Maybe Sha -> ImportTreeConfig -> ImportCommitConfig -> Imported -> CommandStart-commitRemote remote branch tb trackingcommit importtreeconfig importcommitconfig imported =+commitRemote :: Remote -> Branch -> RemoteTrackingBranch -> Maybe Sha -> ImportTreeConfig -> ImportCommitConfig -> AddUnlockedMatcher -> Imported -> CommandStart+commitRemote remote branch tb trackingcommit importtreeconfig importcommitconfig addunlockedmatcher imported = 	starting "update" ai si $ do-		importcommit <- buildImportCommit remote importtreeconfig importcommitconfig imported+		importcommit <- buildImportCommit remote importtreeconfig importcommitconfig addunlockedmatcher imported 		next $ updateremotetrackingbranch importcommit   where 	ai = ActionItemOther (Just $ UnquotedString $ fromRef $ fromRemoteTrackingBranch tb)
Command/ImportFeed.hs view
@@ -170,7 +170,7 @@  	-- Use parseFeedFromFile rather than reading the file 	-- ourselves because it goes out of its way to handle encodings.-	parse tmpf = liftIO (parseFeedFromFile' tmpf) >>= \case+	parse tmpf = liftIO (parseFeedFromFile tmpf) >>= \case 		Nothing -> debugfeedcontent tmpf "parsing the feed failed" 		Just f -> do 			case decodeBS $ fromFeedText $ getFeedTitle f of@@ -200,13 +200,6 @@ 		Right playlist -> do 			record (Just (Just (playlistDownloads url playlist))) 			next $ return True--parseFeedFromFile' :: FilePath -> IO (Maybe Feed)-#if MIN_VERSION_feed(1,1,0)-parseFeedFromFile' = parseFeedFromFile-#else-parseFeedFromFile' f = catchMaybeIO (parseFeedFromFile f)-#endif  data ToDownload = ToDownload 	{ feedurl :: URLString
Command/Sync.hs view
@@ -53,6 +53,7 @@ import Annex.Wanted import Annex.Content import Annex.WorkTree+import Annex.FileMatcher import Command.Get (getKey') import qualified Command.Move import qualified Command.Export@@ -77,7 +78,6 @@ import Annex.Import import Annex.CheckIgnore import Annex.PidLock-import Types.FileMatcher import Types.GitConfig import Types.Availability import qualified Database.Export as Export@@ -85,6 +85,7 @@ import Utility.OptParse import Utility.Process.Transcript import Utility.Tuple+import Utility.Matcher  import Control.Concurrent.MVar import qualified Data.Map as M@@ -579,7 +580,8 @@ 			let (branch, subdir) = splitRemoteAnnexTrackingBranchSubdir b 			if canImportKeys remote importcontent 				then do-					Command.Import.seekRemote remote branch subdir importcontent (CheckGitIgnore True) []+					addunlockedmatcher <- addUnlockedMatcher+					Command.Import.seekRemote remote branch subdir importcontent (CheckGitIgnore True) addunlockedmatcher [] 					-- Importing generates a branch 					-- that is not initially connected 					-- to the current branch, so allow@@ -606,7 +608,7 @@   where 	go (Just importable) = importChanges remote ImportTree False True importable >>= \case 		ImportFinished imported -> do-			(_t, updatestate) <- recordImportTree remote ImportTree imported+			(_t, updatestate) <- recordImportTree remote ImportTree Nothing imported 			next $ do 				updatestate 				return True@@ -1130,7 +1132,7 @@ 		_ -> do 			m <- preferredContentMap 			hereu <- getUUID-			when (any (`M.member` m) (hereu:map Remote.uuid remotes)) $+			when (any (preferredcontentconfigured m) (hereu:map Remote.uuid remotes)) $ 				showwarning   where 	showwarning = earlyWarning $@@ -1140,6 +1142,8 @@ 		<> " send 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)  notOnlyAnnex :: SyncOptions -> Annex Bool notOnlyAnnex o = not <$> onlyAnnex o
Database/ContentIdentifier.hs view
@@ -12,10 +12,8 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE DataKinds, FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-}-#if MIN_VERSION_persistent_template(2,8,0) {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE StandaloneDeriving #-}-#endif  module Database.ContentIdentifier ( 	ContentIdentifierHandle,
Database/Export.hs view
@@ -5,17 +5,14 @@  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE CPP #-} {-# LANGUAGE QuasiQuotes, TypeFamilies, TypeOperators, TemplateHaskell #-} {-# LANGUAGE OverloadedStrings, GADTs, FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE DataKinds, FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-}-#if MIN_VERSION_persistent_template(2,8,0) {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE StandaloneDeriving #-}-#endif  module Database.Export ( 	ExportHandle,
Database/Fsck.hs view
@@ -5,7 +5,6 @@  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE CPP #-} {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell #-} {-# LANGUAGE OverloadedStrings, GADTs, FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}@@ -13,10 +12,8 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeOperators #-}-#if MIN_VERSION_persistent_template(2,8,0) {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE StandaloneDeriving #-}-#endif  module Database.Fsck ( 	FsckHandle,
Database/ImportFeed.hs view
@@ -6,17 +6,14 @@  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE CPP #-} {-# LANGUAGE QuasiQuotes, TypeFamilies, TypeOperators, TemplateHaskell #-} {-# LANGUAGE OverloadedStrings, GADTs, FlexibleContexts, EmptyDataDecls #-} {-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE DataKinds, FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-}-#if MIN_VERSION_persistent_template(2,8,0) {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE StandaloneDeriving #-}-#endif  module Database.ImportFeed ( 	ImportFeedDbHandle,
Database/Keys/SQL.hs view
@@ -5,17 +5,14 @@  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE CPP #-} {-# LANGUAGE QuasiQuotes, TypeFamilies, TypeOperators, TemplateHaskell #-} {-# LANGUAGE OverloadedStrings, GADTs, FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving #-} {-# LANGUAGE RankNTypes, ScopedTypeVariables #-} {-# LANGUAGE DataKinds, FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-}-#if MIN_VERSION_persistent_template(2,8,0) {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE StandaloneDeriving #-}-#endif  module Database.Keys.SQL where
Database/RepoSize.hs view
@@ -5,7 +5,6 @@  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE CPP #-} {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell #-} {-# LANGUAGE OverloadedStrings, GADTs, FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}@@ -13,10 +12,8 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeOperators #-}-#if MIN_VERSION_persistent_template(2,8,0) {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE StandaloneDeriving #-}-#endif  module Database.RepoSize ( 	RepoSizeHandle,
Git/HashObject.hs view
@@ -48,13 +48,17 @@ 	-- So, make the filename absolute, which will work now 	-- and also if git's behavior later changes. 	file' <- absPath file-	if newline `S.elem` file'+	if newline `S.elem` file' || carriagereturn `S.elem` file 		then hashFile' hdl file 		else CoProcess.query h (send file') receive   where 	send file' to = S8.hPutStrLn to file' 	receive from = getSha "hash-object" $ S8.hGetLine from 	newline = fromIntegral (ord '\n')+	-- git strips carriage return from the end of a line, out of some+	-- misplaced desire to support windows, so also use the newline+	-- fallback for those.+	carriagereturn = fromIntegral (ord '\r')  {- Runs git hash-object once per call, rather than using a running  - one, so is slower. But, is able to handle newlines in the filepath,
Git/Remote.hs view
@@ -89,7 +89,7 @@ parseRemoteLocation :: String -> Bool -> Repo -> RemoteLocation parseRemoteLocation s knownurl repo = go   where- 	s' = calcloc s+ 	s' = fromMaybe s $ insteadOfUrl s ".insteadof" $ fullconfig repo 	go #ifdef mingw32_HOST_OS 		| dosstyle s' = RemotePath (dospath s')@@ -98,28 +98,6 @@ 		| urlstyle s' = RemoteUrl s' 		| knownurl && s' == s = RemoteUrl s' 		| otherwise = RemotePath s'-	-- insteadof config can rewrite remote location-	calcloc l-		| null insteadofs = l-		| otherwise = replacement ++ drop (S.length bestvalue) l-	  where-		replacement = decodeBS $ S.drop (S.length prefix) $-			S.take (S.length bestkey - S.length suffix) bestkey-		(bestkey, bestvalue) = -			case maximumBy longestvalue insteadofs of-				(ConfigKey k, ConfigValue v) -> (k, v)-				(ConfigKey k, NoConfigValue) -> (k, mempty)-		longestvalue (_, a) (_, b) = compare b a-		insteadofs = filterconfig $ \case-			(ConfigKey k, ConfigValue v) -> -				prefix `S.isPrefixOf` k &&-				suffix `S.isSuffixOf` k &&-				v `S.isPrefixOf` encodeBS l-			(_, NoConfigValue) -> False-		filterconfig f = filter f $-			concatMap splitconfigs $ M.toList $ fullconfig repo-		splitconfigs (k, vs) = map (\v -> (k, v)) (NE.toList vs)-		(prefix, suffix) = ("url." , ".insteadof") 	-- git supports URIs that contain unescaped characters such as 	-- spaces. So to test if it's a (git) URI, escape those. 	urlstyle v = isURI (escapeURIString isUnescapedInURI v)@@ -147,3 +125,26 @@ 	dosstyle = hasDrive 	dospath = fromRawFilePath . fromInternalGitPath . toRawFilePath #endif++insteadOfUrl :: String -> S.ByteString -> RepoFullConfig -> Maybe String+insteadOfUrl u configsuffix fullcfg+	| null insteadofs = Nothing+	| otherwise = Just $ replacement ++ drop (S.length bestvalue) u+  where+	replacement = decodeBS $ S.drop (S.length configprefix) $+		S.take (S.length bestkey - S.length configsuffix) bestkey+	(bestkey, bestvalue) = +		case maximumBy longestvalue insteadofs of+			(ConfigKey k, ConfigValue v) -> (k, v)+			(ConfigKey k, NoConfigValue) -> (k, mempty)+	longestvalue (_, a) (_, b) = compare b a+	insteadofs = filterconfig $ \case+		(ConfigKey k, ConfigValue v) -> +			configprefix `S.isPrefixOf` k &&+			configsuffix `S.isSuffixOf` k &&+			v `S.isPrefixOf` encodeBS u+		(_, NoConfigValue) -> False+	filterconfig f = filter f $+		concatMap splitconfigs $ M.toList fullcfg+	splitconfigs (k, vs) = map (\v -> (k, v)) (NE.toList vs)+	configprefix = "url."
Git/Types.hs view
@@ -41,9 +41,9 @@  data Repo = Repo 	{ location :: RepoLocation-	, config :: M.Map ConfigKey ConfigValue+	, config :: RepoConfig 	-- a given git config key can actually have multiple values-	, fullconfig :: M.Map ConfigKey (NE.NonEmpty ConfigValue)+	, fullconfig :: RepoFullConfig 	-- remoteName holds the name used for this repo in some other 	-- repo's list of remotes, when this repo is such a remote 	, remoteName :: Maybe RemoteName@@ -60,6 +60,10 @@ 	-- when using this repository. 	, repoPathSpecifiedExplicitly :: Bool 	} deriving (Show, Eq, Ord)+	+type RepoConfig = M.Map ConfigKey ConfigValue++type RepoFullConfig = M.Map ConfigKey (NE.NonEmpty ConfigValue)  newtype ConfigKey = ConfigKey S.ByteString 	deriving (Ord, Eq)
Messages/JSON.hs view
@@ -5,7 +5,7 @@  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE OverloadedStrings, GADTs, CPP #-}+{-# LANGUAGE OverloadedStrings, GADTs #-}  module Messages.JSON ( 	JSONBuilder,@@ -35,11 +35,7 @@ import qualified Data.Map as M import qualified Data.Vector as V import qualified Data.ByteString.Lazy as L-#if MIN_VERSION_aeson(2,0,0) import qualified Data.Aeson.KeyMap as HM-#else-import qualified Data.HashMap.Strict as HM-#endif import System.IO import System.IO.Unsafe (unsafePerformIO) import Control.Concurrent
Remote/Git.hs view
@@ -98,8 +98,9 @@  list :: Bool -> Annex [Git.Repo] list autoinit = do-	c <- fromRepo Git.config-	rs <- mapM (tweakurl c) =<< Annex.getGitRemotes+	cfg <- fromRepo Git.config+	fullcfg <- fromRepo Git.fullconfig+	rs <- mapM (tweakurl cfg fullcfg) =<< Annex.getGitRemotes 	rs' <- mapM (configRead autoinit) (filter (not . isGitRemoteAnnex) rs) 	proxies <- doQuietAction getProxies 	if proxies == mempty@@ -108,17 +109,20 @@ 			proxied <- listProxied proxies rs' 			return (proxied++rs')   where-	tweakurl c r = do+	tweakurl cfg fullcfg r = do 		let n = fromJust $ Git.remoteName r-		case getAnnexUrl r c of-			Just url | not (isP2PHttpProtocolUrl url) -> +		case getAnnexUrl r cfg fullcfg of+			Just url | not (isP2PHttpProtocolUrl url) -> 				inRepo $ \g -> Git.Construct.remoteNamed n $ 					Git.Construct.fromRemoteLocation url 						False g 			_ -> return r -getAnnexUrl :: Git.Repo -> M.Map Git.ConfigKey Git.ConfigValue -> Maybe String-getAnnexUrl r c = Git.fromConfigValue <$> M.lookup (annexUrlConfigKey r) c+getAnnexUrl :: Git.Repo -> Git.RepoConfig -> Git.RepoFullConfig -> Maybe String+getAnnexUrl r cfg fullcfg = +	(Git.fromConfigValue <$> M.lookup (annexUrlConfigKey r) cfg)+		<|>+	annexInsteadOfUrl fullcfg (Git.repoLocation r)  annexUrlConfigKey :: Git.Repo -> Git.ConfigKey annexUrlConfigKey r = remoteConfig r "annexurl"
Remote/S3.hs view
@@ -366,12 +366,8 @@ 		resp <- sendS3Handle h req 		vid <- mkS3VersionID object 			<$> extractFromResourceT (S3.porVersionId resp)-#if MIN_VERSION_aws(0,22,0) 		etag <- extractFromResourceT (Just (S3.porETag resp)) 		return (etag, vid)-#else-		return (Nothing, vid)-#endif 	multipartupload fsz partsz = runResourceT $ do 		contenttype <- liftIO getcontenttype 		let startreq = (S3.postInitiateMultipartUpload (bucket info) object)@@ -751,11 +747,7 @@ storeExportWithContentIdentifierS3 :: S3HandleVar -> Remote -> RemoteStateHandle -> S3Info -> Maybe Magic -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier storeExportWithContentIdentifierS3 hv r rs info magic src k loc _overwritablecids p 	| versioning info = go-#if MIN_VERSION_aws(0,22,0) 	| otherwise = go-#else-	| otherwise = giveup "git-annex is built with too old a version of the aws library to support this operation"-#endif   where 	go = storeExportS3' hv r rs info magic src k loc p >>= \case 		(_, Just vid) -> return $@@ -1370,11 +1362,7 @@ -- setting versioning in a bucket that git-annex has already exported -- files to risks losing the content of those un-versioned files. enableBucketVersioning :: SetupStage -> S3Info -> ParsedRemoteConfig -> RemoteGitConfig -> UUID -> Annex ()-#if MIN_VERSION_aws(0,21,1) enableBucketVersioning ss info c gc u = do-#else-enableBucketVersioning ss info _ _ _ = do-#endif 	case ss of 		Init -> when (versioning info) $ 			enableversioning (bucket info)@@ -1382,7 +1370,6 @@ 		AutoEnable oldc -> checkunchanged oldc   where 	enableversioning b = do-#if MIN_VERSION_aws(0,21,1) 		showAction "checking bucket versioning" 		hdl <- mkS3HandleVar c gc u 		let setversioning = S3.putBucketVersioning b S3.VersioningEnabled@@ -1400,15 +1387,6 @@ 								++ T.unpack (S3.s3ErrorMessage err) #else 			void $ liftIO $ runResourceT $ sendS3Handle h setversioning-#endif-#else-		showLongNote $ unlines-			[ "This version of git-annex cannot auto-enable S3 bucket versioning."-			, "You need to manually enable versioning in the S3 console"-			, "for the bucket \"" ++ T.unpack b ++ "\""-			, "https://docs.aws.amazon.com/AmazonS3/latest/user-guide/enable-versioning.html"-			, "It's important you enable versioning before storing anything in the bucket!"-			] #endif  	checkunchanged oldc = do
Test/Framework.hs view
@@ -5,8 +5,6 @@  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE CPP #-}- module Test.Framework where  import Test.Tasty@@ -858,13 +856,7 @@ initTestsName = "Init Tests"  tastyParser :: [TestTree] -> ([String], Parser Test.Tasty.Options.OptionSet)-#if MIN_VERSION_tasty(1,3,0)-tastyParser ts = go-#else-tastyParser ts = ([], go)-#endif-  where- 	go = suiteOptionParser ingredients (topLevelTestGroup ts)+tastyParser ts = suiteOptionParser ingredients (topLevelTestGroup ts)  ingredients :: [Ingredient] ingredients =
Types/GitConfig.hs view
@@ -27,6 +27,7 @@ 	proxyInheritedFields, 	MkRemoteConfigKey, 	mkRemoteConfigKey,+	annexInsteadOfUrl, ) where  import Common@@ -35,7 +36,7 @@ import qualified Git.Construct import Git.Types import Git.ConfigTypes-import Git.Remote (isRemoteKey, isLegalName, remoteKeyToRemoteName)+import Git.Remote (isRemoteKey, isLegalName, remoteKeyToRemoteName, insteadOfUrl) import Git.Branch (CommitMode(..)) import Git.Quote (QuotePath(..)) import Utility.DataUnits@@ -497,16 +498,14 @@ 		, remoteAnnexClusterGateway = fromMaybe [] $ 			(mapMaybe (mkClusterUUID . toUUID) . words) 				<$> getmaybe ClusterGatewayField-		, remoteUrl = case Git.Config.getMaybe (mkRemoteConfigKey remotename (remoteGitConfigKey UrlField)) r of-			Just (ConfigValue b)-				| B.null b -> Nothing-				| otherwise -> Just (decodeBS b)-			_ -> Nothing+		, remoteUrl = getremoteurl 		, remoteAnnexP2PHttpUrl = 			case Git.Config.getMaybe (mkRemoteConfigKey remotename (remoteGitConfigKey AnnexUrlField)) r of 				Just (ConfigValue b) -> 					parseP2PHttpUrl (decodeBS b)-				_ -> Nothing+				_ -> parseP2PHttpUrl+					=<< annexInsteadOfUrl (fullconfig r)+					=<< getremoteurl 		, remoteAnnexShell = getmaybe ShellField 		, remoteAnnexSshOptions = getoptions SshOptionsField 		, remoteAnnexRsyncOptions = getoptions RsyncOptionsField@@ -544,6 +543,11 @@ 		in Git.Config.getMaybe (mkRemoteConfigKey remotename k) r 			<|> Git.Config.getMaybe (mkAnnexConfigKey k) r 	getoptions k = fromMaybe [] $ words <$> getmaybe k+	getremoteurl = case Git.Config.getMaybe (mkRemoteConfigKey remotename (remoteGitConfigKey UrlField)) r of+		Just (ConfigValue b)+			| B.null b -> Nothing+			| otherwise -> Just (decodeBS b)+		_ -> Nothing  data RemoteGitConfigField 	= CostField@@ -742,3 +746,6 @@ remoteConfig :: RemoteNameable r => r -> B.ByteString -> ConfigKey remoteConfig r key = ConfigKey $ 	"remote." <> encodeBS (getRemoteName r) <> "." <> key++annexInsteadOfUrl :: RepoFullConfig -> String -> Maybe String+annexInsteadOfUrl fullcfg loc = insteadOfUrl loc ".annexinsteadof" fullcfg
Utility/Aeson.hs view
@@ -7,7 +7,7 @@  - License: BSD-2-clause  -} -{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, CPP #-}+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}  module Utility.Aeson ( 	module X,@@ -21,9 +21,7 @@ import Data.Aeson as X (decode, eitherDecode, parseJSON, FromJSON, Object, object, Value(..), (.=), (.:), (.:?)) import Data.Aeson hiding (encode) import qualified Data.Aeson-#if MIN_VERSION_aeson(2,0,0) import qualified Data.Aeson.Key as AK-#endif import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.ByteString.Lazy as L@@ -73,13 +71,8 @@ 	Right t -> t 	Left _ -> T.pack s -#if MIN_VERSION_aeson(2,0,0) textKey :: T.Text -> AK.Key textKey = AK.fromText-#else-textKey :: T.Text -> T.Text-textKey = id-#endif  -- | The same as packString . decodeBS, but more efficient in the usual -- case.
Utility/MonotonicClock.hs view
@@ -10,11 +10,7 @@  module Utility.MonotonicClock where -#if MIN_VERSION_clock(0,3,0) import qualified System.Clock as Clock-#else-import qualified System.Posix.Clock as Clock-#endif #ifdef linux_HOST_OS import Utility.Exception #endif
Utility/Process.hs view
@@ -219,21 +219,7 @@ 	return r  cleanupProcess :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO () -#if MIN_VERSION_process(1,6,4) cleanupProcess = Utility.Process.Shim.cleanupProcess-#else-cleanupProcess (mb_stdin, mb_stdout, mb_stderr, pid) = do-	-- Unlike the real cleanupProcess, this does not wait-	-- for the process to finish in the background, so if-	-- the process ignores SIGTERM, this can block until the process-	-- gets around the exiting.-	terminateProcess pid-	let void _ = return ()-	maybe (return ()) (void . tryNonAsync . hClose) mb_stdin-	maybe (return ()) hClose mb_stdout-	maybe (return ()) hClose mb_stderr-	void $ waitForProcess pid-#endif  {- | Like hGetLine, reads a line from the Handle. Returns Nothing if end of  - file is reached, or the handle is closed, or if the process has exited
Utility/TList.hs view
@@ -12,7 +12,6 @@  -}  {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}  module Utility.TList ( 	TList,@@ -45,11 +44,7 @@ headTList :: TList a -> STM a headTList tlist = do 	dl <- takeTMVar tlist-#if MIN_VERSION_dlist(1,0,0) 	let !dl' = D.fromList $ D.tail dl-#else-	let !dl' = D.tail dl-#endif 	unless (emptyDList dl') $ 		putTMVar tlist dl' 	return (D.head dl)
Utility/TimeStamp.hs view
@@ -5,8 +5,6 @@  - License: BSD-2-clause  -} -{-# LANGUAGE CPP #-}- module Utility.TimeStamp ( 	parserPOSIXTime, 	parsePOSIXTime,@@ -62,11 +60,7 @@  {- Truncate the resolution to the specified number of decimal places. -} truncateResolution :: Int -> POSIXTime -> POSIXTime-#if MIN_VERSION_time(1,9,1) truncateResolution n t = secondsToNominalDiffTime $ 	fromIntegral ((truncate (nominalDiffTimeToSeconds t * d)) :: Integer) / d   where 	d = 10 ^ n-#else-truncateResolution _ t = t-#endif
Utility/Tor.hs view
@@ -5,8 +5,6 @@  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE CPP #-}- module Utility.Tor ( 	OnionPort, 	OnionAddress(..),@@ -51,12 +49,8 @@ 	return s   where 	torsocksport = 9050-#if MIN_VERSION_socks(0,6,0) 	torsockconf = defaultSocksConf $ SockAddrInet torsocksport $ 		tupleToHostAddress (127,0,0,1)-#else-	torsockconf = defaultSocksConf "127.0.0.1" torsocksport-#endif 	socksdomain = SocksAddrDomainName (BU8.fromString address) 	socksaddr = SocksAddress socksdomain (fromIntegral port)
git-annex.cabal view
@@ -1,11 +1,11 @@ Name: git-annex-Version: 10.20241202+Version: 10.20250102 Cabal-Version: 1.12 License: AGPL-3 Maintainer: Joey Hess <id@joeyh.name> Author: Joey Hess Stability: Stable-Copyright: 2010-2024 Joey Hess+Copyright: 2010-2025 Joey Hess License-File: COPYRIGHT Homepage: http://git-annex.branchable.com/ Build-type: Custom@@ -192,14 +192,14 @@  custom-setup   Setup-Depends:-    base (>= 4.11.1.0 && < 5.0),+    base (>= 4.15.1.0 && < 5.0),     split,     filepath,     exceptions,     bytestring,     filepath-bytestring (>= 1.4.2.1.4),-    process (>= 1.6.3),-    time (>= 1.5.0),+    process (>= 1.6.4),+    time (>= 1.9.1),     directory (>= 1.2.7.0),     async,     utf8-string,@@ -208,7 +208,7 @@ Executable git-annex   Main-Is: git-annex.hs   Build-Depends:-   base (>= 4.11.1.0 && < 5.0),+   base (>= 4.15.1.0 && < 5.0),    network-uri (>= 2.6),    optparse-applicative (>= 0.14.2),    containers (>= 0.5.8),@@ -216,11 +216,11 @@    stm (>= 2.3),    mtl (>= 2),    uuid (>= 1.2.6),-   process (>= 1.6.3),+   process (>= 1.6.4),    data-default,    case-insensitive,    random,-   dlist,+   dlist (>= 1.0),    unix-compat (>= 0.5 && < 0.8),    SafeSemaphore,    async,@@ -246,20 +246,20 @@    http-conduit (>= 2.3.0),    http-client-restricted (>= 0.0.2),    conduit,-   time (>= 1.5.0),+   time (>= 1.9.1),    old-locale,    persistent-sqlite (>= 2.8.1),    persistent (>= 2.8.1),-   persistent-template,+   persistent-template (>= 2.8.0),    unliftio-core,    microlens,-   aeson,+   aeson (>= 2.0.0),    vector,    tagsoup,    unordered-containers,-   feed (>= 1.0.0),+   feed (>= 1.1.0),    regex-tdfa,-   socks,+   socks (>= 0.6.0),    byteable,    stm-chans,    securemem,@@ -271,17 +271,17 @@    concurrent-output (>= 1.10),    unbounded-delays,    QuickCheck (>= 2.10.0),-   tasty (>= 1.2),+   tasty (>= 1.3.0),    tasty-hunit,    tasty-quickcheck,    tasty-rerun,    ansi-terminal >= 0.9,-   aws (>= 0.20),+   aws (>= 0.22.1),    DAV (>= 1.0),    network (>= 3.0.0.0),    network-bsd,    git-lfs (>= 1.2.0),-   clock (>= 0.2.0.0)+   clock (>= 0.3.0)   CC-Options: -Wall   GHC-Options: -Wall -fno-warn-tabs  -Wincomplete-uni-patterns   Default-Language: Haskell2010
stack.yaml view
@@ -13,7 +13,6 @@     servant: true packages: - '.'-resolver: nightly-2024-07-29+resolver: lts-23.2 extra-deps: - filepath-bytestring-1.4.100.3.2-- aws-0.24.3