git-annex 8.20211231 → 10.20220127
raw patch · 58 files changed
+768/−282 lines, 58 files
Files
- Annex.hs +2/−0
- Annex/Content.hs +155/−50
- Annex/Content/Presence.hs +58/−9
- Annex/Init.hs +1/−1
- Annex/Locations.hs +22/−1
- Annex/Perms.hs +47/−19
- Annex/SpecialRemote.hs +12/−6
- Annex/Version.hs +23/−11
- Assistant/MakeRemote.hs +6/−6
- CHANGELOG +33/−0
- COPYRIGHT +1/−1
- CmdLine/Batch.hs +8/−2
- Command/Add.hs +2/−1
- Command/AddUrl.hs +3/−3
- Command/Copy.hs +2/−1
- Command/Drop.hs +2/−1
- Command/DropKey.hs +4/−4
- Command/EnableRemote.hs +13/−6
- Command/Export.hs +19/−7
- Command/Find.hs +2/−1
- Command/FromKey.hs +2/−1
- Command/Fsck.hs +0/−36
- Command/Get.hs +2/−1
- Command/Info.hs +2/−1
- Command/InitRemote.hs +1/−1
- Command/MetaData.hs +3/−2
- Command/Migrate.hs +1/−1
- Command/Move.hs +2/−1
- Command/ReKey.hs +3/−2
- Command/RegisterUrl.hs +1/−1
- Command/RenameRemote.hs +6/−5
- Command/RmUrl.hs +2/−1
- Command/SetPresentKey.hs +4/−3
- Command/Version.hs +1/−1
- Command/Whereis.hs +2/−1
- Config/Smudge.hs +8/−1
- Database/Keys.hs +17/−4
- Logs/Upgrade.hs +52/−0
- NEWS +7/−0
- P2P/Annex.hs +4/−2
- README +5/−4
- Remote/Adb.hs +20/−7
- Remote/Git.hs +7/−2
- Remote/Helper/Ssh.hs +9/−40
- Types/Upgrade.hs +10/−0
- Upgrade.hs +29/−16
- Upgrade/V0.hs +2/−1
- Upgrade/V1.hs +2/−1
- Upgrade/V2.hs +3/−2
- Upgrade/V4.hs +3/−2
- Upgrade/V5.hs +4/−3
- Upgrade/V6.hs +3/−2
- Upgrade/V7.hs +3/−2
- Upgrade/V8.hs +21/−0
- Upgrade/V9.hs +103/−0
- doc/git-annex-enable-tor.mdwn +1/−1
- doc/git-annex-init.mdwn +2/−2
- git-annex.cabal +6/−2
Annex.hs view
@@ -154,6 +154,7 @@ , gitconfigadjustment :: (GitConfig -> GitConfig) , gitconfigoverride :: [String] , gitremotes :: Maybe [Git.Repo]+ , gitconfiginodecache :: Maybe InodeCache , backend :: Maybe (BackendA Annex) , remotes :: [Types.Remote.RemoteA Annex] , output :: MessageState@@ -214,6 +215,7 @@ , gitconfigadjustment = id , gitconfigoverride = [] , gitremotes = Nothing+ , gitconfiginodecache = Nothing , backend = Nothing , remotes = [] , output = o
Annex/Content.hs view
@@ -1,6 +1,6 @@ {- git-annex file content managing -- - Copyright 2010-2021 Joey Hess <id@joeyh.name>+ - Copyright 2010-2022 Joey Hess <id@joeyh.name> - - Licensed under the GNU AGPL version 3 or higher. -}@@ -19,6 +19,7 @@ RetrievalSecurityPolicy(..), getViaTmp, getViaTmpFromDisk,+ verificationOfContentFailed, checkDiskSpaceToGet, checkSecureHashes, prepTmp,@@ -58,6 +59,10 @@ Verification(..), unVerified, withTmpWorkDir,+ KeyStatus(..),+ isKeyUnlockedThin,+ getKeyStatus,+ getKeyFileStatus, ) where import System.IO.Unsafe (unsafeInterleaveIO)@@ -114,8 +119,14 @@ where notpresent = giveup $ "failed to lock content: not present" #ifndef mingw32_HOST_OS- lock contentfile Nothing = tryLockShared Nothing contentfile- lock _ (Just lockfile) = posixLocker tryLockShared lockfile+ lock _ (Just lockfile) = + ( posixLocker tryLockShared lockfile+ , Just (posixLocker tryLockExclusive lockfile)+ )+ lock contentfile Nothing =+ ( tryLockShared Nothing contentfile+ , Nothing+ ) #else lock = winLocker lockShared #endif@@ -125,28 +136,33 @@ - - If locking fails, throws an exception rather than running the action. -- - But, if locking fails because the the content is not present, runs the- - fallback action instead.+ - If locking fails because the the content is not present, runs the+ - fallback action instead. However, the content is not guaranteed to be+ - present when this succeeds. -} lockContentForRemoval :: Key -> Annex a -> (ContentRemovalLock -> Annex a) -> Annex a lockContentForRemoval key fallback a = lockContentUsing lock key fallback $ a (ContentRemovalLock key) where #ifndef mingw32_HOST_OS- {- Since content files are stored with the write bit disabled, have- - to fiddle with permissions to open for an exclusive lock. -}- lock contentfile Nothing = bracket_- (thawContent contentfile)- (freezeContent contentfile)- (tryLockExclusive Nothing contentfile)- lock _ (Just lockfile) = posixLocker tryLockExclusive lockfile+ lock _ (Just lockfile) = (posixLocker tryLockExclusive lockfile, Nothing)+ {- No lock file, so the content file itself is locked. + - Since content files are stored with the write bit+ - disabled, have to fiddle with permissions to open+ - for an exclusive lock. -}+ lock contentfile Nothing =+ let lck = bracket_+ (thawContent contentfile)+ (freezeContent contentfile)+ (tryLockExclusive Nothing contentfile)+ in (lck, Nothing) #else lock = winLocker lockExclusive #endif {- Passed the object content file, and maybe a separate lock file to use, - when the content file itself should not be locked. -}-type ContentLocker = RawFilePath -> Maybe LockFile -> Annex (Maybe LockHandle)+type ContentLocker = RawFilePath -> Maybe LockFile -> (Annex (Maybe LockHandle), Maybe (Annex (Maybe LockHandle))) #ifndef mingw32_HOST_OS posixLocker :: (Maybe FileMode -> LockFile -> Annex (Maybe LockHandle)) -> LockFile -> Annex (Maybe LockHandle)@@ -154,37 +170,49 @@ mode <- annexFileMode modifyContent lockfile $ takelock (Just mode) lockfile- #else winLocker :: (LockFile -> IO (Maybe LockHandle)) -> ContentLocker-winLocker takelock _ (Just lockfile) = do- modifyContent lockfile $- void $ liftIO $ tryIO $- writeFile (fromRawFilePath lockfile) ""- liftIO $ takelock lockfile+winLocker takelock _ (Just lockfile) = + let lck = do+ modifyContent lockfile $+ void $ liftIO $ tryIO $+ writeFile (fromRawFilePath lockfile) ""+ liftIO $ takelock lockfile+ in (lck, Nothing) -- never reached; windows always uses a separate lock file-winLocker _ _ Nothing = return Nothing+winLocker _ _ Nothing = (return Nothing, Nothing) #endif {- The fallback action is run if the ContentLocker throws an IO exception - and the content is not present. It's not guaranteed to always run when - the content is not present, because the content file is not always- - the file that is locked eg on Windows a different file is locked. -}+ - the file that is locked. -} lockContentUsing :: ContentLocker -> Key -> Annex a -> Annex a -> Annex a-lockContentUsing locker key fallback a = do+lockContentUsing contentlocker key fallback a = withContentLockFile key $ \mlockfile -> do contentfile <- calcRepo (gitAnnexLocation key)- lockfile <- contentLockFile key+ let (locker, sharedtoexclusive) = contentlocker contentfile mlockfile bracket- (lock contentfile lockfile)- (either (const noop) (unlock lockfile))+ (lock locker mlockfile)+ (either (const noop) (unlock sharedtoexclusive mlockfile)) go where alreadylocked = giveup "content is locked" failedtolock e = giveup $ "failed to lock content: " ++ show e - lock contentfile lockfile = tryIO $- maybe alreadylocked return - =<< locker contentfile lockfile+ lock locker mlockfile = tryIO $ locker >>= \case+ Nothing -> alreadylocked+ Just h ->+#ifndef mingw32_HOST_OS+ case mlockfile of+ Nothing -> return h+ Just lockfile ->+ ifM (checkSaneLock lockfile h)+ ( return h+ , alreadylocked+ )+#else+ return h+#endif go (Right _) = a go (Left e) = ifM (inAnnex key)@@ -193,19 +221,47 @@ ) #ifndef mingw32_HOST_OS- unlock mlockfile lck = do- maybe noop cleanuplockfile mlockfile- liftIO $ dropLock lck+ unlock sharedtoexclusive mlockfile lck = case (sharedtoexclusive, mlockfile) of+ -- We have a shared lock, so other processes may also+ -- have shared locks of the same lock file. To avoid+ -- deleting the lock file when there are other shared+ -- locks, try to convert to an exclusive lock, and only+ -- delete it when that succeeds.+ --+ -- Since other processes might be doing the same,+ -- a race is possible where we open the lock file+ -- and then another process takes the exclusive lock and+ -- deletes it, leaving us with an invalid lock. To avoid + -- that race, checkSaneLock is used after taking the lock+ -- here, and above.+ (Just exclusivelocker, Just lockfile) -> do+ liftIO $ dropLock lck+ exclusivelocker >>= \case+ Nothing -> return ()+ Just h -> do+ whenM (checkSaneLock lockfile h) $ do+ cleanuplockfile lockfile+ liftIO $ dropLock h+ -- We have an exclusive lock, so no other process can have+ -- the lock file locked, and so it's safe to remove it, as + -- long as all lock attempts use checkSaneLock.+ _ -> do+ maybe noop cleanuplockfile mlockfile+ liftIO $ dropLock lck #else- unlock mlockfile lck = do- -- Can't delete a locked file on Windows+ unlock _ mlockfile lck = do+ -- Can't delete a locked file on Windows,+ -- so close our lock first. If there are other shared+ -- locks, they will prevent the file deletion from+ -- happening. liftIO $ dropLock lck maybe noop cleanuplockfile mlockfile #endif - cleanuplockfile lockfile = modifyContent lockfile $- void $ liftIO $ tryIO $- removeWhenExistsWith R.removeLink lockfile+ cleanuplockfile lockfile = void $ tryNonAsync $ do+ thawContentDir lockfile+ liftIO $ removeWhenExistsWith R.removeLink lockfile+ liftIO $ cleanObjectDirs lockfile {- Runs an action, passing it the temp file to get, - and if the action succeeds, verifies the file matches@@ -235,16 +291,7 @@ then ifM (verifyKeyContentPostRetrieval rsp v verification' key tmpfile) ( pruneTmpWorkDirBefore tmpfile (moveAnnex key af) , do- warning "verification of content failed"- -- The bad content is not retained, because- -- a retry should not try to resume from it- -- since it's apparently corrupted.- -- Also, the bad content could be any data,- -- including perhaps the content of another- -- file than the one that was requested,- -- and so it's best not to keep it on disk.- pruneTmpWorkDirBefore tmpfile- (liftIO . removeWhenExistsWith R.removeLink)+ verificationOfContentFailed tmpfile return False ) -- On transfer failure, the tmp file is left behind, in case@@ -263,6 +310,24 @@ ) ) +{- When the content of a file that was successfully transferred from a remote+ - fails to verify, use this to display a message so the user knows why it+ - failed, and to clean up the corrupted content.+ -+ - The bad content is not retained, because the transfer of it succeeded.+ - So it's not incomplete and a resume using it will not work. While+ - some protocols like rsync could recover such a bad content file,+ - they are assumed to not write out bad data to a file in the first place.+ - Most protocols, including the P2P protocol, pick up downloads where they+ - left off, and so if the bad content were not deleted, repeated downloads+ - would continue to fail.+ -}+verificationOfContentFailed :: RawFilePath -> Annex ()+verificationOfContentFailed tmpfile = do+ warning "Verification of content failed"+ pruneTmpWorkDirBefore tmpfile+ (liftIO . removeWhenExistsWith R.removeLink)+ {- Checks if there is enough free disk space to download a key - to its temp file. -@@ -533,12 +598,15 @@ file <- calcRepo (gitAnnexLocation key) void $ tryIO $ thawContentDir file cleaner- liftIO $ removeparents file (3 :: Int)+ liftIO $ cleanObjectDirs file++cleanObjectDirs :: RawFilePath -> IO ()+cleanObjectDirs = go (3 :: Int) where- removeparents _ 0 = noop- removeparents file n = do+ go 0 _ = noop+ go n file = do let dir = parentDir file- maybe noop (const $ removeparents dir (n-1))+ maybe noop (const $ go (n-1) dir) <=< catchMaybeIO $ removeDirectory (fromRawFilePath dir) {- Removes a key's file from .git/annex/objects/ -}@@ -780,3 +848,40 @@ exclude smaller larger = S.toList $ remove larger $ S.fromList smaller where remove a b = foldl (flip S.delete) b a++data KeyStatus+ = KeyMissing+ | KeyPresent+ | KeyUnlockedThin+ -- ^ An annex.thin worktree file is hard linked to the object.+ | KeyLockedThin+ -- ^ The object has hard links, but the file being fscked+ -- is not the one that hard links to it.+ deriving (Show)++isKeyUnlockedThin :: KeyStatus -> Bool+isKeyUnlockedThin KeyUnlockedThin = True+isKeyUnlockedThin KeyLockedThin = False+isKeyUnlockedThin KeyPresent = False+isKeyUnlockedThin KeyMissing = False++getKeyStatus :: Key -> Annex KeyStatus+getKeyStatus key = catchDefaultIO KeyMissing $ do+ afs <- not . null <$> Database.Keys.getAssociatedFiles key+ obj <- calcRepo (gitAnnexLocation key)+ multilink <- ((> 1) . linkCount <$> liftIO (R.getFileStatus obj))+ return $ if multilink && afs+ then KeyUnlockedThin+ else KeyPresent++getKeyFileStatus :: Key -> FilePath -> Annex KeyStatus+getKeyFileStatus key file = do+ s <- getKeyStatus key+ case s of+ KeyUnlockedThin -> catchDefaultIO KeyUnlockedThin $+ ifM (isJust <$> isAnnexLink (toRawFilePath file))+ ( return KeyLockedThin+ , return KeyUnlockedThin+ )+ _ -> return s+
Annex/Content/Presence.hs view
@@ -1,11 +1,12 @@ {- git-annex object content presence -- - Copyright 2010-2021 Joey Hess <id@joeyh.name>+ - Copyright 2010-2022 Joey Hess <id@joeyh.name> - - Licensed under the GNU AGPL version 3 or higher. -} {-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} module Annex.Content.Presence ( inAnnex,@@ -17,22 +18,29 @@ isUnmodified, isUnmodified', isUnmodifiedCheap,- contentLockFile,+ withContentLockFile, ) where import Annex.Content.Presence.LowLevel import Annex.Common import qualified Annex import Annex.LockPool+import Annex.LockFile+import Annex.Version+import Types.RepoVersion import qualified Database.Keys import Annex.InodeSentinal import Utility.InodeCache import qualified Utility.RawFilePath as R+import qualified Git+import Config #ifdef mingw32_HOST_OS import Annex.Perms #endif +import qualified System.FilePath.ByteString as P+ {- Checks if a given key's content is currently present. -} inAnnex :: Key -> Annex Bool inAnnex key = inAnnexCheck key $ liftIO . R.doesPathExist@@ -76,7 +84,7 @@ is_unlocked = Just True is_missing = Just False - go contentfile = flip checklock contentfile =<< contentLockFile key+ go contentfile = withContentLockFile key $ flip checklock contentfile #ifndef mingw32_HOST_OS checklock Nothing contentfile = checkOr is_missing contentfile@@ -115,14 +123,55 @@ ) #endif -{- Windows has to use a separate lock file from the content, since- - locking the actual content file would interfere with the user's- - use of it. -}-contentLockFile :: Key -> Annex (Maybe RawFilePath)+{- Runs an action with the lock file to use to lock a key's content.+ - When the content file itself should be locked, runs the action with+ - Nothing.+ -+ - In v9 and below, while the action is running, a shared lock is held of the+ - gitAnnexContentLockLock. That prevents the v10 upgrade, which changes how+ - content locking works, from running at the same time as content is locked+ - using the old method.+ -}+withContentLockFile :: Key -> (Maybe RawFilePath -> Annex a) -> Annex a+withContentLockFile k a = do+ v <- getVersion+ if versionNeedsWritableContentFiles v+ then withSharedLock gitAnnexContentLockLock $ do+ {- While the lock is held, check to see if the git+ - config has changed, and reload it if so. This+ - updates the annex.version after the v10 upgrade,+ - so that a process that started in a v9 repository+ - will switch over to v10 content lock files at the+ - right time. -}+ gitdir <- fromRepo Git.localGitDir+ let gitconfig = gitdir P.</> "config"+ ic <- withTSDelta (liftIO . genInodeCache gitconfig)+ oldic <- Annex.getState Annex.gitconfiginodecache+ v' <- if fromMaybe False (compareStrong <$> ic <*> oldic)+ then pure v+ else do+ Annex.changeState $ \s -> + s { Annex.gitconfiginodecache = ic }+ reloadConfig+ getVersion+ go (v')+ else (go v)+ where+ go v = contentLockFile k v >>= a++contentLockFile :: Key -> Maybe RepoVersion -> Annex (Maybe RawFilePath) #ifndef mingw32_HOST_OS-contentLockFile _ = pure Nothing+{- Older versions of git-annex locked content files themselves, but newer+ - versions use a separate lock file, to better support repos shared+ - amoung users in eg a group. -}+contentLockFile key v+ | versionNeedsWritableContentFiles v = pure Nothing+ | otherwise = Just <$> calcRepo (gitAnnexContentLock key) #else-contentLockFile key = Just <$> calcRepo (gitAnnexContentLock key)+{- Windows always has to use a separate lock file from the content, since+ - locking the actual content file would interfere with the user's+ - use of it. -}+contentLockFile key _ = Just <$> calcRepo (gitAnnexContentLock key) #endif {- Performs an action, passing it the location to use for a key's content. -}
Annex/Init.hs view
@@ -282,7 +282,7 @@ -- running as root). But some crippled -- filesystems ignore write bit removals or ignore -- permissions entirely.- ifM ((== Just False) <$> liftIO (checkContentWritePerm' UnShared (toRawFilePath f)))+ ifM ((== Just False) <$> liftIO (checkContentWritePerm' UnShared (toRawFilePath f) Nothing)) ( return (True, ["Filesystem does not allow removing write bit from files."]) , liftIO $ ifM ((== 0) <$> getRealUserID) ( return (False, [])
Annex/Locations.hs view
@@ -1,6 +1,6 @@ {- git-annex file locations -- - Copyright 2010-2021 Joey Hess <id@joeyh.name>+ - Copyright 2010-2022 Joey Hess <id@joeyh.name> - - Licensed under the GNU AGPL version 3 or higher. -}@@ -20,6 +20,7 @@ gitAnnexLink, gitAnnexLinkCanonical, gitAnnexContentLock,+ gitAnnexContentLockLock, gitAnnexInodeSentinal, gitAnnexInodeSentinalCache, annexLocationsBare,@@ -44,6 +45,8 @@ gitAnnexFsckDbDirOld, gitAnnexFsckDbLock, gitAnnexFsckResultsLog,+ gitAnnexUpgradeLog,+ gitAnnexUpgradeLock, gitAnnexSmudgeLog, gitAnnexSmudgeLock, gitAnnexMoveLog,@@ -237,6 +240,17 @@ loc <- gitAnnexLocation key r config return $ loc <> ".lck" +{- Lock that is held when taking the gitAnnexContentLock to support the v10+ - upgrade.+ -+ - This uses the gitAnnexInodeSentinal file, because it needs to be a file+ - that exists in the repository, even when it's an old v8 repository that+ - is mounted read-only. The gitAnnexInodeSentinal is created by git-annex+ - init, so should already exist.+ -}+gitAnnexContentLockLock :: Git.Repo -> RawFilePath+gitAnnexContentLockLock = gitAnnexInodeSentinal+ gitAnnexInodeSentinal :: Git.Repo -> RawFilePath gitAnnexInodeSentinal r = gitAnnexDir r P.</> "sentinal" @@ -344,6 +358,13 @@ gitAnnexFsckResultsLog :: UUID -> Git.Repo -> RawFilePath gitAnnexFsckResultsLog u r = gitAnnexDir r P.</> "fsckresults" P.</> fromUUID u++{- .git/annex/upgrade.log is used to record repository version upgrades. -}+gitAnnexUpgradeLog :: Git.Repo -> RawFilePath+gitAnnexUpgradeLog r = gitAnnexDir r P.</> "upgrade.log"++gitAnnexUpgradeLock :: Git.Repo -> RawFilePath+gitAnnexUpgradeLock r = gitAnnexDir r P.</> "upgrade.lck" {- .git/annex/smudge.log is used to log smudges worktree files that need to - be updated. -}
Annex/Perms.hs view
@@ -1,6 +1,6 @@ {- git-annex file permissions -- - Copyright 2012-2021 Joey Hess <id@joeyh.name>+ - Copyright 2012-2022 Joey Hess <id@joeyh.name> - - Licensed under the GNU AGPL version 3 or higher. -}@@ -16,6 +16,7 @@ noUmask, freezeContent, freezeContent',+ freezeContent'', checkContentWritePerm, checkContentWritePerm', thawContent,@@ -32,6 +33,8 @@ import Git import Git.ConfigTypes import qualified Annex+import Annex.Version+import Types.RepoVersion import Config import Utility.Directory.Create import qualified Utility.RawFilePath as R@@ -127,12 +130,15 @@ {- Normally, blocks writing to an annexed file, and modifies file - permissions to allow reading it. -- - When core.sharedRepository is set, the write bits are not removed from- - the file, but instead the appropriate group write bits are set. This is- - necessary to let other users in the group lock the file. But, in a- - shared repository, the current user may not be able to change a file- - owned by another user, so failure to set this mode is ignored.+ - Before v9, when core.sharedRepository is set, the write bits are not+ - removed from the file, but instead the appropriate group write bits+ - are set. This is necessary to let other users in the group lock the file.+ - v9 improved this by using separate lock files, so the content file does+ - not need to be writable when using it. -+ - In a shared repository, the current user may not be able to change+ - a file owned by another user, so failure to change modes is ignored.+ - - Note that, on Linux, xattrs can sometimes prevent removing - certain permissions from a file with chmod. (Maybe some ACLs too?) - In such a case, this will return with the file still having some mode@@ -144,17 +150,32 @@ withShared $ \sr -> freezeContent' sr file freezeContent' :: SharedRepository -> RawFilePath -> Annex ()-freezeContent' sr file = do+freezeContent' sr file = freezeContent'' sr file =<< getVersion++freezeContent'' :: SharedRepository -> RawFilePath -> Maybe RepoVersion -> Annex ()+freezeContent'' sr file rv = do go sr freezeHook file where- go GroupShared = liftIO $ void $ tryIO $ modifyFileMode file $- addModes [ownerReadMode, groupReadMode, ownerWriteMode, groupWriteMode]- go AllShared = liftIO $ void $ tryIO $ modifyFileMode file $- addModes (readModes ++ writeModes)- go _ = liftIO $ modifyFileMode file $+ go GroupShared = if versionNeedsWritableContentFiles rv+ then liftIO $ ignoresharederr $ modmode $ addModes+ [ownerReadMode, groupReadMode, ownerWriteMode, groupWriteMode]+ else liftIO $ ignoresharederr $+ nowriteadd [ownerReadMode, groupReadMode]+ go AllShared = if versionNeedsWritableContentFiles rv+ then liftIO $ ignoresharederr $ modmode $ addModes+ (readModes ++ writeModes)+ else liftIO $ ignoresharederr $ + nowriteadd readModes+ go _ = liftIO $ nowriteadd [ownerReadMode]++ ignoresharederr = void . tryIO++ modmode = modifyFileMode file++ nowriteadd readmodes = modmode $ removeModes writeModes .- addModes [ownerReadMode]+ addModes readmodes {- Checks if the write permissions are as freezeContent should set them. -@@ -166,14 +187,21 @@ checkContentWritePerm :: RawFilePath -> Annex (Maybe Bool) checkContentWritePerm file = ifM crippledFileSystem ( return (Just True)- , withShared (\sr -> liftIO (checkContentWritePerm' sr file))+ , do+ rv <- getVersion+ withShared (\sr -> liftIO (checkContentWritePerm' sr file rv)) ) -checkContentWritePerm' :: SharedRepository -> RawFilePath -> IO (Maybe Bool)-checkContentWritePerm' sr file = case sr of- GroupShared -> want sharedret- (includemodes [ownerWriteMode, groupWriteMode])- AllShared -> want sharedret (includemodes writeModes)+checkContentWritePerm' :: SharedRepository -> RawFilePath -> Maybe RepoVersion -> IO (Maybe Bool)+checkContentWritePerm' sr file rv = case sr of+ GroupShared+ | versionNeedsWritableContentFiles rv -> want sharedret+ (includemodes [ownerWriteMode, groupWriteMode])+ | otherwise -> want sharedret (excludemodes writeModes)+ AllShared+ | versionNeedsWritableContentFiles rv -> + want sharedret (includemodes writeModes)+ | otherwise -> want sharedret (excludemodes writeModes) _ -> want Just (excludemodes writeModes) where want mk f = catchMaybeIO (fileMode <$> R.getFileStatus file)
Annex/SpecialRemote.hs view
@@ -1,6 +1,6 @@ {- git-annex special remote configuration -- - Copyright 2011-2019 Joey Hess <id@joeyh.name>+ - Copyright 2011-2021 Joey Hess <id@joeyh.name> - - Licensed under the GNU AGPL version 3 or higher. -}@@ -25,16 +25,22 @@ import Git.Types (RemoteName) import qualified Data.Map as M-import Data.Ord {- See if there's an existing special remote with this name. -- - Prefer remotes that are not dead when a name appears multiple times. -}-findExisting :: RemoteName -> Annex (Maybe (UUID, RemoteConfig, Maybe (ConfigFrom UUID)))+ - Remotes that are not dead come first in the list+ - when a name appears multiple times. -}+findExisting :: RemoteName -> Annex [(UUID, RemoteConfig, Maybe (ConfigFrom UUID))] findExisting name = do+ (a, b) <- findExisting' name+ return (a++b)++{- Dead remotes with the name are in the second list, all others in the+ - first list. -}+findExisting' :: RemoteName -> Annex ([(UUID, RemoteConfig, Maybe (ConfigFrom UUID))], [(UUID, RemoteConfig, Maybe (ConfigFrom UUID))])+findExisting' name = do t <- trustMap- headMaybe- . sortBy (comparing $ \(u, _, _) -> Down $ M.lookup u t)+ partition (\(u, _, _) -> M.lookup u t /= Just DeadTrusted) . findByRemoteConfig (\c -> lookupName c == Just name) <$> Logs.Remote.remoteConfigMap
Annex/Version.hs view
@@ -1,6 +1,6 @@ {- git-annex repository versioning -- - Copyright 2010-2019 Joey Hess <id@joeyh.name>+ - Copyright 2010-2022 Joey Hess <id@joeyh.name> - - Licensed under the GNU AGPL version 3 or higher. -}@@ -22,25 +22,27 @@ defaultVersion = RepoVersion 8 latestVersion :: RepoVersion-latestVersion = RepoVersion 8+latestVersion = RepoVersion 10 supportedVersions :: [RepoVersion]-supportedVersions = map RepoVersion [8]+supportedVersions = map RepoVersion [8, 9, 10] -upgradableVersions :: [RepoVersion]+upgradeableVersions :: [RepoVersion] #ifndef mingw32_HOST_OS-upgradableVersions = map RepoVersion [0..7]+upgradeableVersions = map RepoVersion [0..10] #else-upgradableVersions = map RepoVersion [2..7]+upgradeableVersions = map RepoVersion [2..10] #endif autoUpgradeableVersions :: M.Map RepoVersion RepoVersion autoUpgradeableVersions = M.fromList- [ (RepoVersion 3, latestVersion)- , (RepoVersion 4, latestVersion)- , (RepoVersion 5, latestVersion)- , (RepoVersion 6, latestVersion)- , (RepoVersion 7, latestVersion)+ [ (RepoVersion 3, defaultVersion)+ , (RepoVersion 4, defaultVersion)+ , (RepoVersion 5, defaultVersion)+ , (RepoVersion 6, defaultVersion)+ , (RepoVersion 7, defaultVersion)+ , (RepoVersion 8, defaultVersion)+ , (RepoVersion 9, latestVersion) ] versionField :: ConfigKey@@ -54,3 +56,13 @@ removeVersion :: Annex () removeVersion = unsetConfig versionField++versionSupportsFilterProcess :: Maybe RepoVersion -> Bool+versionSupportsFilterProcess (Just v) + | v >= RepoVersion 9 = True+versionSupportsFilterProcess _ = False++versionNeedsWritableContentFiles :: Maybe RepoVersion -> Bool+versionNeedsWritableContentFiles (Just v) + | v >= RepoVersion 10 = False+versionNeedsWritableContentFiles _ = True
Assistant/MakeRemote.hs view
@@ -55,9 +55,9 @@ makeRsyncRemote name location = makeRemote name location $ const $ void $ go =<< Annex.SpecialRemote.findExisting name where- go Nothing = setupSpecialRemote name Rsync.remote config Nothing+ go [] = setupSpecialRemote name Rsync.remote config Nothing (Nothing, R.Init, Annex.SpecialRemote.newConfig name Nothing mempty mempty) Nothing- go (Just (u, c, mcu)) = setupSpecialRemote name Rsync.remote config Nothing+ go ((u, c, mcu):_) = setupSpecialRemote name Rsync.remote config Nothing (Just u, R.Enable c, c) mcu config = M.fromList [ (encryptionField, Proposed "shared")@@ -86,16 +86,16 @@ go n = do let fullname = if n == 0 then name else name ++ show n Annex.SpecialRemote.findExisting fullname >>= \case- Nothing -> setupSpecialRemote fullname remotetype config mcreds+ [] -> setupSpecialRemote fullname remotetype config mcreds (Nothing, R.Init, Annex.SpecialRemote.newConfig fullname Nothing mempty mempty) Nothing- Just _ -> go (n + 1)+ _ -> go (n + 1) {- Enables an existing special remote. -} enableSpecialRemote :: SpecialRemoteMaker enableSpecialRemote name remotetype mcreds config = Annex.SpecialRemote.findExisting name >>= \case- Nothing -> error $ "Cannot find a special remote named " ++ name- Just (u, c, mcu) -> setupSpecialRemote' False name remotetype config mcreds (Just u, R.Enable c, c) mcu+ [] -> error $ "Cannot find a special remote named " ++ name+ ((u, c, mcu):_) -> setupSpecialRemote' False name remotetype config mcreds (Just u, R.Enable c, c) mcu setupSpecialRemote :: RemoteName -> RemoteType -> R.RemoteConfig -> Maybe CredPair -> (Maybe UUID, R.SetupStage, R.RemoteConfig) -> Maybe (Annex.SpecialRemote.ConfigFrom UUID) -> Annex RemoteName setupSpecialRemote = setupSpecialRemote' True
CHANGELOG view
@@ -1,3 +1,36 @@+git-annex (10.20220127) upstream; urgency=medium++ * New v10 repository version (with v9 as a stepping-stone to it).+ v8 remains the default version for now.+ * In v10, object files are locked using separate lock files. This allows+ the object files to be kept non-writable even in repositories where+ core.sharedRepository is set.+ * The v10 upgrade will happen automatically, one year after the v9+ upgrade, in order to allow time for any old git-annex processes that+ are not aware of the locking change to finish. Or git-annex upgrade+ can be used to upgrade to v10 immediately.+ * In v9 upgrade, set filter.annex.process. This makes git add/checkout faster+ when there are a lot of unlocked annexed files or non-annexed files, but can+ also make git add of large files to the annex somewhat slower.+ If this tradeoff does not work for your use case, you can still unset+ filter.annex.process.+ * export: When a non-annexed symlink is in the tree to be exported, skip it.+ * import: When the previously exported tree contained a non-annexed symlink,+ preserve it in the imported tree so it does not get deleted.+ * enableremote, renameremote: Better handling of the unusual case where+ multiple special remotes have been initialized with the same name.+ * Recover from corrupted content being received from a git remote,+ by deleting the temporary file when it fails to verify. This prevents+ a retry from failing again. + (reversion introduced in version 8.20210903)+ * adb: Added ignorefinderror configuration parameter.+ * Avoid crashing when run in a bare git repo that somehow contains an+ index file.+ * Reject combinations of --batch (or --batch-keys) with options like+ --all or --key or with filenames.++ -- Joey Hess <id@joeyh.name> Thu, 27 Jan 2022 13:25:19 -0400+ git-annex (8.20211231) upstream; urgency=medium * Improved support for using git-annex in a read-only repository,
COPYRIGHT view
@@ -2,7 +2,7 @@ Source: native package Files: *-Copyright: © 2010-2021 Joey Hess <id@joeyh.name>+Copyright: © 2010-2022 Joey Hess <id@joeyh.name> License: AGPL-3+ Files: Assistant/WebApp.hs Assistant/WebApp/* templates/* static/*
CmdLine/Batch.hs view
@@ -77,8 +77,9 @@ batchseeker (opts, NoBatch, params) = mapM_ (\p -> go NoBatch opts (SeekInput [p], p)) params- batchseeker (opts, batchmode@(Batch fmt), _) = - batchInput fmt (pure . Right) (go batchmode opts)+ batchseeker (opts, batchmode@(Batch fmt), params) = + batchOnly Nothing params $+ batchInput fmt (pure . Right) (go batchmode opts) go batchmode opts (si, p) = unlessM (handler opts si p) $@@ -209,3 +210,8 @@ , providedMimeEncoding = Nothing , providedLinkType = Nothing }++batchOnly :: Maybe KeyOptions -> CmdParams -> Annex () -> Annex ()+batchOnly Nothing [] a = a+batchOnly _ _ _ = giveup "Cannot combine batch option with file or key options"+
Command/Add.hs view
@@ -95,7 +95,8 @@ Batch fmt | updateOnly o -> giveup "--update --batch is not supported"- | otherwise -> batchFiles fmt gofile+ | otherwise -> batchOnly Nothing (addThese o) $+ batchFiles fmt gofile NoBatch -> do -- Avoid git ls-files complaining about files that -- are not known to git yet, since this will add
Command/AddUrl.hs view
@@ -119,10 +119,10 @@ then void $ commandAction $ startWeb addunlockedmatcher o' si u else checkUrl addunlockedmatcher r o' si u- forM_ (addUrls o) (\u -> go (SeekInput [u], (o, u))) case batchOption o of- Batch fmt -> batchInput fmt (pure . parseBatchInput o) go- NoBatch -> noop+ Batch fmt -> batchOnly Nothing (addUrls o) $+ batchInput fmt (pure . parseBatchInput o) go+ NoBatch -> forM_ (addUrls o) (\u -> go (SeekInput [u], (o, u))) parseBatchInput :: AddUrlOptions -> String -> Either String (AddUrlOptions, URLString) parseBatchInput o s
Command/Copy.hs view
@@ -51,7 +51,8 @@ (commandAction . keyaction) (withFilesInGitAnnex ww seeker) =<< workTreeItems ww (copyFiles o)- Batch fmt -> batchAnnexed fmt seeker keyaction+ Batch fmt -> batchOnly (keyOptions o) (copyFiles o) $+ batchAnnexed fmt seeker keyaction where ww = WarnUnmatchLsFiles
Command/Drop.hs view
@@ -71,7 +71,8 @@ (commandAction . startKeys o from) (withFilesInGitAnnex ww seeker) =<< workTreeItems ww (dropFiles o)- Batch fmt -> batchAnnexed fmt seeker (startKeys o from)+ Batch fmt -> batchOnly (keyOptions o) (dropFiles o) $+ batchAnnexed fmt seeker (startKeys o from) where ww = WarnUnmatchLsFiles
Command/DropKey.hs view
@@ -33,11 +33,11 @@ seek o = do unlessM (Annex.getState Annex.force) $ giveup "dropkey can cause data loss; use --force if you're sure you want to do this"- withKeys (commandAction . start) (toDrop o) case batchOption o of- Batch fmt -> batchInput fmt (pure . parsekey) $- batchCommandAction . start- NoBatch -> noop+ NoBatch -> withKeys (commandAction . start) (toDrop o)+ Batch fmt -> batchOnly Nothing (toDrop o) $+ batchInput fmt (pure . parsekey) $+ batchCommandAction . start where parsekey = maybe (Left "bad key") Right . deserializeKey
Command/EnableRemote.hs view
@@ -43,8 +43,13 @@ start (name:rest) = go =<< filter matchingname <$> Annex.getGitRemotes where matchingname r = Git.remoteName r == Just name- go [] = startSpecialRemote name (Logs.Remote.keyValToConfig Proposed rest)- =<< SpecialRemote.findExisting name+ go [] = + let use = startSpecialRemote name (Logs.Remote.keyValToConfig Proposed rest)+ in SpecialRemote.findExisting' name >>= \case+ -- enable dead remote only when there is no+ -- other remote with the same name+ ([], l) -> use l+ (l, _) -> use l go (r:_) = do -- This could be either a normal git remote or a special -- remote that has an url (eg gcrypt).@@ -69,16 +74,16 @@ ai = ActionItemOther (Just name) si = SeekInput [name] -startSpecialRemote :: Git.RemoteName -> Remote.RemoteConfig -> Maybe (UUID, Remote.RemoteConfig, Maybe (SpecialRemote.ConfigFrom UUID)) -> CommandStart-startSpecialRemote name config Nothing = do+startSpecialRemote :: Git.RemoteName -> Remote.RemoteConfig -> [(UUID, Remote.RemoteConfig, Maybe (SpecialRemote.ConfigFrom UUID))] -> CommandStart+startSpecialRemote name config [] = do m <- SpecialRemote.specialRemoteMap confm <- Logs.Remote.remoteConfigMap Remote.nameToUUID' name >>= \case Right u | u `M.member` m -> startSpecialRemote name config $- Just (u, fromMaybe M.empty (M.lookup u confm), Nothing)+ [(u, fromMaybe M.empty (M.lookup u confm), Nothing)] _ -> unknownNameError "Unknown remote name."-startSpecialRemote name config (Just (u, c, mcu)) =+startSpecialRemote name config ((u, c, mcu):[]) = starting "enableremote" ai si $ do let fullconfig = config `M.union` c t <- either giveup return (SpecialRemote.findType fullconfig)@@ -89,6 +94,8 @@ where ai = ActionItemOther (Just name) si = SeekInput [name]+startSpecialRemote _ _ _ =+ giveup "Multiple remotes have that name. Either use git-annex renameremote to rename them, or specify the uuid of the remote to enable." performSpecialRemote :: RemoteType -> UUID -> R.RemoteConfig -> R.RemoteConfig -> RemoteGitConfig -> Maybe (SpecialRemote.ConfigFrom UUID) -> CommandPerform performSpecialRemote t u oldc c gc mcu = do
Command/Export.hs view
@@ -479,7 +479,8 @@ newtype ExportFiltered t = ExportFiltered t -- | Filters the tree to annexed files that are preferred content of the--- remote, and also including non-annexed files, but not submodules.+-- remote, and also including non-annexed files, but not submodules or+-- non-annexed symlinks. -- -- A log is written with tree items that were filtered out, so they can -- be added back in when importing from the remote.@@ -505,16 +506,27 @@ case toTreeItemType mode of -- Don't export submodule entries. Just TreeSubmodule -> excluded- _ -> case mmatcher of- Nothing -> return (Just ti)- Just matcher -> catKey sha >>= \case- Just k -> checkmatcher matcher k- -- Always export non-annexed files.- Nothing -> return (Just ti)+ Just TreeSymlink -> checkkey True+ _ -> checkkey False where excluded = do () <- liftIO $ logwriter ti return Nothing++ checkkey issymlink =+ case mmatcher of+ Nothing+ | issymlink -> catKey sha >>= \case+ Just _ -> return (Just ti)+ Nothing+ | issymlink -> excluded+ | otherwise -> return (Just ti)+ | otherwise -> return (Just ti)+ Just matcher -> catKey sha >>= \case+ Just k -> checkmatcher matcher k+ Nothing+ | issymlink -> excluded+ | otherwise -> return (Just ti) checkmatcher matcher k = do let mi = MatchingInfo $ ProvidedInfo
Command/Find.hs view
@@ -70,7 +70,8 @@ (commandAction . startKeys o) (withFilesInGitAnnex ww seeker) =<< workTreeItems ww (findThese o)- Batch fmt -> batchAnnexedFiles fmt seeker+ Batch fmt -> batchOnly (keyOptions o) (findThese o) $+ batchAnnexedFiles fmt seeker where ww = WarnUnmatchLsFiles
Command/FromKey.hs view
@@ -41,7 +41,8 @@ seek o = do matcher <- addUnlockedMatcher case (batchOption o, keyFilePairs o) of- (Batch fmt, _) -> seekBatch matcher fmt+ (Batch fmt, _) -> batchOnly Nothing (keyFilePairs o) $+ seekBatch matcher fmt -- older way of enabling batch input, does not support BatchNull (NoBatch, []) -> seekBatch matcher (BatchFormat BatchLine (BatchKeys False)) (NoBatch, ps) -> do
Command/Fsck.hs view
@@ -705,39 +705,3 @@ withFsckDb NonIncremental _ = noop withFsckDb (ScheduleIncremental _ _ i) a = withFsckDb i a -data KeyStatus- = KeyMissing- | KeyPresent- | KeyUnlockedThin- -- ^ An annex.thin worktree file is hard linked to the object.- | KeyLockedThin- -- ^ The object has hard links, but the file being fscked- -- is not the one that hard links to it.- deriving (Show)--isKeyUnlockedThin :: KeyStatus -> Bool-isKeyUnlockedThin KeyUnlockedThin = True-isKeyUnlockedThin KeyLockedThin = False-isKeyUnlockedThin KeyPresent = False-isKeyUnlockedThin KeyMissing = False--getKeyStatus :: Key -> Annex KeyStatus-getKeyStatus key = catchDefaultIO KeyMissing $ do- afs <- not . null <$> Database.Keys.getAssociatedFiles key- obj <- calcRepo (gitAnnexLocation key)- multilink <- ((> 1) . linkCount <$> liftIO (R.getFileStatus obj))- return $ if multilink && afs- then KeyUnlockedThin- else KeyPresent--getKeyFileStatus :: Key -> FilePath -> Annex KeyStatus-getKeyFileStatus key file = do- s <- getKeyStatus key- case s of- KeyUnlockedThin -> catchDefaultIO KeyUnlockedThin $- ifM (isJust <$> isAnnexLink (toRawFilePath file))- ( return KeyLockedThin- , return KeyUnlockedThin- )- _ -> return s-
Command/Get.hs view
@@ -49,7 +49,8 @@ (commandAction . startKeys from) (withFilesInGitAnnex ww seeker) =<< workTreeItems ww (getFiles o)- Batch fmt -> batchAnnexed fmt seeker (startKeys from)+ Batch fmt -> batchOnly (keyOptions o) (getFiles o) $+ batchAnnexed fmt seeker (startKeys from) where ww = WarnUnmatchLsFiles
Command/Info.hs view
@@ -119,7 +119,8 @@ seek :: InfoOptions -> CommandSeek seek o = case batchOption o of NoBatch -> withWords (commandAction . start o) (infoFor o)- Batch fmt -> batchInput fmt (pure . Right) (itemInfo o)+ Batch fmt -> batchOnly Nothing (infoFor o) $+ batchInput fmt (pure . Right) (itemInfo o) start :: InfoOptions -> [String] -> CommandStart start o [] = do
Command/InitRemote.hs view
@@ -64,7 +64,7 @@ start :: InitRemoteOptions -> [String] -> CommandStart start _ [] = giveup "Specify a name for the remote."-start o (name:ws) = ifM (isJust <$> findExisting name)+start o (name:ws) = ifM (not . null <$> findExisting name) ( giveup $ "There is already a special remote named \"" ++ name ++ "\". (Use enableremote to enable an existing special remote.)" , ifM (isJust <$> Remote.byNameOnly name)
Command/MetaData.hs view
@@ -93,8 +93,9 @@ Batch fmt -> withMessageState $ \s -> case outputType s of JSONOutput _ -> ifM limited ( giveup "combining --batch with file matching options is not currently supported"- , batchInput fmt parseJSONInput - (commandAction . batchCommandStart . startBatch)+ , batchOnly (keyOptions o) (forFiles o) $+ batchInput fmt parseJSONInput + (commandAction . batchCommandStart . startBatch) ) _ -> giveup "--batch is currently only supported in --json mode"
Command/Migrate.hs view
@@ -96,7 +96,7 @@ | knowngoodcontent = finish (removesize newkey) | otherwise = stopUnless checkcontent $ finish (removesize newkey)- checkcontent = Command.Fsck.checkBackend oldbackend oldkey Command.Fsck.KeyPresent afile+ checkcontent = Command.Fsck.checkBackend oldbackend oldkey KeyPresent afile finish newkey = ifM (Command.ReKey.linkKey file oldkey newkey) ( do _ <- copyMetaData oldkey newkey
Command/Move.hs view
@@ -64,7 +64,8 @@ (commandAction . keyaction) (withFilesInGitAnnex ww seeker) =<< workTreeItems ww (moveFiles o)- Batch fmt -> batchAnnexed fmt seeker keyaction+ Batch fmt -> batchOnly (keyOptions o) (moveFiles o) $+ batchAnnexed fmt seeker keyaction where seeker = AnnexedFileSeeker { startAction = start (fromToOptions o) (removeWhen o)
Command/ReKey.hs view
@@ -50,8 +50,9 @@ seek :: ReKeyOptions -> CommandSeek seek o = case batchOption o of- Batch fmt -> batchInput fmt batchParser- (batchCommandAction . uncurry start)+ Batch fmt -> batchOnly Nothing (reKeyThese o) $+ batchInput fmt batchParser+ (batchCommandAction . uncurry start) NoBatch -> withPairs (\(si, p) -> commandAction (start si (parsekey p))) (reKeyThese o)
Command/RegisterUrl.hs view
@@ -32,7 +32,7 @@ seek :: RegisterUrlOptions -> CommandSeek seek o = case (batchOption o, keyUrlPairs o) of- (Batch (BatchFormat sep _), _) ->+ (Batch (BatchFormat sep _), _) -> batchOnly Nothing (keyUrlPairs o) $ commandAction $ startMass setUrlPresent sep -- older way of enabling batch input, does not support BatchNull (NoBatch, []) -> commandAction $ startMass setUrlPresent BatchLine
Command/RenameRemote.hs view
@@ -1,6 +1,6 @@ {- git-annex command -- - Copyright 2019 Joey Hess <id@joeyh.name>+ - Copyright 2019-2021 Joey Hess <id@joeyh.name> - - Licensed under the GNU AGPL version 3 or higher. -}@@ -28,19 +28,20 @@ start :: [String] -> CommandStart start ps@(oldname:newname:[]) = Annex.SpecialRemote.findExisting oldname >>= \case- Just (u, cfg, mcu) -> Annex.SpecialRemote.findExisting newname >>= \case- Just _ -> giveup $ "The name " ++ newname ++ " is already used by a special remote."- Nothing -> go u cfg mcu+ ((u, cfg, mcu):[]) -> Annex.SpecialRemote.findExisting newname >>= \case+ [] -> go u cfg mcu+ _ -> giveup $ "The name " ++ newname ++ " is already used by a special remote." -- Support lookup by uuid or description as well as remote name, -- as a fallback when there is nothing with the name in the -- special remote log.- Nothing -> Remote.nameToUUID' oldname >>= \case+ [] -> Remote.nameToUUID' oldname >>= \case Left e -> giveup e Right u -> do m <- Logs.Remote.remoteConfigMap case M.lookup u m of Nothing -> giveup "That is not a special remote." Just cfg -> go u cfg Nothing+ _ -> giveup $ "There are multiple special remotes named " ++ oldname ++ ". Provide instead the uuid or description of the remote to rename." where ai = ActionItemOther Nothing si = SeekInput ps
Command/RmUrl.hs view
@@ -29,7 +29,8 @@ seek :: RmUrlOptions -> CommandSeek seek o = case batchOption o of- Batch fmt -> batchInput fmt batchParser (batchCommandAction . start)+ Batch fmt -> batchOnly Nothing (rmThese o) $+ batchInput fmt batchParser (batchCommandAction . start) NoBatch -> withPairs (commandAction . start) (rmThese o) -- Split on the last space, since a FilePath can contain whitespace,
Command/SetPresentKey.hs view
@@ -30,9 +30,10 @@ seek :: SetPresentKeyOptions -> CommandSeek seek o = case batchOption o of- Batch fmt -> batchInput fmt- (pure . parseKeyStatus . words)- (batchCommandAction . uncurry start)+ Batch fmt -> batchOnly Nothing (params o) $+ batchInput fmt+ (pure . parseKeyStatus . words)+ (batchCommandAction . uncurry start) NoBatch -> either giveup (commandAction . start (SeekInput (params o))) (parseKeyStatus $ params o)
Command/Version.hs view
@@ -66,7 +66,7 @@ vinfo "supported repository versions" $ verlist supportedVersions vinfo "upgrade supported from repository versions" $- verlist upgradableVersions+ verlist upgradeableVersions where verlist = unwords . map showRepoVersion
Command/Whereis.hs view
@@ -62,7 +62,8 @@ (commandAction . startKeys o m) (withFilesInGitAnnex ww seeker) =<< workTreeItems ww (whereisFiles o)- Batch fmt -> batchAnnexed fmt seeker (startKeys o m)+ Batch fmt -> batchOnly (keyOptions o) (whereisFiles o) $+ batchAnnexed fmt seeker (startKeys o m) where ww = WarnUnmatchLsFiles
Config/Smudge.hs view
@@ -1,6 +1,6 @@ {- Git smudge filter configuration -- - Copyright 2011-2019 Joey Hess <id@joeyh.name>+ - Copyright 2011-2022 Joey Hess <id@joeyh.name> - - Licensed under the GNU AGPL version 3 or higher. -}@@ -16,6 +16,7 @@ import Git.Types import Config import Utility.Directory.Create+import Annex.Version import qualified System.FilePath.ByteString as P @@ -32,6 +33,8 @@ setConfig (ConfigKey "filter.annex.smudge") "git-annex smudge -- %f" setConfig (ConfigKey "filter.annex.clean") "git-annex smudge --clean -- %f"+ whenM (versionSupportsFilterProcess <$> getVersion)+ configureSmudgeFilterProcess lf <- Annex.fromRepo Git.attributesLocal gf <- Annex.fromRepo Git.attributes lfs <- readattr lf@@ -42,6 +45,10 @@ writeFile (fromRawFilePath lf) (lfs ++ "\n" ++ unlines stdattr) where readattr = liftIO . catchDefaultIO "" . readFileStrict . fromRawFilePath++configureSmudgeFilterProcess :: Annex ()+configureSmudgeFilterProcess =+ setConfig (ConfigKey "filter.annex.process") "git-annex filter-process" stdattr :: [String] stdattr =
Database/Keys.hs view
@@ -49,6 +49,7 @@ import Git.CatFile import Git.Branch (writeTreeQuiet, update') import qualified Git.Ref+import qualified Git.Config import Config.Smudge import qualified Utility.RawFilePath as R @@ -154,11 +155,23 @@ {- Note that the files returned were once associated with the key, but - some of them may not be any longer. -} getAssociatedFiles :: Key -> Annex [TopFilePath]-getAssociatedFiles = runReaderIO . SQL.getAssociatedFiles+getAssociatedFiles k = emptyWhenBare $ runReaderIO $ SQL.getAssociatedFiles k +{- Queries for associated files never return anything when in a bare+ - repository, since without a work tree there can be no associated files. + -+ - Normally the keys database is not even populated with associated files + - in a bare repository, but it might happen if a non-bare repo got+ - converted to bare. -}+emptyWhenBare :: Annex [a] -> Annex [a]+emptyWhenBare a = ifM (Git.Config.isBare <$> gitRepo)+ ( return []+ , a+ )+ {- Include a known associated file along with any recorded in the database. -} getAssociatedFilesIncluding :: AssociatedFile -> Key -> Annex [RawFilePath]-getAssociatedFilesIncluding afile k = do+getAssociatedFilesIncluding afile k = emptyWhenBare $ do g <- Annex.gitRepo l <- map (`fromTopFilePath` g) <$> getAssociatedFiles k return $ case afile of@@ -168,7 +181,7 @@ {- Gets any keys that are on record as having a particular associated file. - (Should be one or none but the database doesn't enforce that.) -} getAssociatedKey :: TopFilePath -> Annex [Key]-getAssociatedKey = runReaderIO . SQL.getAssociatedKey+getAssociatedKey f = emptyWhenBare $ runReaderIO $ SQL.getAssociatedKey f removeAssociatedFile :: Key -> TopFilePath -> Annex () removeAssociatedFile k = runWriterIO . SQL.removeAssociatedFile k@@ -233,7 +246,7 @@ - is an associated file. -} reconcileStaged :: H.DbQueue -> Annex ()-reconcileStaged qh = do+reconcileStaged qh = unlessM (Git.Config.isBare <$> gitRepo) $ do gitindex <- inRepo currentIndexFile indexcache <- fromRawFilePath <$> fromRepo gitAnnexKeysDbIndexCache withTSDelta (liftIO . genInodeCache gitindex) >>= \case
+ Logs/Upgrade.hs view
@@ -0,0 +1,52 @@+{- git-annex upgrade log+ -+ - This file is stored locally in .git/annex/, not in the git-annex branch.+ -+ - The format: "version timestamp"+ -+ - Copyright 2022 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Logs.Upgrade (+ writeUpgradeLog,+ readUpgradeLog,+ timeOfUpgrade,+) where++import Annex.Common+import Utility.TimeStamp+import Logs.File+import Types.RepoVersion++import Data.Time.Clock.POSIX++writeUpgradeLog :: RepoVersion -> POSIXTime-> Annex ()+writeUpgradeLog v t = do+ logfile <- fromRepo gitAnnexUpgradeLog+ appendLogFile logfile gitAnnexUpgradeLock $ encodeBL $+ show (fromRepoVersion v) ++ " " ++ show t++readUpgradeLog :: Annex [(RepoVersion, POSIXTime)]+readUpgradeLog = do+ logfile <- fromRawFilePath <$> fromRepo gitAnnexUpgradeLog+ ifM (liftIO $ doesFileExist logfile)+ ( mapMaybe parse . lines+ <$> liftIO (readFileStrict logfile)+ , return []+ )+ where+ parse line = case (readish sint, parsePOSIXTime ts) of+ (Just v, Just t) -> Just (RepoVersion v, t)+ _ -> Nothing+ where+ (sint, ts) = separate (== ' ') line++timeOfUpgrade :: RepoVersion -> Annex (Maybe POSIXTime)+timeOfUpgrade want = do+ l <- readUpgradeLog+ return $ case filter (\(v, _) -> v == want) l of+ [] -> Nothing+ l' -> Just (minimum (map snd l'))+
NEWS view
@@ -1,3 +1,10 @@+git-annex (8.20211028) upstream; urgency=medium++ This version of git-annex removes support for communicating with git-annex+ remotes that have version 6.20180312 or older installed.++ -- Joey Hess <id@joeyh.name> Wed, 05 Jan 2022 10:09:11 -0400+ git-annex (8.20200523) upstream; urgency=medium Transition notice: Commands like `git-annex get foo*` silently skip over
P2P/Annex.hs view
@@ -1,6 +1,6 @@ {- P2P protocol, Annex implementation -- - Copyright 2016-2021 Joey Hess <id@joeyh.name>+ - Copyright 2016-2022 Joey Hess <id@joeyh.name> - - Licensed under the GNU AGPL version 3 or higher. -}@@ -206,7 +206,9 @@ | rightsize -> liftIO (finalizeIncrementalVerifier iv) >>= \case Nothing -> return (True, UnVerified) Just True -> return (True, Verified)- Just False -> return (False, UnVerified)+ Just False -> do+ verificationOfContentFailed (toRawFilePath dest)+ return (False, UnVerified) | otherwise -> return (False, UnVerified) Nothing -> return (rightsize, UnVerified) Right (Just Invalid) | l == 0 ->
README view
@@ -1,6 +1,7 @@-git-annex allows managing files with git, without checking the file-contents into git. While that may seem paradoxical, it is useful when-dealing with files larger than git can currently easily handle, whether due-to limitations in memory, checksumming time, or disk space.+git-annex allows managing large files with git, without storing the file+contents in git. It can sync, backup, and archive your data, offline+and online. Checksums and encryption keep your data safe and secure. Bring+the power and distributed nature of git to bear on your large files with+git-annex. For documentation, see doc/ or <https://git-annex.branchable.com/>
Remote/Adb.hs view
@@ -43,6 +43,8 @@ (FieldDesc "location on the Android device where the files are stored") , optionalStringParser androidserialField (FieldDesc "sometimes needed to specify which Android device to use")+ , yesNoParser ignorefinderrorField (Just False)+ (FieldDesc "ignore adb find errors") ] , setup = adbSetup , exportSupported = exportIsSupported@@ -56,6 +58,10 @@ androidserialField :: RemoteConfigField androidserialField = Accepted "androidserial" +ignorefinderrorField :: RemoteConfigField+ignorefinderrorField = Accepted "ignorefinderror"++ gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote) gen r u rc gc rs = do c <- parsedRemoteConfig remote rc@@ -83,7 +89,7 @@ , renameExport = renameExportM serial adir } , importActions = ImportActions- { listImportableContents = listImportableContentsM serial adir+ { listImportableContents = listImportableContentsM serial adir c , importKey = Nothing , retrieveExportWithContentIdentifier = retrieveExportWithContentIdentifierM serial adir , storeExportWithContentIdentifier = storeExportWithContentIdentifierM serial adir@@ -202,6 +208,7 @@ showOutput -- make way for adb pull output liftIO $ boolSystem "adb" $ mkAdbCommand serial [ Param "pull"+ , Param "-a" , File $ fromAndroidPath src , File dest ]@@ -288,13 +295,13 @@ , File newloc ] -listImportableContentsM :: AndroidSerial -> AndroidPath -> Annex (Maybe (ImportableContentsChunkable Annex (ContentIdentifier, ByteSize)))-listImportableContentsM serial adir = adbfind >>= \case+listImportableContentsM :: AndroidSerial -> AndroidPath -> ParsedRemoteConfig -> Annex (Maybe (ImportableContentsChunkable Annex (ContentIdentifier, ByteSize)))+listImportableContentsM serial adir c = adbfind >>= \case Just ls -> return $ Just $ ImportableContentsComplete $ ImportableContents (mapMaybe mk ls) [] Nothing -> giveup "adb find failed" where- adbfind = adbShell serial+ adbfind = adbShell' serial [ Param "find" -- trailing slash is needed, or android's find command -- won't recurse into the directory@@ -303,8 +310,11 @@ , Param "-exec", Param "stat" , Param "-c", Param statformat , Param "{}", Param "+"- ]+ ] + (if ignorefinderror then "|| true" else "") + ignorefinderror = fromMaybe False (getRemoteConfigValue ignorefinderrorField c)+ statformat = adbStatFormat ++ "\t%n" mk ('S':'T':'\t':l) =@@ -389,8 +399,11 @@ -- -- Any stdout from the command is returned, separated into lines. adbShell :: AndroidSerial -> [CommandParam] -> Annex (Maybe [String])-adbShell serial cmd = adbShellRaw serial $- unwords $ map shellEscape (toCommand cmd)+adbShell serial cmd = adbShell' serial cmd ""++adbShell' :: AndroidSerial -> [CommandParam] -> String -> Annex (Maybe [String])+adbShell' serial cmd extra = adbShellRaw serial $+ (unwords $ map shellEscape (toCommand cmd)) ++ extra adbShellBool :: AndroidSerial -> [CommandParam] -> Annex Bool adbShellBool serial cmd =
Remote/Git.hs view
@@ -30,6 +30,7 @@ import Annex.Transfer import Annex.CopyFile import Annex.Verify+import Annex.Content (verificationOfContentFailed) import Annex.UUID import qualified Annex.Content import qualified Annex.BranchState@@ -706,7 +707,9 @@ ifM (liftIO (catchBoolIO (linker src dest))) ( ifM check ( return (True, Verified)- , return (False, UnVerified)+ , do+ verificationOfContentFailed (toRawFilePath dest)+ return (False, UnVerified) ) , copier src dest k p check verifyconfig )@@ -717,7 +720,9 @@ fileCopier copycowtried src dest p iv >>= \case Copied -> ifM check ( finishVerifyKeyContentIncrementally iv- , return (False, UnVerified)+ , do+ verificationOfContentFailed (toRawFilePath dest)+ return (False, UnVerified) ) CopiedCoW -> unVerified check
Remote/Helper/Ssh.hs view
@@ -1,6 +1,6 @@ {- git-annex remote access with ssh and git-annex-shell -- - Copyright 2011-2018 Joey Hess <id@joeyh.name>+ - Copyright 2011-2022 Joey Hess <id@joeyh.name> - - Licensed under the GNU AGPL version 3 or higher. -}@@ -27,7 +27,6 @@ import qualified P2P.Annex as P2P import Control.Concurrent.STM-import Control.Concurrent.Async toRepo :: ConsumeStdin -> Git.Repo -> RemoteGitConfig -> SshCommand -> Annex (FilePath, [CommandParam]) toRepo cs r gc remotecmd = do@@ -178,18 +177,15 @@ gc = gitconfig r -- A connection over ssh to git-annex shell speaking the P2P protocol.-type P2PSshConnection = P2P.ClosableConnection- (P2P.RunState, P2P.P2PConnection, ProcessHandle, TVar StderrHandlerState)--data StderrHandlerState = DiscardStderr | DisplayStderr | EndStderrHandler+type P2PSshConnection = P2P.ClosableConnection + (P2P.RunState, P2P.P2PConnection, ProcessHandle) closeP2PSshConnection :: P2PSshConnection -> IO (P2PSshConnection, Maybe ExitCode) closeP2PSshConnection P2P.ClosedConnection = return (P2P.ClosedConnection, Nothing)-closeP2PSshConnection (P2P.OpenConnection (_st, conn, pid, stderrhandlerst)) =+closeP2PSshConnection (P2P.OpenConnection (_st, conn, pid)) = -- mask async exceptions, avoid cleanup being interrupted uninterruptibleMask_ $ do P2P.closeConnection conn- atomically $ writeTVar stderrhandlerst EndStderrHandler exitcode <- waitForProcess pid return (P2P.ClosedConnection, Just exitcode) @@ -244,11 +240,10 @@ Just (cmd, params) -> start cmd params =<< getRepo r where start cmd params repo = liftIO $ do- (Just from, Just to, Just err, pid) <- createProcess $+ (Just from, Just to, Nothing, pid) <- createProcess $ (proc cmd (toCommand params)) { std_in = CreatePipe , std_out = CreatePipe- , std_err = CreatePipe } pidnum <- getPid pid let conn = P2P.P2PConnection@@ -259,26 +254,19 @@ , P2P.connIdent = P2P.ConnIdent $ Just $ "ssh connection " ++ show pidnum }- stderrhandlerst <- newStderrHandler err pid runst <- P2P.mkRunState P2P.Client- let c = P2P.OpenConnection (runst, conn, pid, stderrhandlerst)+ let c = P2P.OpenConnection (runst, conn, pid) -- When the connection is successful, the remote -- will send an AUTH_SUCCESS with its uuid. let proto = P2P.postAuth $ P2P.negotiateProtocolVersion P2P.maxProtocolVersion tryNonAsync (P2P.runNetProto runst conn proto) >>= \case- Right (Right (Just theiruuid)) | theiruuid == uuid r -> do- atomically $ - writeTVar stderrhandlerst DisplayStderr+ Right (Right (Just theiruuid)) | theiruuid == uuid r -> return $ Just c _ -> do (cclosed, exitcode) <- closeP2PSshConnection c -- ssh exits 255 when unable to connect to- -- server. Return a closed connection in- -- this case, to avoid the fallback action- -- being run instead, which would mean a- -- second connection attempt to this server- -- that is down.+ -- server. if exitcode == Just (ExitFailure 255) then return (Just cclosed) else do@@ -288,25 +276,6 @@ modifyTVar' connpool $ maybe (Just P2PSshUnsupported) Just -newStderrHandler :: Handle -> ProcessHandle -> IO (TVar StderrHandlerState)-newStderrHandler errh ph = do- -- stderr from git-annex-shell p2pstdio is initially discarded- -- because old versions don't support the command. Once it's known- -- to be running, this is changed to DisplayStderr.- v <- newTVarIO DiscardStderr- void $ async $ go v- return v- where- go v = do- hGetLineUntilExitOrEOF ph errh >>= \case- Nothing -> hClose errh- Just l -> atomically (readTVar v) >>= \case- DiscardStderr -> go v- DisplayStderr -> do- hPutStrLn stderr l- go v- EndStderrHandler -> hClose errh- -- Runs a P2P Proto action on a remote when it supports that, -- otherwise the fallback action. runProto :: Remote -> P2PSshConnectionPool -> Annex a -> P2P.Proto a -> Annex (Maybe a)@@ -323,7 +292,7 @@ runProtoConn :: P2P.Proto a -> P2PSshConnection -> Annex (P2PSshConnection, Maybe a) runProtoConn _ P2P.ClosedConnection = return (P2P.ClosedConnection, Nothing)-runProtoConn a conn@(P2P.OpenConnection (runst, c, _, _)) = do+runProtoConn a conn@(P2P.OpenConnection (runst, c, _)) = do P2P.runFullProto runst c a >>= \case Right r -> return (conn, Just r) -- When runFullProto fails, the connection is no longer
+ Types/Upgrade.hs view
@@ -0,0 +1,10 @@+{- git-annex upgrade types+ -+ - Copyright 2022 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Types.Upgrade where++data UpgradeResult = UpgradeSuccess | UpgradeFailed | UpgradeDeferred
Upgrade.hs view
@@ -1,6 +1,6 @@ {- git-annex upgrade support -- - Copyright 2010-2020 Joey Hess <id@joeyh.name>+ - Copyright 2010-2022 Joey Hess <id@joeyh.name> - - Licensed under the GNU AGPL version 3 or higher. -}@@ -10,12 +10,14 @@ module Upgrade where import Annex.Common+import Types.Upgrade import qualified Annex import qualified Git import Config import Annex.Path import Annex.Version import Types.RepoVersion+import Logs.Upgrade #ifndef mingw32_HOST_OS import qualified Upgrade.V0 import qualified Upgrade.V1@@ -26,8 +28,11 @@ import qualified Upgrade.V5 import qualified Upgrade.V6 import qualified Upgrade.V7+import qualified Upgrade.V8+import qualified Upgrade.V9 import qualified Data.Map as M+import Data.Time.Clock.POSIX checkUpgrade :: RepoVersion -> Annex () checkUpgrade = maybe noop giveup <=< needsUpgrade@@ -37,7 +42,7 @@ | v `elem` supportedVersions = ok | otherwise = case M.lookup v autoUpgradeableVersions of Nothing- | v `elem` upgradableVersions ->+ | v `elem` upgradeableVersions -> err "Upgrade this repository: git-annex upgrade" | otherwise -> err "Upgrade git-annex."@@ -62,25 +67,27 @@ upgrade :: Bool -> RepoVersion -> Annex Bool upgrade automatic destversion = do- upgraded <- go =<< getVersion- when upgraded- postupgrade+ (upgraded, newversion) <- go =<< getVersion+ when upgraded $+ postupgrade newversion return upgraded where go (Just v)- | v >= destversion = return True+ | v >= destversion = return (True, Just v) | otherwise = ifM upgradingRemote ( upgraderemote- , ifM (up v)- ( go (Just (RepoVersion (fromRepoVersion v + 1)))- , return False- )+ , up v >>= \case+ UpgradeSuccess -> go (Just (incrversion v) )+ UpgradeFailed -> return (False, Just v)+ UpgradeDeferred -> return (True, Just v) )- go _ = return True+ go Nothing = return (True, Nothing) - postupgrade = ifM upgradingRemote+ incrversion v = RepoVersion (fromRepoVersion v + 1)++ postupgrade newversion = ifM upgradingRemote ( reloadConfig- , setVersion destversion+ , maybe noop upgradedto newversion ) #ifndef mingw32_HOST_OS@@ -96,7 +103,9 @@ up (RepoVersion 5) = Upgrade.V5.upgrade automatic up (RepoVersion 6) = Upgrade.V6.upgrade automatic up (RepoVersion 7) = Upgrade.V7.upgrade automatic- up _ = return True+ up (RepoVersion 8) = Upgrade.V8.upgrade automatic+ up (RepoVersion 9) = Upgrade.V9.upgrade automatic+ up _ = return UpgradeDeferred -- Upgrade local remotes by running git-annex upgrade in them. -- This avoids complicating the upgrade code by needing to handle@@ -109,9 +118,13 @@ ] (\p -> p { cwd = Just rp }) (\_ _ _ pid -> waitForProcess pid >>= return . \case- ExitSuccess -> True- _ -> False+ ExitSuccess -> (True, Nothing)+ _ -> (False, Nothing) )++ upgradedto v = do+ setVersion v+ writeUpgradeLog v =<< liftIO getPOSIXTime upgradingRemote :: Annex Bool upgradingRemote = isJust <$> fromRepo Git.remoteName
Upgrade/V0.hs view
@@ -8,10 +8,11 @@ module Upgrade.V0 where import Annex.Common+import Types.Upgrade import Annex.Content import qualified Upgrade.V1 -upgrade :: Annex Bool+upgrade :: Annex UpgradeResult upgrade = do showAction "v0 to v1"
Upgrade/V1.hs view
@@ -17,6 +17,7 @@ import qualified System.FilePath.ByteString as P import Annex.Common+import Types.Upgrade import Annex.Content import Annex.Link import Annex.Perms@@ -53,7 +54,7 @@ -- Something similar to the migrate subcommand could be used, -- and users could then run that at their leisure. -upgrade :: Annex Bool+upgrade :: Annex UpgradeResult upgrade = do showAction "v1 to v2"
Upgrade/V2.hs view
@@ -8,6 +8,7 @@ module Upgrade.V2 where import Annex.Common+import Types.Upgrade import qualified Git import qualified Git.Command import qualified Git.Ref@@ -38,7 +39,7 @@ - * Remove stuff that used to be needed in .gitattributes. - * Commit changes. -}-upgrade :: Annex Bool+upgrade :: Annex UpgradeResult upgrade = do showAction "v2 to v3" bare <- fromRepo Git.repoIsLocalBare@@ -63,7 +64,7 @@ unless bare push - return True+ return UpgradeSuccess locationLogs :: Annex [(Key, FilePath)] locationLogs = do
Upgrade/V4.hs view
@@ -8,8 +8,9 @@ module Upgrade.V4 where import Annex.Common+import Types.Upgrade {- Was only used for direct mode upgrade. v4 to v5 indirect update is a no-op, - and direct mode is no longer supported, so nothing needs to be done. -}-upgrade :: Bool -> Annex Bool-upgrade _automatic = return True+upgrade :: Bool -> Annex UpgradeResult+upgrade _automatic = return UpgradeSuccess
Upgrade/V5.hs view
@@ -10,6 +10,7 @@ module Upgrade.V5 where import Annex.Common+import Types.Upgrade import Config import Config.Smudge import Annex.InodeSentinal@@ -36,7 +37,7 @@ import qualified Data.ByteString as S -upgrade :: Bool -> Annex Bool+upgrade :: Bool -> Annex UpgradeResult upgrade automatic = flip catchNonAsync onexception $ do unless automatic $ showAction "v5 to v6"@@ -55,11 +56,11 @@ -- use direct mode may not have created it. unlessM isDirect $ createInodeSentinalFile True- return True+ return UpgradeSuccess where onexception e = do warning $ "caught exception: " ++ show e- return False+ return UpgradeFailed -- git before 2.22 would OOM running git status on a large file. --
Upgrade/V6.hs view
@@ -8,14 +8,15 @@ module Upgrade.V6 where import Annex.Common+import Types.Upgrade import Config import Annex.Hook -upgrade :: Bool -> Annex Bool+upgrade :: Bool -> Annex UpgradeResult upgrade automatic = do unless automatic $ showAction "v6 to v7" unlessM isBareRepo $ do hookWrite postCheckoutHook hookWrite postMergeHook- return True+ return UpgradeSuccess
Upgrade/V7.hs view
@@ -12,6 +12,7 @@ import qualified Annex import Annex.Common+import Types.Upgrade import Annex.CatFile import qualified Database.Keys import qualified Database.Keys.SQL@@ -23,7 +24,7 @@ import qualified System.FilePath.ByteString as P -upgrade :: Bool -> Annex Bool+upgrade :: Bool -> Annex UpgradeResult upgrade automatic = do unless automatic $ showAction "v7 to v8"@@ -54,7 +55,7 @@ updateSmudgeFilter - return True+ return UpgradeSuccess gitAnnexKeysDbOld :: Git.Repo -> RawFilePath gitAnnexKeysDbOld r = gitAnnexDir r P.</> "keys"
+ Upgrade/V8.hs view
@@ -0,0 +1,21 @@+{- git-annex v8 -> v9 upgrade support+ -+ - Copyright 2022 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Upgrade.V8 where++import Annex.Common+import Types.Upgrade+import Config.Smudge++upgrade :: Bool -> Annex UpgradeResult+upgrade automatic = do+ unless automatic $+ showAction "v8 to v9"++ configureSmudgeFilterProcess++ return UpgradeSuccess
+ Upgrade/V9.hs view
@@ -0,0 +1,103 @@+{- git-annex v9 -> v10 upgrade support+ -+ - Copyright 2022 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Upgrade.V9 where++import Annex.Common+import qualified Annex+import Types.Upgrade+import Annex.Content+import Annex.Perms+import Annex.LockFile+import Annex.Version+import Git.ConfigTypes+import Types.RepoVersion+import Logs.Upgrade+import Utility.Daemon++import Data.Time.Clock.POSIX++upgrade :: Bool -> Annex UpgradeResult+upgrade automatic+ | automatic = ifM oldprocessesdanger+ ( return UpgradeDeferred+ , performUpgrade automatic+ )+ | otherwise = ifM (oldprocessesdanger <&&> (not <$> Annex.getState Annex.force))+ ( do+ warning $ unlines unsafeupgrade+ return UpgradeDeferred+ , performUpgrade automatic+ )+ where+ {- Wait until a year after the v9 upgrade, to give time for+ - any old processes that were running before the v9 upgrade+ - to finish. Such old processes lock content using the old method,+ - and it is not safe for such to still be running after+ - this upgrade. -}+ oldprocessesdanger = timeOfUpgrade (RepoVersion 9) >>= \case+ Nothing -> pure True+ Just t -> do+ now <- liftIO getPOSIXTime+ if now - 365*24*60*60 > t+ then return True+ else not <$> assistantrunning++ {- Skip upgrade when git-annex assistant (or watch) is running,+ - because these are long-running daemons that could conceivably+ - run for an entire year and so predate the v9 upgrade. -}+ assistantrunning = do+ pidfile <- fromRepo gitAnnexPidFile+ isJust <$> liftIO (checkDaemon (fromRawFilePath pidfile))+ + unsafeupgrade =+ [ "Not upgrading from v9 to v10, because there may be git-annex"+ , "processes running that predate the v9 upgrade. Upgrading with"+ , "such processes running could lead to data loss. This upgrade"+ , "will be deferred until one year after the v9 upgrade to make"+ , "sure there are no such old processes running."+ , "(Use --force to upgrade immediately.)"+ ]++performUpgrade :: Bool -> Annex UpgradeResult+performUpgrade automatic = do+ unless automatic $+ showAction "v9 to v10"+ + {- Take a lock to ensure that there are no other git-annex+ - processes running that are using the old content locking method. -}+ withExclusiveLock gitAnnexContentLockLock $ do+ {- When core.sharedRepository is set, object files+ - used to have their write bits set. That can now be+ - removed, if the user the upgrade is running as has+ - permission to remove it.+ - (Otherwise, a later fsck will fix up the permissions.) -}+ withShared $ \sr -> case sr of+ GroupShared -> removewrite sr+ AllShared -> removewrite sr+ _ -> return ()++ {- Set the new version while still holding the lock,+ - so that any other process waiting for the lock will+ - be able to detect that the upgrade happened. -}+ setVersion newver++ return UpgradeSuccess+ where+ newver = RepoVersion 10++ removewrite sr = do+ ks <- listKeys InAnnex+ forM_ ks $ \k -> do+ obj <- calcRepo (gitAnnexLocation k)+ keystatus <- getKeyStatus k+ case keystatus of+ KeyPresent -> void $ tryIO $+ freezeContent'' sr obj (Just newver)+ KeyUnlockedThin -> return ()+ KeyLockedThin -> return ()+ KeyMissing -> return ()
doc/git-annex-enable-tor.mdwn view
@@ -18,7 +18,7 @@ as output by `id -u` After this command is run, `git annex remotedaemon` can be run to serve the-tor hidden service, and then `git-annex p2p --gen-address` can be run to+tor hidden service, and then `git-annex p2p --gen-addresses` can be run to give other users access to your repository via the tor hidden service. # OPTIONS
doc/git-annex-init.mdwn view
@@ -45,8 +45,8 @@ Force the repository to be initialized using a different annex.version than the current default. - When the version given is one that automatically upgrades to a newer- version, it will automatically use the newer version instead.+ When the version given is not supported, but can be automatically+ upgraded to a newer version, it will use the newer version instead. * --autoenable
git-annex.cabal view
@@ -1,11 +1,11 @@ Name: git-annex-Version: 8.20211231+Version: 10.20220127 Cabal-Version: >= 1.10 License: AGPL-3 Maintainer: Joey Hess <id@joeyh.name> Author: Joey Hess Stability: Stable-Copyright: 2010-2021 Joey Hess+Copyright: 2010-2022 Joey Hess License-File: COPYRIGHT Homepage: http://git-annex.branchable.com/ Build-type: Custom@@ -943,6 +943,7 @@ Logs.UUID Logs.UUIDBased Logs.Unused+ Logs.Upgrade Logs.View Logs.Web Messages@@ -1055,6 +1056,7 @@ Types.Transitions Types.TrustLevel Types.UUID+ Types.Upgrade Types.UrlContents Types.VectorClock Types.View@@ -1069,6 +1071,8 @@ Upgrade.V5.Direct Upgrade.V6 Upgrade.V7+ Upgrade.V8+ Upgrade.V9 Utility.Aeson Utility.Android Utility.Applicative