diff --git a/Annex/Ingest.hs b/Annex/Ingest.hs --- a/Annex/Ingest.hs +++ b/Annex/Ingest.hs @@ -244,10 +244,9 @@ topf <- inRepo (toTopFilePath file) oldkeys <- filter (/= newkey) <$> Database.Keys.getAssociatedKey topf - forM_ oldkeys $ \key -> do - obj <- calcRepo (gitAnnexLocation key) - caches <- Database.Keys.getInodeCaches key - unlessM (sameInodeCache obj caches) $ do + forM_ oldkeys $ \key -> + unlessM (isUnmodified key =<< calcRepo (gitAnnexLocation key)) $ do + caches <- Database.Keys.getInodeCaches key unlinkAnnex key fs <- filter (/= ingestedf) . map (`fromTopFilePath` g) diff --git a/Annex/Init.hs b/Annex/Init.hs --- a/Annex/Init.hs +++ b/Annex/Init.hs @@ -31,6 +31,7 @@ import Annex.Difference import Annex.UUID import Annex.Link +import Annex.WorkTree import Config import Annex.Direct import Annex.AdjustedBranch @@ -39,7 +40,6 @@ import Annex.InodeSentinal import Upgrade import Annex.Perms -import qualified Database.Keys import Utility.UserInfo #ifndef mingw32_HOST_OS import Utility.FileMode @@ -90,7 +90,7 @@ setVersion (fromMaybe defaultVersion mversion) whenM versionSupportsUnlockedPointers $ do configureSmudgeFilter - Database.Keys.scanAssociatedFiles + scanUnlockedFiles v <- checkAdjustedClone case v of NeedUpgradeForAdjustedClone -> diff --git a/Annex/Locations.hs b/Annex/Locations.hs --- a/Annex/Locations.hs +++ b/Annex/Locations.hs @@ -63,6 +63,7 @@ gitAnnexUrlFile, gitAnnexTmpCfgFile, gitAnnexSshDir, + gitAnnexSshConfig, gitAnnexRemotesDir, gitAnnexAssistantDefaultDir, HashLevels(..), @@ -401,6 +402,10 @@ {- .git/annex/ssh/ is used for ssh connection caching -} gitAnnexSshDir :: Git.Repo -> FilePath gitAnnexSshDir r = addTrailingPathSeparator $ gitAnnexDir r "ssh" + +{- .git/annex/ssh.config is used to configure ssh. -} +gitAnnexSshConfig :: Git.Repo -> FilePath +gitAnnexSshConfig r = gitAnnexDir r "ssh.config" {- .git/annex/remotes/ is used for remote-specific state. -} gitAnnexRemotesDir :: Git.Repo -> FilePath diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs --- a/Annex/Ssh.hs +++ b/Annex/Ssh.hs @@ -33,6 +33,7 @@ import Config import Annex.Path import Utility.Env +import Utility.Tmp import Types.CleanupActions import Git.Env #ifndef mingw32_HOST_OS @@ -49,13 +50,33 @@ go (Just socketfile, params) = do prepSocket socketfile ret params - ret ps = return $ concat - [ ps - , map Param (remoteAnnexSshOptions gc) - , opts - , portParams port - , [Param "-T"] - ] + ret ps = do + overideconfigfile <- fromRepo gitAnnexSshConfig + -- We assume that the file content does not change. + -- If it did, a more expensive test would be needed. + liftIO $ unlessM (doesFileExist overideconfigfile) $ + viaTmp writeFile overideconfigfile $ unlines + -- ssh expands "~" + [ "Include ~/.ssh/config" + -- ssh will silently skip the file + -- if it does not exist + , "Include /etc/ssh/ssh_config" + -- Everything below this point is only + -- used if there's no setting for it in + -- the above files. + -- + -- Make sure that ssh detects stalled + -- connections. + , "ServerAliveInterval 60" + ] + return $ concat + [ ps + , [Param "-F", File overideconfigfile] + , map Param (remoteAnnexSshOptions gc) + , opts + , portParams port + , [Param "-T"] + ] {- Returns a filename to use for a ssh connection caching socket, and - parameters to enable ssh connection caching. -} @@ -136,11 +157,20 @@ liftIO $ createDirectoryIfMissing True $ parentDir socketfile lockFileCached $ socket2lock socketfile +{- Find ssh socket files. + - + - The check that the lock file exists makes only socket files + - that were set up by prepSocket be found. On some NFS systems, + - a deleted socket file may linger for a while under another filename; + - and this check makes such files be skipped since the corresponding lock + - file won't exist. + -} enumSocketFiles :: Annex [FilePath] -enumSocketFiles = go =<< sshCacheDir +enumSocketFiles = liftIO . go =<< sshCacheDir where go Nothing = return [] - go (Just dir) = liftIO $ filter (not . isLock) + go (Just dir) = filterM (doesFileExist . socket2lock) + =<< filter (not . isLock) <$> catchDefaultIO [] (dirContents dir) {- Stop any unused ssh connection caching processes. -} diff --git a/Annex/WorkTree.hs b/Annex/WorkTree.hs --- a/Annex/WorkTree.hs +++ b/Annex/WorkTree.hs @@ -1,6 +1,6 @@ {- git-annex worktree files - - - Copyright 2013-2015 Joey Hess + - Copyright 2013-2016 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -11,7 +11,17 @@ import Annex.Link import Annex.CatFile import Annex.Version +import Annex.Content +import Annex.ReplaceFile import Config +import Git.FilePath +import qualified Git.Ref +import qualified Git.Branch +import qualified Git.LsTree +import qualified Git.Types +import Database.Types +import qualified Database.Keys +import qualified Database.Keys.SQL {- Looks up the key corresponding to an annexed file in the work tree, - by examining what the file links to. @@ -41,3 +51,43 @@ ifAnnexed :: FilePath -> (Key -> Annex a) -> Annex a -> Annex a ifAnnexed file yes no = maybe no yes =<< lookupFile file + +{- Find all unlocked files and update the keys database for them. + - + - This is expensive, and so normally the associated files are updated + - incrementally when changes are noticed. So, this only needs to be done + - when initializing/upgrading a v6 mode repository. + - + - Also, the content for the unlocked file may already be present as + - an annex object. If so, make the unlocked file use that content. + -} +scanUnlockedFiles :: Annex () +scanUnlockedFiles = whenM (isJust <$> inRepo Git.Branch.current) $ do + showSideAction "scanning for unlocked files" + Database.Keys.runWriter $ + liftIO . Database.Keys.SQL.dropAllAssociatedFiles + (l, cleanup) <- inRepo $ Git.LsTree.lsTree Git.Ref.headRef + forM_ l $ \i -> + when (isregfile i) $ + maybe noop (add i) + =<< catKey (Git.LsTree.sha i) + liftIO $ void cleanup + where + isregfile i = case Git.Types.toBlobType (Git.LsTree.mode i) of + Just Git.Types.FileBlob -> True + Just Git.Types.ExecutableBlob -> True + _ -> False + add i k = do + let tf = Git.LsTree.file i + Database.Keys.runWriter $ + liftIO . Database.Keys.SQL.addAssociatedFileFast (toIKey k) tf + whenM (inAnnex k) $ do + f <- fromRepo $ fromTopFilePath tf + destmode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus f + replaceFile f $ \tmp -> do + r <- linkFromAnnex k tmp destmode + case r of + LinkAnnexOk -> return () + LinkAnnexNoop -> return () + LinkAnnexFailed -> liftIO $ + writePointerFile tmp k destmode diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,26 @@ +git-annex (6.20161027) unstable; urgency=medium + + * lock, smudge: Fix edge cases where data loss could occur in v6 mode + when the keys database was not populated. + * upgrade: Handle upgrade to v6 when the repository already contains + v6 unlocked files whose content is already present. + * Improve style of offline html build of website. + * importfeed: Drop URL parameters from file extension. + Thanks, James MacMahon. + * Assistant, repair: Improved filtering out of git fsck lines about + duplicate file entries in tree objects. + * test: Deal with gpg-agent behavior change that broke the test suite. + * Improve ssh socket cleanup code to skip over the cruft that + NFS sometimes puts in a directory when a file is being deleted. + * If a transfer fails for some reason, but some data managed to be sent, + the transfer will be retried. (The assistant already did this.) + * Run ssh with ServerAliveInterval 60, so that stalled transfers will + be noticed within about 3 minutes. + (Any setting in your ~/.ssh/config or /etc/ssh/ssh_config + overrides this.) + + -- Joey Hess Thu, 27 Oct 2016 15:21:58 -0400 + git-annex (6.20161012) unstable; urgency=medium * Optimisations to time it takes git-annex to walk working tree and find diff --git a/Command/Get.hs b/Command/Get.hs --- a/Command/Get.hs +++ b/Command/Get.hs @@ -109,7 +109,7 @@ either (const False) id <$> Remote.hasKey r key | otherwise = return True docopy r witness = getViaTmp (RemoteVerify r) key $ \dest -> - download (Remote.uuid r) key afile noRetry + download (Remote.uuid r) key afile forwardRetry (\p -> do showAction $ "from " ++ Remote.name r Remote.retrieveKeyFile r key afile dest p diff --git a/Command/ImportFeed.hs b/Command/ImportFeed.hs --- a/Command/ImportFeed.hs +++ b/Command/ImportFeed.hs @@ -161,7 +161,7 @@ performDownload :: ImportFeedOptions -> Cache -> ToDownload -> Annex Bool performDownload opts cache todownload = case location todownload of Enclosure url -> checkknown url $ - rundownload url (takeExtension url) $ \f -> do + rundownload url (takeWhile (/= '?') $ takeExtension url) $ \f -> do r <- Remote.claimingUrl url if Remote.uuid r == webUUID || rawOption opts then do diff --git a/Command/Lock.hs b/Command/Lock.hs --- a/Command/Lock.hs +++ b/Command/Lock.hs @@ -45,27 +45,27 @@ ) where go (Just key') - | key' == key = cont True + | key' == key = cont | otherwise = errorModified go Nothing = ifM (isUnmodified key file) - ( cont False + ( cont , ifM (Annex.getState Annex.force) - ( cont True + ( cont , errorModified ) ) - cont = next . performNew file key + cont = next $ performNew file key -performNew :: FilePath -> Key -> Bool -> CommandPerform -performNew file key filemodified = do +performNew :: FilePath -> Key -> CommandPerform +performNew file key = do lockdown =<< calcRepo (gitAnnexLocation key) addLink file key =<< withTSDelta (liftIO . genInodeCache file) next $ cleanupNew file key where lockdown obj = do - ifM (catchBoolIO $ sameInodeCache obj =<< Database.Keys.getInodeCaches key) + ifM (isUnmodified key obj) ( breakhardlink obj , repopulate obj ) @@ -83,20 +83,18 @@ Database.Keys.storeInodeCaches key [obj] -- Try to repopulate obj from an unmodified associated file. - repopulate obj - | filemodified = modifyContent obj $ do - g <- Annex.gitRepo - fs <- map (`fromTopFilePath` g) - <$> Database.Keys.getAssociatedFiles key - mfile <- firstM (isUnmodified key) fs - liftIO $ nukeFile obj - case mfile of - Just unmodified -> - unlessM (checkedCopyFile key unmodified obj Nothing) - lostcontent - Nothing -> lostcontent - | otherwise = modifyContent obj $ - liftIO $ renameFile file obj + repopulate obj = modifyContent obj $ do + g <- Annex.gitRepo + fs <- map (`fromTopFilePath` g) + <$> Database.Keys.getAssociatedFiles key + mfile <- firstM (isUnmodified key) fs + liftIO $ nukeFile obj + case mfile of + Just unmodified -> + unlessM (checkedCopyFile key unmodified obj Nothing) + lostcontent + Nothing -> lostcontent + lostcontent = logStatus key InfoMissing cleanupNew :: FilePath -> Key -> CommandCleanup diff --git a/Command/Move.hs b/Command/Move.hs --- a/Command/Move.hs +++ b/Command/Move.hs @@ -114,7 +114,7 @@ Right False -> do showAction $ "to " ++ Remote.name dest ok <- notifyTransfer Upload afile $ - upload (Remote.uuid dest) key afile noRetry $ + upload (Remote.uuid dest) key afile forwardRetry $ Remote.storeKey dest key afile if ok then finish $ @@ -177,7 +177,7 @@ ) where go = notifyTransfer Download afile $ - download (Remote.uuid src) key afile noRetry $ \p -> do + download (Remote.uuid src) key afile forwardRetry $ \p -> do showAction $ "from " ++ Remote.name src getViaTmp (RemoteVerify src) key $ \t -> Remote.retrieveKeyFile src key afile t p diff --git a/Command/SendKey.hs b/Command/SendKey.hs --- a/Command/SendKey.hs +++ b/Command/SendKey.hs @@ -48,6 +48,7 @@ liftIO $ debugM "fieldTransfer" "transfer start" afile <- Fields.getField Fields.associatedFile ok <- maybe (a $ const noop) + -- Using noRetry here because we're the sender. (\u -> runner (Transfer direction (toUUID u) key) afile noRetry a) =<< Fields.getField Fields.remoteUUID liftIO $ debugM "fieldTransfer" "transfer done" diff --git a/Command/Unlock.hs b/Command/Unlock.hs --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -56,7 +56,7 @@ case r of LinkAnnexOk -> return () LinkAnnexNoop -> return () - _ -> error "unlock failed" + LinkAnnexFailed -> error "unlock failed" , liftIO $ writePointerFile tmp key destmode ) next $ cleanupNew dest key destmode diff --git a/Database/Keys.hs b/Database/Keys.hs --- a/Database/Keys.hs +++ b/Database/Keys.hs @@ -14,11 +14,11 @@ getAssociatedFiles, getAssociatedKey, removeAssociatedFile, - scanAssociatedFiles, storeInodeCaches, addInodeCaches, getInodeCaches, removeInodeCaches, + runWriter, ) where import qualified Database.Keys.SQL as SQL @@ -33,15 +33,8 @@ import Annex.LockFile import Utility.InodeCache import Annex.InodeSentinal -import qualified Git.Types -import qualified Git.LsTree -import qualified Git.Branch -import Git.Ref import Git.FilePath -import Annex.CatFile -import Database.Esqueleto hiding (Key) - {- Runs an action that reads from the database. - - If the database doesn't already exist, it's not created; mempty is @@ -167,32 +160,6 @@ removeAssociatedFile :: Key -> TopFilePath -> Annex () removeAssociatedFile k = runWriterIO . SQL.removeAssociatedFile (toIKey k) - -{- Find all unlocked associated files. This is expensive, and so normally - - the associated files are updated incrementally when changes are noticed. -} -scanAssociatedFiles :: Annex () -scanAssociatedFiles = whenM (isJust <$> inRepo Git.Branch.current) $ - runWriter $ \h -> do - showSideAction "scanning for unlocked files" - dropallassociated h - (l, cleanup) <- inRepo $ Git.LsTree.lsTree headRef - forM_ l $ \i -> - when (isregfile i) $ - maybe noop (add h i) - =<< catKey (Git.LsTree.sha i) - liftIO $ void cleanup - where - dropallassociated h = liftIO $ flip SQL.queueDb h $ - delete $ from $ \(_r :: SqlExpr (Entity SQL.Associated)) -> - return () - isregfile i = case Git.Types.toBlobType (Git.LsTree.mode i) of - Just Git.Types.FileBlob -> True - Just Git.Types.ExecutableBlob -> True - _ -> False - add h i k = liftIO $ flip SQL.queueDb h $ - void $ insertUnique $ SQL.Associated - (toIKey k) - (toSFilePath $ getTopFilePath $ Git.LsTree.file i) {- Stats the files, and stores their InodeCaches. -} storeInodeCaches :: Key -> [FilePath] -> Annex () diff --git a/Database/Keys/SQL.hs b/Database/Keys/SQL.hs --- a/Database/Keys/SQL.hs +++ b/Database/Keys/SQL.hs @@ -68,6 +68,18 @@ where af = toSFilePath (getTopFilePath f) +-- Does not remove any old association for a file, but less expensive +-- than addAssociatedFile. Calling dropAllAssociatedFiles first and then +-- this is an efficient way to update all associated files. +addAssociatedFileFast :: IKey -> TopFilePath -> WriteHandle -> IO () +addAssociatedFileFast ik f = queueDb $ void $ insertUnique $ Associated ik af + where + af = toSFilePath (getTopFilePath f) + +dropAllAssociatedFiles :: WriteHandle -> IO () +dropAllAssociatedFiles = queueDb $ + delete $ from $ \(_r :: SqlExpr (Entity Associated)) -> return () + {- Note that the files returned were once associated with the key, but - some of them may not be any longer. -} getAssociatedFiles :: IKey -> ReadHandle -> IO [TopFilePath] diff --git a/Git/Fsck.hs b/Git/Fsck.hs --- a/Git/Fsck.hs +++ b/Git/Fsck.hs @@ -105,7 +105,7 @@ where wanted l -- Skip lines like "error in tree : duplicateEntries: contains duplicate file entries" - | "duplicateEntries" `isPrefixOf` l = False + | "duplicateEntries" `isInfixOf` l = False | supportsNoDangling = True | otherwise = not ("dangling " `isPrefixOf` l) diff --git a/Remote/Git.hs b/Remote/Git.hs --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -439,7 +439,7 @@ Just (object, checksuccess) -> do copier <- mkCopier hardlink params runTransfer (Transfer Download u key) - file noRetry + file forwardRetry (\p -> copier object dest (combineMeterUpdate p meterupdate) checksuccess) | Git.repoIsSsh (repo r) = unVerified $ feedprogressback $ \p -> do Ssh.rsyncHelper (Just (combineMeterUpdate meterupdate p)) @@ -565,7 +565,7 @@ ensureInitialized copier <- mkCopier hardlink params let verify = Annex.Content.RemoteVerify r - runTransfer (Transfer Download u key) file noRetry $ \p -> + runTransfer (Transfer Download u key) file forwardRetry $ \p -> let p' = combineMeterUpdate meterupdate p in Annex.Content.saveState True `after` Annex.Content.getViaTmp verify key diff --git a/Test.hs b/Test.hs --- a/Test.hs +++ b/Test.hs @@ -212,6 +212,7 @@ , testCase "move" test_move , testCase "copy" test_copy , testCase "lock" test_lock + , testCase "lock (v6 --force)" test_lock_v6_force , testCase "edit (no pre-commit)" test_edit , testCase "edit (pre-commit)" test_edit_precommit , testCase "partial commit" test_partial_commit @@ -612,6 +613,23 @@ assertEqual "content of modified file" c (changedcontent annexedfile) r' <- git_annex "drop" [annexedfile] not r' @? "drop wrongly succeeded with no known copy of modified file" + +-- Regression test: lock --force when work tree file +-- was modified lost the (unmodified) annex object. +-- (Only occurred when the keys database was out of sync.) +test_lock_v6_force :: Assertion +test_lock_v6_force = intmpclonerepoInDirect $ do + git_annex "upgrade" [] @? "upgrade failed" + whenM (annexeval Annex.Version.versionSupportsUnlockedPointers) $ do + git_annex "get" [annexedfile] @? "get of file failed" + git_annex "unlock" [annexedfile] @? "unlock failed in v6 mode" + annexeval $ do + dbdir <- Annex.fromRepo Annex.Locations.gitAnnexKeysDb + liftIO $ removeDirectoryRecursive dbdir + writeFile annexedfile "test_lock_v6_force content" + not <$> git_annex "lock" [annexedfile] @? "lock of modified file failed to fail in v6 mode" + git_annex "lock" ["--force", annexedfile] @? "lock --force of modified file failed in v6 mode" + annexed_present_locked annexedfile test_edit :: Assertion test_edit = test_edit' False diff --git a/Upgrade/V5.hs b/Upgrade/V5.hs --- a/Upgrade/V5.hs +++ b/Upgrade/V5.hs @@ -15,6 +15,7 @@ import Annex.Direct import Annex.Content import Annex.CatFile +import Annex.WorkTree import qualified Database.Keys import qualified Annex.Content.Direct as Direct import qualified Git @@ -31,7 +32,7 @@ upgrade automatic = do unless automatic $ showAction "v5 to v6" - Database.Keys.scanAssociatedFiles + scanUnlockedFiles whenM isDirect $ do {- Direct mode makes the same tradeoff of using less disk - space, with less preservation of old versions of files diff --git a/Utility/Gpg.hs b/Utility/Gpg.hs --- a/Utility/Gpg.hs +++ b/Utility/Gpg.hs @@ -352,7 +352,14 @@ [testSecretKey, testKey] return dir - cleanup orig tmpdir = removeDirectoryRecursive tmpdir >> reset orig + cleanup orig tmpdir = do + removeDirectoryRecursive tmpdir + -- gpg-agent may be shutting down at the same time + -- and may delete its socket at the same time as + -- we're trying to, causing an exception. Retrying + -- will deal with this race. + `catchIO` (\_ -> removeDirectoryRecursive tmpdir) + reset orig reset (Just v) = setEnv var v True reset _ = unsetEnv var diff --git a/doc/git-annex-unannex.mdwn b/doc/git-annex-unannex.mdwn --- a/doc/git-annex-unannex.mdwn +++ b/doc/git-annex-unannex.mdwn @@ -14,9 +14,10 @@ Note that for safety, the content of the file remains in the annex, until you use `git annex unused` and `git annex dropunused`. -This is not the command you should use if you intentionally annexed a -file and don't want its contents any more. In that case you should use -`git annex drop` instead, and you can also `git rm` the file. +This is not the command you should use if you intentionally added a +file some time ago, and don't want its contents any more. In that +case you should use `git annex drop` instead, and you can also +`git rm` the file. # OPTIONS diff --git a/git-annex.cabal b/git-annex.cabal --- a/git-annex.cabal +++ b/git-annex.cabal @@ -1,5 +1,5 @@ Name: git-annex -Version: 6.20161012 +Version: 6.20161027 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess