f1b0a4b404
* since this is a crippled filesystem anyway, git-annex doesn't use symlinks on it * so there's no reason to use the mixed case hash directories that we're stuck using to avoid breaking everyone's symlinks to the content * so we can do what is already done for all bare repos, and make non-bare repos on crippled filesystems use the all-lower case hash directories * which are, happily, all 3 letters long, so they cannot conflict with mixed case hash directories * so I was able to 100% fix this and even resuming `git annex add` in the test case will recover and it will all just work.
98 lines
2.4 KiB
Haskell
98 lines
2.4 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 Init
|
|
|
|
def :: [Command]
|
|
def = [notBareRepo $ 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
|
|
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
|