git-annex/Command/Indirect.hs
Joey Hess 07f1e638ee
annex.securehashesonly
Cryptographically secure hashes can be forced to be used in a repository,
by setting annex.securehashesonly. This does not prevent the git repository
from containing files with insecure hashes, but it does prevent the content
of such files from being pulled into .git/annex/objects from another
repository.

We want to make sure that at no point does git-annex accept content into
.git/annex/objects that is hashed with an insecure key. Here's how it
was done:

* .git/annex/objects/xx/yy/KEY/ is kept frozen, so nothing can be
  written to it normally
* So every place that writes content must call, thawContent or modifyContent.
  We can audit for these, and be sure we've considered all cases.
* The main functions are moveAnnex, and linkToAnnex; these were made to
  check annex.securehashesonly, and are the main security boundary
  for annex.securehashesonly.
* Most other calls to modifyContent deal with other files in the KEY
  directory (inode cache etc). The other ones that mess with the content
  are:
	- Annex.Direct.toDirectGen, in which content already in the
	  annex directory is moved to the direct mode file, so not relevant.
	- fix and lock, which don't add new content
	- Command.ReKey.linkKey, which manually unlocks it to make a
	  copy.
* All other calls to thawContent appear safe.

Made moveAnnex return a Bool, so checked all callsites and made them
deal with a failure in appropriate ways.

linkToAnnex simply returns LinkAnnexFailed; all callsites already deal
with it failing in appropriate ways.

This commit was sponsored by Riku Voipio.
2017-02-27 13:33:59 -04:00

105 lines
2.6 KiB
Haskell

{- git-annex command
-
- Copyright 2012 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.Indirect where
import Command
import qualified Git
import qualified Git.Branch
import qualified Git.LsFiles
import Git.FileMode
import Config
import qualified Annex
import Annex.Direct
import Annex.Content
import Annex.Content.Direct
import Annex.CatFile
import Annex.Init
import Annex.Ingest
cmd :: Command
cmd = notBareRepo $ noDaemonRunning $
command "indirect" SectionSetup "switch repository to indirect mode"
paramNothing (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withNothing start
start :: CommandStart
start = ifM isDirect
( do
unlessM (coreSymlinks <$> Annex.getGitConfig) $
giveup "Git is configured to not use symlinks, so you must use direct mode."
whenM probeCrippledFileSystem $
giveup "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.Branch.commitCommand Git.Branch.ManualCommit
[ 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 (f, Just sha, Just mode) | isSymLink mode = do
r <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus f
case r of
Just s
| isSymbolicLink s -> void $ flip whenAnnexed f $
\_ k -> do
removeInodeCache k
removeAssociatedFiles k
return Nothing
| otherwise ->
maybe noop (fromdirect f)
=<< catKey sha
_ -> noop
go _ = noop
fromdirect f k = do
showStart "indirect" f
removeInodeCache k
removeAssociatedFiles k
whenM (liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f) $ do
v <- tryNonAsync (moveAnnex k f)
case v of
Right True -> do
l <- calcRepo $ gitAnnexLink f k
liftIO $ createSymbolicLink l f
Right False -> warnlocked "Failed to move file to annex"
Left e -> catchNonAsync (restoreFile f k e) $
warnlocked . show
showEndOk
warnlocked msg = do
warning msg
warning "leaving this file as-is; correct this problem and run git annex add on it"
cleanup :: CommandCleanup
cleanup = do
showStart "indirect" ""
showEndOk
return True