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.
		
			
				
	
	
		
			105 lines
		
	
	
	
		
			2.6 KiB
			
		
	
	
	
		
			Haskell
		
	
	
	
	
	
			
		
		
	
	
			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
 |