0807211a67
A content directory can be frozen in direct mode. One way this can happen is if the content is transferred before direct mode has a mapping for it, so it's stored in the content directory. So, we need to thaw the content directory before doing things with it.
101 lines
2.5 KiB
Haskell
101 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 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.stagedDetails [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
|