diff --git a/Annex/Import.hs b/Annex/Import.hs --- a/Annex/Import.hs +++ b/Annex/Import.hs @@ -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. - diff --git a/Annex/Perms.hs b/Annex/Perms.hs --- a/Annex/Perms.hs +++ b/Annex/Perms.hs @@ -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 diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,27 @@ +git-annex (10.20250102) upstream; urgency=medium + + * Added config `url..annexInsteadOf` corresponding to git's + `url..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 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 diff --git a/COPYRIGHT b/COPYRIGHT --- a/COPYRIGHT +++ b/COPYRIGHT @@ -2,7 +2,7 @@ Source: native package Files: * -Copyright: © 2010-2024 Joey Hess +Copyright: © 2010-2025 Joey Hess License: AGPL-3+ Files: Assistant/WebApp.hs Assistant/WebApp/* templates/* static/* @@ -20,7 +20,7 @@ Files: Command/Sync.hs Copyright: © Joachim Breitner - © 2011-2020 Joey Hess + © 2011-2024 Joey Hess License: AGPL-3+ Files: Command/List.hs @@ -43,7 +43,7 @@ License: AGPL-3+ Files: Utility/* -Copyright: 2012-2022 Joey Hess +Copyright: 2012-2025 Joey Hess License: BSD-2-clause Files: doc/logo* */favicon.ico standalone/osx/git-annex.app/Contents/Resources/git-annex.icns diff --git a/Command/Import.hs b/Command/Import.hs --- a/Command/Import.hs +++ b/Command/Import.hs @@ -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) diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs --- a/Command/ImportFeed.hs +++ b/Command/ImportFeed.hs @@ -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 diff --git a/Command/Sync.hs b/Command/Sync.hs --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -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 diff --git a/Database/ContentIdentifier.hs b/Database/ContentIdentifier.hs --- a/Database/ContentIdentifier.hs +++ b/Database/ContentIdentifier.hs @@ -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, diff --git a/Database/Export.hs b/Database/Export.hs --- a/Database/Export.hs +++ b/Database/Export.hs @@ -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, diff --git a/Database/Fsck.hs b/Database/Fsck.hs --- a/Database/Fsck.hs +++ b/Database/Fsck.hs @@ -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, diff --git a/Database/ImportFeed.hs b/Database/ImportFeed.hs --- a/Database/ImportFeed.hs +++ b/Database/ImportFeed.hs @@ -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, diff --git a/Database/Keys/SQL.hs b/Database/Keys/SQL.hs --- a/Database/Keys/SQL.hs +++ b/Database/Keys/SQL.hs @@ -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 diff --git a/Database/RepoSize.hs b/Database/RepoSize.hs --- a/Database/RepoSize.hs +++ b/Database/RepoSize.hs @@ -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, diff --git a/Git/HashObject.hs b/Git/HashObject.hs --- a/Git/HashObject.hs +++ b/Git/HashObject.hs @@ -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, diff --git a/Git/Remote.hs b/Git/Remote.hs --- a/Git/Remote.hs +++ b/Git/Remote.hs @@ -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." diff --git a/Git/Types.hs b/Git/Types.hs --- a/Git/Types.hs +++ b/Git/Types.hs @@ -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) diff --git a/Messages/JSON.hs b/Messages/JSON.hs --- a/Messages/JSON.hs +++ b/Messages/JSON.hs @@ -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 diff --git a/Remote/Git.hs b/Remote/Git.hs --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -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" diff --git a/Remote/S3.hs b/Remote/S3.hs --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -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 diff --git a/Test/Framework.hs b/Test/Framework.hs --- a/Test/Framework.hs +++ b/Test/Framework.hs @@ -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 = diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs --- a/Types/GitConfig.hs +++ b/Types/GitConfig.hs @@ -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 diff --git a/Utility/Aeson.hs b/Utility/Aeson.hs --- a/Utility/Aeson.hs +++ b/Utility/Aeson.hs @@ -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. diff --git a/Utility/MonotonicClock.hs b/Utility/MonotonicClock.hs --- a/Utility/MonotonicClock.hs +++ b/Utility/MonotonicClock.hs @@ -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 diff --git a/Utility/Process.hs b/Utility/Process.hs --- a/Utility/Process.hs +++ b/Utility/Process.hs @@ -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 diff --git a/Utility/TList.hs b/Utility/TList.hs --- a/Utility/TList.hs +++ b/Utility/TList.hs @@ -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) diff --git a/Utility/TimeStamp.hs b/Utility/TimeStamp.hs --- a/Utility/TimeStamp.hs +++ b/Utility/TimeStamp.hs @@ -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 diff --git a/Utility/Tor.hs b/Utility/Tor.hs --- a/Utility/Tor.hs +++ b/Utility/Tor.hs @@ -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) diff --git a/git-annex.cabal b/git-annex.cabal --- a/git-annex.cabal +++ b/git-annex.cabal @@ -1,11 +1,11 @@ Name: git-annex -Version: 10.20241202 +Version: 10.20250102 Cabal-Version: 1.12 License: AGPL-3 Maintainer: Joey Hess 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 diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -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