diff options
| -rw-r--r-- | Annex/Exception.hs | 5 | ||||
| -rw-r--r-- | Command/Indirect.hs | 20 | ||||
| -rw-r--r-- | debian/changelog | 2 | ||||
| -rw-r--r-- | doc/bugs/git_annex_indirect_can_fail_catastrophically.mdwn | 7 |
4 files changed, 30 insertions, 4 deletions
diff --git a/Annex/Exception.hs b/Annex/Exception.hs index 040229d65..aaa6811a5 100644 --- a/Annex/Exception.hs +++ b/Annex/Exception.hs @@ -13,6 +13,7 @@ module Annex.Exception ( bracketIO, tryAnnex, + tryAnnexIO, throwAnnex, catchAnnex, ) where @@ -30,6 +31,10 @@ bracketIO setup cleanup = M.bracket (liftIO setup) (liftIO . cleanup) tryAnnex :: Annex a -> Annex (Either SomeException a) tryAnnex = M.try +{- try in the Annex monad, but only catching IO exceptions -} +tryAnnexIO :: Annex a -> Annex (Either IOException a) +tryAnnexIO = M.try + {- throw in the Annex monad -} throwAnnex :: Exception e => e -> Annex a throwAnnex = M.throw diff --git a/Command/Indirect.hs b/Command/Indirect.hs index 22c8b2d62..a2512ea96 100644 --- a/Command/Indirect.hs +++ b/Command/Indirect.hs @@ -8,6 +8,7 @@ module Command.Indirect where import System.PosixCompat.Files +import Control.Exception.Extensible import Common.Annex import Command @@ -22,7 +23,9 @@ import Annex.Content import Annex.CatFile import Annex.Version import Annex.Perms +import Annex.Exception import Init +import qualified Command.Add def :: [Command] def = [notBareRepo $ noDaemonRunning $ @@ -87,15 +90,24 @@ perform = do thawContentDir =<< calcRepo (gitAnnexLocation k) cleandirect k -- clean before content directory gets frozen whenM (liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f) $ do - moveAnnex k f - l <- inRepo $ gitAnnexLink f k - liftIO $ createSymbolicLink l f + v <-tryAnnexIO (moveAnnex k f) + case v of + Right _ -> do + l <- inRepo $ gitAnnexLink f k + liftIO $ createSymbolicLink l f + Left e -> catchAnnex (Command.Add.undo f k e) + warnlocked showEndOk + warnlocked :: SomeException -> Annex () + warnlocked e = do + warning $ show e + warning "leaving this file as-is; correct this problem and run git annex add on it" + cleandirect k = do liftIO . nukeFile =<< calcRepo (gitAnnexInodeCache k) liftIO . nukeFile =<< calcRepo (gitAnnexMapping k) - + cleanup :: CommandCleanup cleanup = do setVersion defaultVersion diff --git a/debian/changelog b/debian/changelog index 09e395815..fad2d372e 100644 --- a/debian/changelog +++ b/debian/changelog @@ -13,6 +13,8 @@ git-annex (4.20130921) UNRELEASED; urgency=low * assistant: Clear the list of failed transfers when doing a full transfer scan. This prevents repeated retries to download files that are not available, or are not referenced by the current git tree. + * indirect: Better behavior when a file in direct mode is not owned by + the user running the conversion. -- Joey Hess <joeyh@debian.org> Sun, 22 Sep 2013 19:42:29 -0400 diff --git a/doc/bugs/git_annex_indirect_can_fail_catastrophically.mdwn b/doc/bugs/git_annex_indirect_can_fail_catastrophically.mdwn index 4da8131b2..34096d894 100644 --- a/doc/bugs/git_annex_indirect_can_fail_catastrophically.mdwn +++ b/doc/bugs/git_annex_indirect_can_fail_catastrophically.mdwn @@ -69,3 +69,10 @@ index 7835988..ed8ea6c 100644 """]] Any update on this? Why is `-a` used here? -- [[anarcat]] + +> -a is not really the problem. You certianly do usually want +> to commit your changes before converting to direct mode. +> +> [[done]]; now when this happens it catches the exception and +> leaves the file in direct mode, which is the same as it being +> unlocked. --[[Joey]] |