packages feed

git-annex 10.20250320 → 10.20250416

raw patch · 32 files changed

+474/−136 lines, 32 files

Files

Annex/Content.hs view
@@ -368,8 +368,16 @@ 				cleanuplockfile lockfile #endif -	cleanuplockfile lockfile = void $ tryNonAsync $ do-		thawContentDir lockfile+	cleanuplockfile lockfile = +		-- Often the content directory will be thawed already,+		-- so avoid re-thawing, unless cleanup fails.+		tryNonAsync (cleanuplockfile' lockfile) >>= \case+			Right () -> return ()+			Left _ -> void $ tryNonAsync $ do+				thawContentDir lockfile+				cleanuplockfile' lockfile+	+	cleanuplockfile' lockfile = do 		liftIO $ removeWhenExistsWith removeFile lockfile 		cleanObjectDirs lockfile
Annex/Ssh.hs view
@@ -351,10 +351,15 @@ 	fromSshHost host ++ "!" ++ show port hostport2socket' :: String -> OsPath hostport2socket' s-	| length s > lengthofmd5s = toOsPath $ show $ md5 $ encodeBL s-	| otherwise = toOsPath s+	| length s' > lengthofmd5s = toOsPath $ show $ md5 $ encodeBL s'+	| otherwise = toOsPath s'   where 	lengthofmd5s = 32+	-- ssh parses the socket filename as a ControlPath, so it can+	-- contain eg "%h". We don't want that here, and it's possible+	-- for a hostname to itself contain a '%', eg a IPV6 link-local+	-- address with a zone ID.+	s' = filter (/= '%') s  socket2lock :: OsPath -> OsPath socket2lock socket = socket <> lockExt
Annex/Url.hs view
@@ -56,8 +56,8 @@ getUserAgent = Annex.getRead $  	fromMaybe defaultUserAgent . Annex.useragent -getUrlOptions :: Annex U.UrlOptions-getUrlOptions = Annex.getState Annex.urloptions >>= \case+getUrlOptions :: Maybe RemoteGitConfig -> Annex U.UrlOptions+getUrlOptions mgc = Annex.getState Annex.urloptions >>= \case 	Just uo -> return uo 	Nothing -> do 		uo <- mk@@ -81,10 +81,15 @@ 			>>= \case 				Just output -> pure (lines output) 				Nothing -> annexHttpHeaders <$> Annex.getGitConfig+			+	getweboptions = case mgc of+		Just gc | not (null (remoteAnnexWebOptions gc)) ->+			pure (remoteAnnexWebOptions gc)+		_ -> annexWebOptions <$> Annex.getGitConfig 	 	checkallowedaddr = words . annexAllowedIPAddresses <$> Annex.getGitConfig >>= \case 		["all"] -> do-			curlopts <- map Param . annexWebOptions <$> Annex.getGitConfig+			curlopts <- map Param <$> getweboptions 			allowedurlschemes <- annexAllowedUrlSchemes <$> Annex.getGitConfig 			let urldownloader = if null curlopts && not (any (`S.notMember` U.conduitUrlSchemes) allowedurlschemes) 				then U.DownloadWithConduit $@@ -148,8 +153,8 @@ ipAddressesUnlimited =  	("all" == ) . annexAllowedIPAddresses <$> Annex.getGitConfig -withUrlOptions :: (U.UrlOptions -> Annex a) -> Annex a-withUrlOptions a = a =<< getUrlOptions+withUrlOptions :: Maybe RemoteGitConfig -> (U.UrlOptions -> Annex a) -> Annex a+withUrlOptions mgc a = a =<< getUrlOptions mgc  -- When downloading an url, if authentication is needed, uses -- git-credential to prompt for username and password.@@ -157,10 +162,10 @@ -- Note that, when the downloader is curl, it will not use git-credential. -- If the user wants to, they can configure curl to use a netrc file that -- handles authentication.-withUrlOptionsPromptingCreds :: (U.UrlOptions -> Annex a) -> Annex a-withUrlOptionsPromptingCreds a = do+withUrlOptionsPromptingCreds :: Maybe RemoteGitConfig -> (U.UrlOptions -> Annex a) -> Annex a+withUrlOptionsPromptingCreds mgc a = do 	g <- Annex.gitRepo-	uo <- getUrlOptions+	uo <- getUrlOptions mgc 	prompter <- mkPrompter 	cc <- Annex.getRead Annex.gitcredentialcache 	a $ uo
Annex/YoutubeDl.hs view
@@ -74,7 +74,7 @@ -- <https://github.com/rg3/youtube-dl/issues/14864>) youtubeDl :: URLString -> OsPath -> MeterUpdate -> Annex (Either String (Maybe OsPath)) youtubeDl url workdir p = ifM ipAddressesUnlimited-	( withUrlOptions $ youtubeDl' url workdir p+	( withUrlOptions Nothing $ youtubeDl' url workdir p 	, return $ Left youtubeDlNotAllowedMessage 	) @@ -194,7 +194,7 @@ -- without it. So, this first downloads part of the content and checks  -- if it's a html page; only then is youtube-dl used. htmlOnly :: URLString -> a -> Annex a -> Annex a-htmlOnly url fallback a = withUrlOptions $ \uo -> +htmlOnly url fallback a = withUrlOptions Nothing $ \uo ->  	liftIO (downloadPartial url uo htmlPrefixLength) >>= \case 		Just bs | isHtmlBs bs -> a 		_ -> return fallback@@ -202,7 +202,7 @@ -- Check if youtube-dl supports downloading content from an url. youtubeDlSupported :: URLString -> Annex Bool youtubeDlSupported url = either (const False) id-	<$> withUrlOptions (youtubeDlCheck' url)+	<$> withUrlOptions Nothing (youtubeDlCheck' url)  -- Check if youtube-dl can find media in an url. --@@ -211,7 +211,7 @@ -- download won't succeed. youtubeDlCheck :: URLString -> Annex (Either String Bool) youtubeDlCheck url = ifM youtubeDlAllowed-	( withUrlOptions $ youtubeDlCheck' url+	( withUrlOptions Nothing $ youtubeDlCheck' url 	, return $ Left youtubeDlNotAllowedMessage 	) @@ -227,7 +227,7 @@ -- -- (This is not always identical to the filename it uses when downloading.) youtubeDlFileName :: URLString -> Annex (Either String OsPath)-youtubeDlFileName url = withUrlOptions go+youtubeDlFileName url = withUrlOptions Nothing go   where 	go uo 		| supportedScheme uo url = flip catchIO (pure . Left . show) $@@ -238,7 +238,7 @@ -- Does not check if the url contains htmlOnly; use when that's already -- been verified. youtubeDlFileNameHtmlOnly :: URLString -> Annex (Either String OsPath)-youtubeDlFileNameHtmlOnly = withUrlOptions . youtubeDlFileNameHtmlOnly'+youtubeDlFileNameHtmlOnly = withUrlOptions Nothing . youtubeDlFileNameHtmlOnly'  youtubeDlFileNameHtmlOnly' :: URLString -> UrlOptions -> Annex (Either String OsPath) youtubeDlFileNameHtmlOnly' url uo
Assistant/Upgrade.hs view
@@ -324,7 +324,7 @@  downloadDistributionInfo :: Assistant (Maybe GitAnnexDistribution) downloadDistributionInfo = do-	uo <- liftAnnex Url.getUrlOptions+	uo <- liftAnnex $ Url.getUrlOptions Nothing 	gpgcmd <- liftAnnex $ gpgCmd <$> Annex.getGitConfig 	liftIO $ withTmpDir (literalOsPath "git-annex.tmp") $ \tmpdir -> do 		let infof = tmpdir </> literalOsPath "info"
Assistant/WebApp/Configurators/IA.hs view
@@ -179,7 +179,7 @@  getRepoInfo :: RemoteConfig -> Widget getRepoInfo c = do-	uo <- liftAnnex Url.getUrlOptions+	uo <- liftAnnex $ Url.getUrlOptions Nothing 	urlexists <- liftAnnex $ catchDefaultIO False $ Url.exists url uo 	[whamlet| <a href="#{url}">
CHANGELOG view
@@ -1,3 +1,26 @@+git-annex (10.20250416) upstream; urgency=medium++  * Added the mask special remote.+  * updatecluster, updateproxy: When a remote that has no annex-uuid is+    configured as annex-cluster-node, warn and avoid writing bad data to+    the git-annex branch.+  * Fix build without the assistant.+  * fsck: Avoid complaining about required content of dead repositories.+  * drop: Avoid redundant object directory thawing.+  * httpalso: Windows url fix.+  * Added remote.name.annex-web-options config, which is a per-remote+    version of the annex.web-options config.+  * migrate: Fix --remove-size to work when a file is not present.+    Fixes reversion introduced in version 10.20231129.+  * Support git remotes that use a IPV6 link-local address with a zone ID.+  * Support git remotes that use an url with a user name that is URL+    encoded, or in the case of an "scp-style" url, a user name that must be+    encoded to be legal in an URL.+  * Fix git-lfs special remote ssh endpoint discovery when the repository+    path is URL encoded.++ -- Joey Hess <id@joeyh.name>  Wed, 16 Apr 2025 13:34:40 -0400+ git-annex (10.20250320) upstream; urgency=medium    * Added the compute special remote.
CmdLine/GitRemoteAnnex.hs view
@@ -496,7 +496,7 @@ resolveSpecialRemoteWebUrl :: String -> Annex (Maybe String) resolveSpecialRemoteWebUrl url 	| "http://" `isPrefixOf` lcurl || "https://" `isPrefixOf` lcurl =-		Url.withUrlOptionsPromptingCreds $ \uo ->+		Url.withUrlOptionsPromptingCreds Nothing $ \uo -> 			withTmpFile (literalOsPath "git-remote-annex") $ \tmp h -> do 				liftIO $ hClose h 				Url.download' nullMeterUpdate Nothing url tmp uo >>= \case
Command/AddUrl.hs view
@@ -251,7 +251,7 @@ 	go url = startingAddUrl si urlstring o $ 		if relaxedOption (downloadOptions o) 			then go' url Url.assumeUrlExists-			else Url.withUrlOptions (Url.getUrlInfo urlstring) >>= \case+			else Url.withUrlOptions Nothing (Url.getUrlInfo urlstring) >>= \case 				Right urlinfo -> go' url urlinfo 				Left err -> do 					warning (UnquotedString err)@@ -352,7 +352,8 @@ 	go =<< downloadWith' downloader urlkey webUUID url file   where 	urlkey = addSizeUrlKey urlinfo $ Backend.URL.fromUrl url Nothing (verifiableOption o)-	downloader f p = Url.withUrlOptions $ downloadUrl False urlkey p Nothing [url] f+	downloader f p = Url.withUrlOptions Nothing $+		downloadUrl False urlkey p Nothing [url] f 	go Nothing = return Nothing 	go (Just (tmp, backend)) = ifM (useYoutubeDl o <&&> liftIO (isHtmlFile tmp)) 		( tryyoutubedl tmp backend
Command/Fsck.hs view
@@ -375,11 +375,13 @@ 	-- Can't be checked if there's no associated file. 	AssociatedFile Nothing -> return True 	AssociatedFile (Just _) -> do-		requiredlocs <- S.fromList . M.keys <$> requiredContentMap-		if S.null requiredlocs+		requiredlocs <- filterM notdead =<< (M.keys <$> requiredContentMap)+		if null requiredlocs 			then return True-			else go requiredlocs+			else go (S.fromList requiredlocs)   where+	notdead u = (/=) DeadTrusted <$> lookupTrust u+ 	go requiredlocs = do 		presentlocs <- S.fromList <$> loggedLocations key 		missinglocs <- filterM
Command/ImportFeed.hs view
@@ -268,7 +268,7 @@ downloadFeed :: URLString -> FilePath -> Annex Bool downloadFeed url f 	| Url.parseURIRelaxed url == Nothing = giveup "invalid feed url"-	| otherwise = Url.withUrlOptions $+	| otherwise = Url.withUrlOptions Nothing $ 		Url.download nullMeterUpdate Nothing url (toOsPath f)  startDownload :: AddUnlockedMatcher -> ImportFeedOptions -> Cache -> TMVar Bool -> ToDownload -> CommandStart@@ -367,7 +367,7 @@ 				let go urlinfo = Just . maybeToList <$> addUrlFile addunlockedmatcher dlopts url urlinfo f 				if relaxedOption (downloadOptions opts) 					then go Url.assumeUrlExists-					else Url.withUrlOptions (Url.getUrlInfo url) >>= \case+					else Url.withUrlOptions Nothing (Url.getUrlInfo url) >>= \case 						Right urlinfo -> go urlinfo 						Left err -> do 							warning (UnquotedString err)
Command/Migrate.hs view
@@ -90,7 +90,7 @@ 			newbackend <- chooseBackend file 			if (newbackend /= oldbackend || upgradableKey oldbackend || forced) && exists 				then go False oldbackend newbackend-				else if cantweaksize newbackend oldbackend && exists+				else if cantweaksize newbackend oldbackend exists 					then go True oldbackend newbackend 					else stop   where@@ -101,10 +101,10 @@ 		starting "migrate" (mkActionItem (key, file)) si $ 			perform onlytweaksize o file key keyrec oldbackend newbackend -	cantweaksize newbackend oldbackend+	cantweaksize newbackend oldbackend exists 		| removeSize o = isJust (fromKey keySize key) 		| newbackend /= oldbackend = False-		| isNothing (fromKey keySize key) = True+		| isNothing (fromKey keySize key) && exists = True 		| otherwise = False  	upgradableKey oldbackend = maybe False (\a -> a key) (canUpgradeKey oldbackend)
Command/UpdateCluster.hs view
@@ -38,7 +38,7 @@ 		Nothing -> return Nothing 		Just [] -> return Nothing 		Just clusternames -> -			ifM (Command.UpdateProxy.checkCanProxy r "Cannot use this special remote as a cluster node.")+			ifM (Command.UpdateProxy.checkCanProxy r "Cannot use this remote as a cluster node.") 				( return $ Just $ M.fromList $ 					zip clusternames (repeat (S.singleton r)) 				, return Nothing
Command/UpdateProxy.hs view
@@ -59,24 +59,32 @@ 	 	isproxy r 		| remoteAnnexProxy (R.gitconfig r) || not (null (remoteAnnexClusterNode (R.gitconfig r))) = -			checkCanProxy r "Cannot proxy to this special remote."+			checkCanProxy r "Cannot proxy to this remote." 		| otherwise = pure False  checkCanProxy :: Remote -> String -> Annex Bool-checkCanProxy r cannotmessage = -	ifM (R.isExportSupported r)-		( if annexObjects (R.config r)-			then pure True-			else do-				warnannexobjects-				pure False-		, pure True-		)+checkCanProxy r cannotmessage+	| R.uuid r == NoUUID = do+		warning $ UnquotedString $ unwords+			[ R.name r+			, "is a git remote without a known annex-uuid."+			, cannotmessage+			]+		pure False+	| otherwise =+		ifM (R.isExportSupported r)+			( if annexObjects (R.config r)+				then pure True+				else do+					warnannexobjects+					pure False+			, pure True+			)   where 	warnannexobjects = warning $ UnquotedString $ unwords 		[ R.name r-		, "is configured with exporttree=yes, but without"-		, "annexobjects=yes."+		, "is a special remote configured with exporttree=yes,"+		, "but without annexobjects=yes." 		, cannotmessage 		, "Suggest you run: git-annex enableremote" 		, R.name r
Git/Remote.hs view
@@ -103,9 +103,10 @@ 	urlstyle v = isURI (escapeURIString isUnescapedInURI v) 	-- git remotes can be written scp style -- [user@]host:dir 	-- but foo::bar is a git-remote-helper location instead+	-- (although '::' can also be part of an IPV6 address) 	scpstyle v = ":" `isInfixOf` v  		&& not ("//" `isInfixOf` v)-		&& not ("::" `isInfixOf` v)+		&& not ("::" `isInfixOf` (takeWhile (/= '[') v)) 	scptourl v = "ssh://" ++ host ++ slash dir 	  where 		(host, dir)
Git/Url.hs view
@@ -36,9 +36,14 @@ 		len  = length rest - 1 	fixup x = x -{- Hostname of an URL repo. -}+{- Hostname of an URL repo. + -+ - An IPV6 link-local address in an url can include a+ - scope, eg "%wlan0". The "%" is necessarily URI-encoded+ - as "%25" in the URI. So the hostname gets URI-decoded here.+ -} host :: Repo -> Maybe String-host = authpart uriRegName'+host = authpart (unEscapeString . uriRegName')  {- Port of an URL repo, if it has a nonstandard one. -} port :: Repo -> Maybe Integer@@ -49,11 +54,14 @@ 		Just (':':p) -> readish p 		Just _ -> Nothing -{- Hostname of an URL repo, including any username (ie, "user@host") -}+{- Hostname of an URL repo, including any username (ie, "user@host")+ -+ - Both the username and hostname are URI-decoded.+ -} hostuser :: Repo -> Maybe String hostuser r = (++)-	<$> authpart uriUserInfo r-	<*> authpart uriRegName' r+	<$> authpart (unEscapeString . uriUserInfo) r+	<*> host r  {- The full authority portion an URL repo. (ie, "user@host:port") -} authority :: Repo -> Maybe String@@ -66,7 +74,7 @@ authpart a Repo { location = Url u } = a <$> uriAuthority u authpart _ _ = Nothing -{- Path part of an URL repo. -}+{- Path part of an URL repo. It is URI-decoded. -} path :: Repo -> Maybe FilePath-path Repo { location = Url u } = Just (uriPath u)+path Repo { location = Url u } = Just $ unEscapeString $ uriPath u path _ = Nothing
P2P/Http/Client.hs view
@@ -100,7 +100,7 @@ 	case p2pHttpBaseUrl <$> remoteAnnexP2PHttpUrl (gitconfig rmt) of 		Nothing -> error "internal" 		Just baseurl -> do-			mgr <- httpManager <$> getUrlOptions+			mgr <- httpManager <$> getUrlOptions Nothing 			let clientenv = mkClientEnv mgr baseurl 			ccv <- Annex.getRead Annex.gitcredentialcache 			Git.CredentialCache cc <- liftIO $ atomically $
Remote/BitTorrent.hs view
@@ -66,7 +66,7 @@ 		, cost = cst 		, name = Git.repoDescribe r 		, storeKey = uploadKey-		, retrieveKeyFile = downloadKey+		, retrieveKeyFile = downloadKey gc 		-- Bittorrent downloads out of order, but downloadTorrentContent 		-- moves the downloaded file to the destination at the end. 		, retrieveKeyFileInOrder = pure True@@ -94,12 +94,12 @@ 		, mkUnavailable = return Nothing 		, getInfo = return [] 		, claimUrl = Just (pure . isSupportedUrl)-		, checkUrl = Just checkTorrentUrl+		, checkUrl = Just (checkTorrentUrl gc) 		, remoteStateHandle = rs 		} -downloadKey :: Key -> AssociatedFile -> OsPath -> MeterUpdate -> VerifyConfig -> Annex Verification-downloadKey key _file dest p _ = do+downloadKey :: RemoteGitConfig -> Key -> AssociatedFile -> OsPath -> MeterUpdate -> VerifyConfig -> Annex Verification+downloadKey gc key _file dest p _ = do 	get . map (torrentUrlNum . fst . getDownloader) =<< getBitTorrentUrls key 	-- While bittorrent verifies the hash in the torrent file, 	-- the torrent file itself is downloaded without verification,@@ -112,7 +112,7 @@ 		ok <- untilTrue urls $ \(u, filenum) -> do 			registerTorrentCleanup u 			checkDependencies-			ifM (downloadTorrentFile u)+			ifM (downloadTorrentFile gc u) 				( downloadTorrentContent key u dest filenum p 				, return False 				)@@ -151,11 +151,11 @@ 	checkbt (Just uri) | "xt=urn:btih:" `isInfixOf` uriQuery uri = True 	checkbt _ = False -checkTorrentUrl :: URLString -> Annex UrlContents-checkTorrentUrl u = do+checkTorrentUrl :: RemoteGitConfig -> URLString -> Annex UrlContents+checkTorrentUrl gc u = do 	checkDependencies 	registerTorrentCleanup u-	ifM (downloadTorrentFile u)+	ifM (downloadTorrentFile gc u) 		( torrentContents u 		, giveup "could not download torrent file" 		)@@ -192,8 +192,8 @@ 	liftIO . removeWhenExistsWith removeFile =<< tmpTorrentFile u  {- Downloads the torrent file. (Not its contents.) -}-downloadTorrentFile :: URLString -> Annex Bool-downloadTorrentFile u = do+downloadTorrentFile :: RemoteGitConfig -> URLString -> Annex Bool+downloadTorrentFile gc u = do 	torrent <- tmpTorrentFile u 	ifM (liftIO $ doesFileExist torrent) 		( return True@@ -213,7 +213,7 @@ 					withTmpFileIn othertmp (literalOsPath "torrent") $ \f h -> do 						liftIO $ hClose h 						resetAnnexFilePerm f-						ok <- Url.withUrlOptions $ +						ok <- Url.withUrlOptions (Just gc) $  							Url.download nullMeterUpdate Nothing u f 						when ok $ 							liftIO $ moveFile f torrent
Remote/External.hs view
@@ -77,9 +77,9 @@ 			exportUnsupported 		return $ Just $ specialRemote c 			readonlyStorer-			retrieveUrl+			(retrieveUrl gc) 			readonlyRemoveKey-			checkKeyUrl+			(checkKeyUrl gc) 			rmt 	| otherwise = do 		c <- parsedRemoteConfig remote rc@@ -834,16 +834,16 @@   where 	mkmulti (u, s, f) = (u, s, toOsPath f) -retrieveUrl :: Retriever-retrieveUrl = fileRetriever' $ \f k p iv -> do+retrieveUrl :: RemoteGitConfig -> Retriever+retrieveUrl gc = fileRetriever' $ \f k p iv -> do 	us <- getWebUrls k-	unlessM (withUrlOptions $ downloadUrl True k p iv us f) $+	unlessM (withUrlOptions (Just gc) $ downloadUrl True k p iv us f) $ 		giveup "failed to download content" -checkKeyUrl :: CheckPresent-checkKeyUrl k = do+checkKeyUrl :: RemoteGitConfig -> CheckPresent+checkKeyUrl gc k = do 	us <- getWebUrls k-	anyM (\u -> withUrlOptions $ checkBoth u (fromKey keySize k)) us+	anyM (\u -> withUrlOptions (Just gc) $ checkBoth u (fromKey keySize k)) us  getWebUrls :: Key -> Annex [URLString] getWebUrls key = filter supported <$> getUrls key
Remote/Git.hs view
@@ -142,11 +142,11 @@  - etc.  -} gitSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)-gitSetup Init mu _ c _ = do+gitSetup Init mu _ c gc = do 	let location = maybe (giveup "Specify location=url") fromProposedAccepted $ 		M.lookup locationField c 	r <- inRepo $ Git.Construct.fromRemoteLocation location False-	r' <- tryGitConfigRead False r False+	r' <- tryGitConfigRead gc False r False 	let u = getUncachedUUID r' 	if u == NoUUID 		then giveup "git repository does not have an annex uuid"@@ -187,10 +187,10 @@ 	case (repoCheap r, annexignore, hasuuid) of 		(_, True, _) -> return r 		(True, _, _)-			| remoteAnnexCheckUUID gc -> tryGitConfigRead autoinit r hasuuid+			| remoteAnnexCheckUUID gc -> tryGitConfigRead gc autoinit r hasuuid 			| otherwise -> return r 		(False, _, False) -> configSpecialGitRemotes r >>= \case-			Nothing -> tryGitConfigRead autoinit r False+			Nothing -> tryGitConfigRead gc autoinit r False 			Just r' -> return r' 		_ -> return r @@ -273,8 +273,8 @@  {- Tries to read the config for a specified remote, updates state, and  - returns the updated repo. -}-tryGitConfigRead :: Bool -> Git.Repo -> Bool -> Annex Git.Repo-tryGitConfigRead autoinit r hasuuid+tryGitConfigRead :: RemoteGitConfig -> Bool -> Git.Repo -> Bool -> Annex Git.Repo+tryGitConfigRead gc autoinit r hasuuid 	| haveconfig r = return r -- already read 	| Git.repoIsSsh r = storeUpdatedRemote $ do 		v <- Ssh.onRemote NoConsumeStdin r@@ -323,7 +323,7 @@ 				warning $ UnquotedString $ "Unable to parse git config from " ++ configloc 				return $ Left exitcode -	geturlconfig = Url.withUrlOptionsPromptingCreds $ \uo -> do+	geturlconfig = Url.withUrlOptionsPromptingCreds (Just gc) $ \uo -> do 		let url = Git.repoLocation r ++ "/config" 		v <- withTmpFile (literalOsPath "git-annex.tmp") $ \tmpfile h -> do 			liftIO $ hClose h@@ -449,7 +449,7 @@ 	checkp2phttp = p2pHttpClient rmt giveup (clientCheckPresent key) 	checkhttp = do 		gc <- Annex.getGitConfig-		Url.withUrlOptionsPromptingCreds $ \uo -> +		Url.withUrlOptionsPromptingCreds (Just (gitconfig rmt)) $ \uo ->  			anyM (\u -> Url.checkBoth u (fromKey keySize key) uo) 				(keyUrls gc repo rmt key) 	checkremote = P2PHelper.checkpresent (Ssh.runProto rmt connpool (cantCheck rmt)) key@@ -570,7 +570,7 @@ 	| isP2PHttp r = copyp2phttp 	| Git.repoIsHttp repo = verifyKeyContentIncrementally vc key $ \iv -> do 		gc <- Annex.getGitConfig-		ok <- Url.withUrlOptionsPromptingCreds $+		ok <- Url.withUrlOptionsPromptingCreds (Just (gitconfig r)) $ 			Annex.Content.downloadUrl False key meterupdate iv (keyUrls gc repo r key) dest 		unless ok $ 			giveup "failed to download content"@@ -890,7 +890,7 @@ 			rv <- liftIO newEmptyMVar 			let getrepo = ifM (liftIO $ isEmptyMVar rv) 				( do-					r' <- tryGitConfigRead False r True+					r' <- tryGitConfigRead gc False r True 					let t = (r', extractGitConfig FromGitConfig r') 					void $ liftIO $ tryPutMVar rv t 					return t
Remote/GitLFS.hs view
@@ -101,7 +101,7 @@ 		} 	return $ Just $ specialRemote' specialcfg c 		(store rs h)-		(retrieve rs h)+		(retrieve gc rs h) 		(remove h) 		(checkKey rs h) 		(this c cst h)@@ -367,7 +367,7 @@ -- Not for use in downloading an object. makeSmallAPIRequest :: Request -> Annex (Response L.ByteString) makeSmallAPIRequest req = do-	uo <- getUrlOptions+	uo <- getUrlOptions Nothing 	let req' = applyRequest uo req 	fastDebug "Remote.GitLFS" (show req') 	resp <- liftIO $ httpLbs req' (httpManager uo)@@ -499,8 +499,8 @@ 					Just reqs -> forM_ reqs $ 						makeSmallAPIRequest . setRequestCheckStatus -retrieve :: RemoteStateHandle -> TVar LFSHandle -> Retriever-retrieve rs h = fileRetriever' $ \dest k p iv -> getLFSEndpoint LFS.RequestDownload h >>= \case+retrieve :: RemoteGitConfig -> RemoteStateHandle -> TVar LFSHandle -> Retriever+retrieve gc rs h = fileRetriever' $ \dest k p iv -> getLFSEndpoint LFS.RequestDownload h >>= \case 	Nothing -> giveup "unable to connect to git-lfs endpoint" 	Just endpoint -> mkDownloadRequest rs k >>= \case 		Nothing -> giveup "unable to download this object from git-lfs"@@ -520,7 +520,7 @@ 			Just op -> case LFS.downloadOperationRequest op of 				Nothing -> giveup "unable to parse git-lfs server download url" 				Just req -> do-					uo <- getUrlOptions+					uo <- getUrlOptions (Just gc) 					liftIO $ downloadConduit p iv req dest uo  -- Since git-lfs does not support removing content, nothing needs to be
Remote/Helper/Encryptable.hs view
@@ -8,7 +8,7 @@ {-# LANGUAGE FlexibleContexts, ScopedTypeVariables, PackageImports #-}  module Remote.Helper.Encryptable (-	EncryptionIsSetup,+	EncryptionIsSetup(..), 	encryptionSetup, 	noEncryptionUsed, 	encryptionAlreadySetup,
Remote/HttpAlso.hs view
@@ -1,6 +1,6 @@ {- HttpAlso remote (readonly).  -- - Copyright 2020-2023 Joey Hess <id@joeyh.name>+ - Copyright 2020-2025 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -24,6 +24,7 @@ import Annex.Verify import qualified Annex.Url as Url import Annex.SpecialRemote.Config+import Git.FilePath  import Data.Either import qualified Data.Map as M@@ -56,9 +57,9 @@ 	ll <- liftIO newLearnedLayout 	return $ Just $ specialRemote c 		cannotModify-		(downloadKey url ll)+		(downloadKey gc url ll) 		cannotModify-		(checkKey url ll)+		(checkKey gc url ll) 		(this url c cst)   where 	this url c cst = Remote@@ -78,9 +79,9 @@ 		, checkPresentCheap = False 		, exportActions = ExportActions 			{ storeExport = cannotModify-			, retrieveExport = retriveExportHttpAlso url+			, retrieveExport = retriveExportHttpAlso gc url 			, removeExport = cannotModify-			, checkPresentExport = checkPresentExportHttpAlso url+			, checkPresentExport = checkPresentExportHttpAlso gc url 			, removeExportDirectory = Nothing 			, renameExport = cannotModify 			}@@ -120,34 +121,35 @@ 	gitConfigSpecialRemote u c' [("httpalso", "true")] 	return (c', u) -downloadKey :: Maybe URLString -> LearnedLayout -> Retriever-downloadKey baseurl ll = fileRetriever' $ \dest key p iv ->-	downloadAction dest p iv (keyUrlAction baseurl ll key)+downloadKey :: RemoteGitConfig -> Maybe URLString -> LearnedLayout -> Retriever+downloadKey gc baseurl ll = fileRetriever' $ \dest key p iv ->+	downloadAction gc dest p iv (keyUrlAction baseurl ll key) -retriveExportHttpAlso :: Maybe URLString -> Key -> ExportLocation -> OsPath -> MeterUpdate -> Annex Verification-retriveExportHttpAlso baseurl key loc dest p = do+retriveExportHttpAlso :: RemoteGitConfig -> Maybe URLString -> Key -> ExportLocation -> OsPath -> MeterUpdate -> Annex Verification+retriveExportHttpAlso gc baseurl key loc dest p = do 	verifyKeyContentIncrementally AlwaysVerify key $ \iv ->-		downloadAction dest p iv (exportLocationUrlAction baseurl loc)+		downloadAction gc dest p iv (exportLocationUrlAction baseurl loc) -downloadAction :: OsPath -> MeterUpdate -> Maybe IncrementalVerifier -> ((URLString -> Annex (Either String ())) -> Annex (Either String ())) -> Annex ()-downloadAction dest p iv run =-	Url.withUrlOptions $ \uo ->+downloadAction :: RemoteGitConfig -> OsPath -> MeterUpdate -> Maybe IncrementalVerifier -> ((URLString -> Annex (Either String ())) -> Annex (Either String ())) -> Annex ()+downloadAction gc dest p iv run =+	Url.withUrlOptions (Just gc) $ \uo -> 		run (\url -> Url.download' p iv url dest uo) 			>>= either giveup (const (return ())) -checkKey :: Maybe URLString -> LearnedLayout -> CheckPresent-checkKey baseurl ll key =-	isRight <$> keyUrlAction baseurl ll key (checkKey' key)+checkKey :: RemoteGitConfig -> Maybe URLString -> LearnedLayout -> CheckPresent+checkKey gc baseurl ll key =+	isRight <$> keyUrlAction baseurl ll key (checkKey' gc key) -checkKey' :: Key -> URLString -> Annex (Either String ())-checkKey' key url = ifM (Url.withUrlOptions $ Url.checkBoth url (fromKey keySize key))-	( return (Right ())-	, return (Left "content not found")-	)+checkKey' :: RemoteGitConfig -> Key -> URLString -> Annex (Either String ())+checkKey' gc key url = +	ifM (Url.withUrlOptions (Just gc) $ Url.checkBoth url (fromKey keySize key))+		( return (Right ())+		, return (Left "content not found")+		) -checkPresentExportHttpAlso :: Maybe URLString -> Key -> ExportLocation -> Annex Bool-checkPresentExportHttpAlso baseurl key loc =-	isRight <$> exportLocationUrlAction baseurl loc (checkKey' key)+checkPresentExportHttpAlso :: RemoteGitConfig -> Maybe URLString -> Key -> ExportLocation -> Annex Bool+checkPresentExportHttpAlso gc baseurl key loc =+	isRight <$> exportLocationUrlAction baseurl loc (checkKey' gc key)  type LearnedLayout = TVar (Maybe [Key -> URLString]) @@ -228,5 +230,10 @@ 	  ] 	]   where-	mkurl k hasher = baseurl P.</> fromOsPath (hasher k) P.</> kf k+	mkurl k hasher = baseurl+		-- On windows, the hasher uses `\` path separators,+		-- but for an url, it needs to use '/'.+		-- So, use toInternalGitPath.+		P.</> fromOsPath (toInternalGitPath (hasher k)) +		P.</> kf k 	kf k = fromOsPath (keyFile k)
Remote/List.hs view
@@ -41,6 +41,7 @@ import qualified Remote.Hook import qualified Remote.External import qualified Remote.Compute+import qualified Remote.Mask  remoteTypes :: [RemoteType] remoteTypes = map adjustExportImportRemoteType@@ -65,6 +66,7 @@ 	, Remote.Hook.remote 	, Remote.External.remote 	, Remote.Compute.remote+	, Remote.Mask.remote 	]  {- Builds a list of all Remotes.
+ Remote/Mask.hs view
@@ -0,0 +1,257 @@+{- Mask another remote with added encryption+ -+ - Copyright 2025 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++{-# LANGUAGE RankNTypes #-}++module Remote.Mask (remote) where++import Annex.Common+import Types.Remote+import Types.Creds+import Types.Crypto+import qualified Git+import qualified Annex+import Remote.Helper.Special+import Remote.Helper.ExportImport+import Config+import Config.Cost+import Annex.UUID+import Types.ProposedAccepted+import Annex.SpecialRemote.Config+import Logs.UUID+import Utility.Metered+import qualified Remote.Git++import Control.Concurrent.STM+import qualified Data.Map as M++remote :: RemoteType+remote = specialRemoteType $ RemoteType+	{ typename = "mask"+	, enumerate = const (findSpecialRemotes "mask")+	, generate = gen+	, configParser = mkRemoteConfigParser+		[ optionalStringParser remoteField+			(FieldDesc "remote to mask")+		]+	, setup = maskSetup+	, exportSupported = exportUnsupported+	, importSupported = importUnsupported+	, thirdPartyPopulated = False+	}++gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)+gen r u rc gc rs = do+	maskedremote <- mkMaskedRemote rc gc u+	c <- parsedRemoteConfig remote rc+	cst <- remoteCost gc c $ encryptedRemoteCostAdj + semiExpensiveRemoteCost+	let this = Remote+		{ uuid = u+		, cost = cst+		, name = Git.repoDescribe r+		, storeKey = storeKeyDummy+		, retrieveKeyFile = retrieveKeyFileDummy+		, retrieveKeyFileInOrder = pure True+		, retrieveKeyFileCheap = Nothing+		, retrievalSecurityPolicy = RetrievalVerifiableKeysSecure+		, removeKey = removeKeyDummy+		, lockContent = Nothing+		, checkPresent = checkPresentDummy+		, checkPresentCheap = False+		, exportActions = exportUnsupported+		, importActions = importUnsupported+		, whereisKey = Nothing+		, remoteFsck = Nothing+		, repairRepo = Nothing+		, config = c+		, getRepo = return r+		, gitconfig = gc+		, localpath = Nothing+		, remotetype = remote+		, availability = pure LocallyAvailable+		, readonly = False+		, appendonly = False+		, untrustworthy = False+		, mkUnavailable = return Nothing+		, getInfo = getInfo =<< getMaskedRemote maskedremote+		, claimUrl = Nothing+		, checkUrl = Nothing+		, remoteStateHandle = rs+		}+	return $ Just $ specialRemote c+		(store maskedremote)+		(retrieve maskedremote)+		(remove maskedremote)+		(checkKey maskedremote)+		this++maskSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)+maskSetup setupstage mu _ c gc = do+	remotelist <- Annex.getState Annex.remotes+	let findnamed maskremotename =+		case filter (\r -> name r == maskremotename) remotelist of+			(r:_) -> return r+			[] -> giveup $ "There is no remote named \"" ++ maskremotename ++ "\""+	case setupstage of+		Init -> do+			maskremotename <- maybe+				(giveup "Specify remote=")+				(pure . fromProposedAccepted)+				(M.lookup remoteField c)+			setupremote =<< findnamed maskremotename+		_ -> case M.lookup remoteField c of+			-- enableremote with remote= overrides the remote+			-- name that was used with initremote.+			Just (Proposed maskremotename) -> do+				r <- findnamed maskremotename+				unless (uuid r == maskremoteuuid) $+					giveup $ "Remote \"" ++ maskremotename ++ "\" does not have the expected uuid (" ++ fromUUID maskremoteuuid ++ ")" +				setupremote r+			_ -> enableremote remotelist+  where+	setupremote r = do+		let c' = M.insert remoteUUIDField+			(Proposed (fromUUID (uuid r) :: String)) c+		(c'', encsetup) <- encryptionSetup c' gc+		verifyencryptionok encsetup r+		+		u <- maybe (liftIO genUUID) return mu+		gitConfigSpecialRemote u c'' [ ("mask", name r) ]+		return (c'', u)+		+	maskremoteuuid = fromMaybe NoUUID $ +		toUUID . fromProposedAccepted+			<$> M.lookup remoteUUIDField c+				+	enableremote remotelist = do+		case filter (\r -> uuid r == maskremoteuuid) remotelist of+			(r:_) -> setupremote r+			[] -> case setupstage of+				Enable _ ->+					missingMaskedRemote maskremoteuuid+				-- When autoenabling, the masked remote may+				-- get autoenabled later, or need to be+				-- manually enabled.+				_ -> do+					(c', _) <- encryptionSetup c gc+					u <- maybe (liftIO genUUID) return mu+					gitConfigSpecialRemote u c' [ ("mask", "true") ]+					return (c', u)++	verifyencryptionok NoEncryption _ =+		giveup "Must use encryption with a mask special remote."+	verifyencryptionok EncryptionIsSetup r+		| remotetype r == Remote.Git.remote =+			verifyencryptionokgit+		| otherwise = noop+	+	verifyencryptionokgit = case parseEncryptionMethod c of+		Right SharedEncryption ->+			giveup "It's not secure to use encryption=shared with a git remote."+		_ -> noop++newtype MaskedRemote = MaskedRemote { getMaskedRemote :: Annex Remote }++-- findMaskedRemote won't work until the remote list has been populated,+-- so has to be done on the fly rather than at generation time.+-- This caches it for speed.+mkMaskedRemote :: RemoteConfig -> RemoteGitConfig -> UUID -> Annex MaskedRemote+mkMaskedRemote c gc u = do+	v <- liftIO $ newTMVarIO Nothing+	return $ MaskedRemote $ +		liftIO (atomically (takeTMVar v)) >>= \case+			Just maskedremote -> return maskedremote+			Nothing -> do+				maskedremote <- findMaskedRemote c gc u+				liftIO $ atomically $ putTMVar v (Just maskedremote)+				return maskedremote++findMaskedRemote :: RemoteConfig -> RemoteGitConfig -> UUID -> Annex Remote+findMaskedRemote c gc myuuid = case remoteAnnexMask gc of+	-- This remote was autoenabled, so use any remote with the+	-- uuid of the masked remote, so that it can also be autoenabled.+	Just "true" -> +		case getmaskedremoteuuid of+			Just maskremoteuuid -> +				selectremote maskremoteuuid $ \r ->+					uuid r == maskremoteuuid+			Nothing -> missingMaskedRemote NoUUID+	Just maskremotename ->+		selectremote (fromMaybe NoUUID getmaskedremoteuuid) $ \r -> +			name r == maskremotename +				&& Just (uuid r) == getmaskedremoteuuid+	Nothing -> missingMaskedRemote NoUUID+  where+	getmaskedremoteuuid = toUUID . fromProposedAccepted+		<$> M.lookup remoteUUIDField c+	selectremote u f = do+		remotelist <- Annex.getState Annex.remotes+		case filter f remotelist of+			(r:_)+				| uuid r == myuuid -> giveup "Mask special remote is configured to mask itself. This is not a valid configuration."+				-- Avoid cycles, and there is no benefit+				-- to masking a mask special remote.+				| remotetype r == remote -> giveup "Mask special remote is configured to mask another mask special remote. This is not supported."+				| otherwise -> return r+			[] -> missingMaskedRemote u++missingMaskedRemote :: UUID -> Annex a+missingMaskedRemote maskremoteuuid = do+	descmap <- uuidDescMap+	let desc = case M.lookup maskremoteuuid descmap of+		Just (UUIDDesc d) -> decodeBS d+		Nothing -> ""+	giveup $ unlines+		[ "Before this mask special remote can be used, you must set up the remote it uses:"+		, "  " ++ fromUUID maskremoteuuid ++ " -- " ++ desc+		]++store :: MaskedRemote -> Storer+store maskedremote k src p = do+	r <- getMaskedRemote maskedremote +	storeMasked r k src p++storeMasked :: Remote -> Storer+storeMasked maskedremote = +	fileStorer $ \k f p -> storeKey maskedremote k af (Just f) p+  where+	af = AssociatedFile Nothing++retrieve :: MaskedRemote -> Retriever+retrieve maskedremote k p dest iv callback = do+	r <- getMaskedRemote maskedremote +	fileRetriever (retrieveMasked r) k p dest iv callback++retrieveMasked :: Remote -> OsPath -> Key -> MeterUpdate -> Annex ()+retrieveMasked maskedremote dest k p = +	-- The masked remote does not need to verify, because fileRetriever+	-- does its own verification.+	void $ retrieveKeyFile maskedremote k af dest p NoVerify+  where+	af = AssociatedFile Nothing++remove :: MaskedRemote -> Remover+remove maskedremote proof k = do+	r <- getMaskedRemote maskedremote +	removeMasked r proof k++removeMasked :: Remote -> Remover+removeMasked maskedremote = removeKey maskedremote++checkKey :: MaskedRemote -> CheckPresent+checkKey maskedremote k = do+	r <- getMaskedRemote maskedremote +	checkKeyMasked r k++checkKeyMasked :: Remote -> CheckPresent+checkKeyMasked maskedremote = checkPresent maskedremote++remoteField :: RemoteConfigField+remoteField = Accepted "remote"++remoteUUIDField :: RemoteConfigField+remoteUUIDField = Accepted "remoteuuid"
Remote/S3.hs view
@@ -427,7 +427,7 @@ 			Left failreason -> do 				warning (UnquotedString failreason) 				giveup "cannot download content"-			Right us -> unlessM (withUrlOptions $ downloadUrl False k p iv us f) $+			Right us -> unlessM (withUrlOptions Nothing $ downloadUrl False k p iv us f) $ 				giveup "failed to download content" 	Left S3HandleAnonymousOldAws -> giveupS3HandleProblem S3HandleAnonymousOldAws (uuid r) @@ -475,7 +475,7 @@ 				warning (UnquotedString failreason) 				giveup "cannot check content" 			Right us -> do-				let check u = withUrlOptions $ +				let check u = withUrlOptions Nothing $  					Url.checkBoth u (fromKey keySize k) 				anyM check us 	Left S3HandleAnonymousOldAws -> giveupS3HandleProblem S3HandleAnonymousOldAws (uuid r)@@ -516,7 +516,7 @@ 		Right h -> retrieveHelper info h (Left (T.pack exportloc)) f p iv 		Left S3HandleNeedCreds -> case getPublicUrlMaker info of 			Just geturl -> either giveup return =<<-				Url.withUrlOptions+				withUrlOptions Nothing 					(Url.download' p iv (geturl exportloc) f) 			Nothing -> giveup $ needS3Creds (uuid r) 		Left S3HandleAnonymousOldAws -> giveupS3HandleProblem S3HandleAnonymousOldAws (uuid r)@@ -537,7 +537,7 @@ checkPresentExportS3 hv r info k loc = withS3Handle hv $ \case 	Right h -> checkKeyHelper info h (Left (T.pack $ bucketExportLocation info loc)) 	Left S3HandleNeedCreds -> case getPublicUrlMaker info of-		Just geturl -> withUrlOptions $+		Just geturl -> withUrlOptions Nothing $ 			Url.checkBoth (geturl $ bucketExportLocation info loc) (fromKey keySize k) 		Nothing -> giveupS3HandleProblem S3HandleNeedCreds (uuid r) 	Left S3HandleAnonymousOldAws -> giveupS3HandleProblem S3HandleAnonymousOldAws (uuid r)@@ -913,7 +913,7 @@ 				Nothing -> return (Left S3HandleNeedCreds)   where 	go awscreds = do-		ou <- getUrlOptions+		ou <- getUrlOptions Nothing 		ua <- getUserAgent 		let awscfg = AWS.Configuration AWS.Timestamp awscreds debugMapper Nothing 		let s3cfg = s3Configuration (Just ua) c
Remote/Web.hs view
@@ -75,7 +75,7 @@ 		, cost = cst 		, name = Git.repoDescribe r 		, storeKey = uploadKey-		, retrieveKeyFile = downloadKey urlincludeexclude+		, retrieveKeyFile = downloadKey gc urlincludeexclude 		, retrieveKeyFileInOrder = pure True 		, retrieveKeyFileCheap = Nothing 		-- HttpManagerRestricted is used here, so this is@@ -83,7 +83,7 @@ 		, retrievalSecurityPolicy = RetrievalAllKeysSecure 		, removeKey = dropKey urlincludeexclude 		, lockContent = Nothing-		, checkPresent = checkKey urlincludeexclude+		, checkPresent = checkKey gc urlincludeexclude 		, checkPresentCheap = False 		, exportActions = exportUnsupported 		, importActions = importUnsupported@@ -115,8 +115,8 @@ 	gitConfigSpecialRemote u c [("web", "true")] 	return (c, u) -downloadKey :: UrlIncludeExclude -> Key -> AssociatedFile -> OsPath -> MeterUpdate -> VerifyConfig -> Annex Verification-downloadKey urlincludeexclude key _af dest p vc = +downloadKey :: RemoteGitConfig -> UrlIncludeExclude -> Key -> AssociatedFile -> OsPath -> MeterUpdate -> VerifyConfig -> Annex Verification+downloadKey gc urlincludeexclude key _af dest p vc =  	go =<< getWebUrls' urlincludeexclude key   where 	go [] = giveup "no known url"@@ -138,7 +138,7 @@ 			) 	dl (us, ytus) = do 		iv <- startVerifyKeyContentIncrementally vc key-		ifM (Url.withUrlOptions $ downloadUrl True key p iv (map fst us) dest)+		ifM (Url.withUrlOptions (Just gc) $ downloadUrl True key p iv (map fst us) dest) 			( finishVerifyKeyContentIncrementally iv >>= \case 				(True, v) -> postdl v 				(False, _) -> dl ([], ytus)@@ -177,19 +177,21 @@ dropKey :: UrlIncludeExclude -> Maybe SafeDropProof -> Key -> Annex () dropKey urlincludeexclude _proof k = mapM_ (setUrlMissing k) =<< getWebUrls' urlincludeexclude k -checkKey :: UrlIncludeExclude -> Key -> Annex Bool-checkKey urlincludeexclude key = do+checkKey :: RemoteGitConfig -> UrlIncludeExclude -> Key -> Annex Bool+checkKey gc urlincludeexclude key = do 	us <- getWebUrls' urlincludeexclude key 	if null us 		then return False-		else either giveup return =<< checkKey' key us-checkKey' :: Key -> [URLString] -> Annex (Either String Bool)-checkKey' key us = firsthit us (Right False) $ \u -> do+		else either giveup return =<< checkKey' gc key us++checkKey' :: RemoteGitConfig -> Key -> [URLString] -> Annex (Either String Bool)+checkKey' gc key us = firsthit us (Right False) $ \u -> do 	let (u', downloader) = getDownloader u 	case downloader of 		YoutubeDownloader -> youtubeDlCheck u' 		_ -> catchMsgIO $-			Url.withUrlOptions $ Url.checkBoth u' (fromKey keySize key)+			Url.withUrlOptions (Just gc) $+				Url.checkBoth u' (fromKey keySize key)   where 	firsthit [] miss _ = return miss 	firsthit (u:rest) _ a = do
Types/GitConfig.hs view
@@ -404,6 +404,7 @@ 	, remoteAnnexBwLimitUpload :: Maybe BwRate 	, remoteAnnexBwLimitDownload :: Maybe BwRate 	, remoteAnnexAllowUnverifiedDownloads :: Bool+	, remoteAnnexWebOptions :: [String] 	, remoteAnnexUUID :: Maybe UUID 	, remoteAnnexConfigUUID :: Maybe UUID 	, remoteAnnexMaxGitBundles :: Int@@ -440,6 +441,7 @@ 	, remoteAnnexDdarRepo :: Maybe String 	, remoteAnnexHookType :: Maybe String 	, remoteAnnexExternalType :: Maybe String+	, remoteAnnexMask :: Maybe String 	}  {- The Git.Repo is the local repository, which has the remote with the@@ -492,6 +494,7 @@ 			readBwRatePerSecond =<< getmaybe BWLimitDownloadField 		, remoteAnnexAllowUnverifiedDownloads = (== Just "ACKTHPPT") $ 			getmaybe SecurityAllowUnverifiedDownloadsField+		, remoteAnnexWebOptions = getwords WebOptionsField 		, remoteAnnexUUID = toUUID <$> getmaybe UUIDField 		, remoteAnnexConfigUUID = toUUID <$> getmaybe ConfigUUIDField 		, remoteAnnexMaxGitBundles =@@ -539,6 +542,7 @@ 		, remoteAnnexDdarRepo = getmaybe DdarRepoField 		, remoteAnnexHookType = notempty $ getmaybe HookTypeField 		, remoteAnnexExternalType = notempty $ getmaybe ExternalTypeField+		, remoteAnnexMask = notempty $ getmaybe MaskField 		}   where 	getbool k d = fromMaybe d $ getmaybebool k@@ -556,6 +560,7 @@ 			| B.null b -> Nothing 			| otherwise -> Just (decodeBS b) 		_ -> Nothing+	getwords k = fromMaybe [] $ words <$> getmaybe k  data RemoteGitConfigField 	= CostField@@ -588,6 +593,7 @@ 	| UUIDField 	| ConfigUUIDField 	| SecurityAllowUnverifiedDownloadsField+	| WebOptionsField 	| MaxGitBundlesField 	| AllowEncryptedGitRepoField 	| ProxyField@@ -619,6 +625,7 @@ 	| DdarRepoField 	| HookTypeField 	| ExternalTypeField+	| MaskField 	deriving (Enum, Bounded)  remoteGitConfigField :: RemoteGitConfigField -> (MkRemoteConfigKey, ProxyInherited)@@ -656,6 +663,7 @@ 	UUIDField -> uninherited True "uuid" 	ConfigUUIDField -> uninherited True "config-uuid" 	SecurityAllowUnverifiedDownloadsField -> inherited True "security-allow-unverified-downloads"+	WebOptionsField -> inherited True "web-options" 	MaxGitBundlesField -> inherited True "max-git-bundles" 	AllowEncryptedGitRepoField -> inherited True "allow-encrypted-gitrepo" 	-- Allow proxy chains.@@ -688,6 +696,7 @@ 	DdarRepoField -> uninherited True "ddarrepo" 	HookTypeField -> uninherited True "hooktype" 	ExternalTypeField -> uninherited True "externaltype"+	MaskField -> uninherited True "mask"   where 	inherited True f = (MkRemoteAnnexConfigKey f, ProxyInherited True) 	inherited False f = (MkRemoteConfigKey f, ProxyInherited True)
Types/Remote.hs view
@@ -89,6 +89,8 @@ 	-- Remotes have a use cost; higher is more expensive 	, cost :: Cost 	-- Transfers a key's contents from disk to the remote.+	-- The optional OsPath is the location of the key's object file.+	-- When not provided, uses the annex object file. 	-- The key should not appear to be present on the remote until 	-- all of its contents have been transferred. 	-- Throws exception on failure.
Utility/DirWatcher.hs view
@@ -139,7 +139,7 @@ 	runstartup $ Win32Notify.watchDir dir prune scanevents hooks #else type DirWatcherHandle = ()-watchDir :: FilePath -> Pruner -> Bool -> WatchHooks -> (IO () -> IO ()) -> IO DirWatcherHandle+watchDir :: OsPath -> Pruner -> Bool -> WatchHooks -> (IO () -> IO ()) -> IO DirWatcherHandle watchDir = error "watchDir not defined" #endif #endif
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 10.20250320+Version: 10.20250416 Cabal-Version: 1.12 License: AGPL-3 Maintainer: Joey Hess <id@joeyh.name>@@ -964,6 +964,7 @@     Remote.Hook     Remote.List     Remote.List.Util+    Remote.Mask     Remote.P2P     Remote.Rclone     Remote.Rsync
stack.yaml view
@@ -14,11 +14,8 @@     ospath: true packages: - '.'-resolver: nightly-2025-01-20+resolver: nightly-2025-04-04 extra-deps:-- filepath-bytestring-1.5.2.0.2-- aws-0.24.4-- git-lfs-1.2.5 - feed-1.3.2.1 allow-newer: true allow-newer-deps: