git-annex/Command/Indirect.hs
Joey Hess 341269e035 git-annex (4.20130815) unstable; urgency=low
* assistant, watcher: .gitignore files and other git ignores are now
    honored, when git 1.8.4 or newer is installed.
    (Thanks, Adam Spiers, for getting the necessary support into git for this.)
  * importfeed: Ignores transient problems with feeds. Only exits nonzero
    when a feed has repeatedly had a problems for at least 1 day.
  * importfeed: Fix handling of dots in extensions.
  * Windows: Added support for encrypted special remotes.
  * Windows: Fixed permissions problem that prevented removing files
    from directory special remote. Directory special remotes now fully usable.

# imported from the archive
2013-08-15 04:14:33 -04:00

103 lines
2.5 KiB
Haskell

{- git-annex command
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.Indirect where
import System.PosixCompat.Files
import Common.Annex
import Command
import qualified Git
import qualified Git.Command
import qualified Git.LsFiles
import Config
import qualified Annex
import Annex.Direct
import Annex.Content
import Annex.CatFile
import Annex.Version
import Annex.Perms
import Init
def :: [Command]
def = [notBareRepo $ noDaemonRunning $
command "indirect" paramNothing seek
SectionSetup "switch repository to indirect mode"]
seek :: [CommandSeek]
seek = [withNothing start]
start :: CommandStart
start = ifM isDirect
( do
unlessM (coreSymlinks <$> Annex.getGitConfig) $
error "Git is configured to not use symlinks, so you must use direct mode."
whenM probeCrippledFileSystem $
error "This repository seems to be on a crippled filesystem, you must use direct mode."
next perform
, stop
)
perform :: CommandPerform
perform = do
showStart "commit" ""
whenM (stageDirect) $ do
showOutput
void $ inRepo $ Git.Command.runBool
[ Param "commit"
, Param "-m"
, Param "commit before switching to indirect mode"
]
showEndOk
-- Note that we set indirect mode early, so that we can use
-- moveAnnex in indirect mode.
setDirect False
top <- fromRepo Git.repoPath
(l, clean) <- inRepo $ Git.LsFiles.stagedOthersDetails [top]
forM_ l go
void $ liftIO clean
next cleanup
where
{- Walk tree from top and move all present direct mode files into
- the annex, replacing with symlinks. Also delete direct mode
- caches and mappings. -}
go (_, Nothing) = noop
go (f, Just sha) = do
r <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus f
case r of
Just s
| isSymbolicLink s -> void $ flip whenAnnexed f $
\_ (k, _) -> do
cleandirect k
return Nothing
| otherwise ->
maybe noop (fromdirect f)
=<< catKey sha
_ -> noop
fromdirect f k = do
showStart "indirect" f
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
showEndOk
cleandirect k = do
liftIO . nukeFile =<< calcRepo (gitAnnexInodeCache k)
liftIO . nukeFile =<< calcRepo (gitAnnexMapping k)
cleanup :: CommandCleanup
cleanup = do
setVersion defaultVersion
showStart "indirect" ""
showEndOk
return True