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.

1 files changed, 20 insertions, 12 deletions

diff --git a/Annex/Ingest.hs b/Annex/Ingest.hs
index 5f6e38ff2..4dabb1b58 100644
--- a/Annex/Ingest.hs
+++ b/Annex/Ingest.hs
@@ -172,10 +172,13 @@ ingest' preferredbackend (Just (LockedDown cfg source)) mk = withTSDelta $ \delt
 	go _ _ _ = failure "failed to generate a key"
 
 	golocked key mcache s = do
-		catchNonAsync (moveAnnex key $ contentLocation source)
-			(restoreFile (keyFilename source) key)
-		populateAssociatedFiles key source
-		success key mcache s
+		v <- tryNonAsync (moveAnnex key $ contentLocation source)
+		case v of
+			Right True -> do
+				populateAssociatedFiles key source
+				success key mcache s		
+			Right False -> giveup "failed to add content to annex"
+			Left e -> restoreFile (keyFilename source) key e
 
 	gounlocked key (Just cache) s = do
 		-- Remove temp directory hard link first because
@@ -352,8 +355,11 @@ cachedCurrentBranch = maybe cache (return . Just)
 
 {- Adds a file to the work tree for the key, and stages it in the index.
  - The content of the key may be provided in a temp file, which will be
- - moved into place. -}
-addAnnexedFile :: FilePath -> Key -> Maybe FilePath -> Annex ()
+ - moved into place.
+ -
+ - When the content of the key is not accepted into the annex, returns False.
+ -}
+addAnnexedFile :: FilePath -> Key -> Maybe FilePath -> Annex Bool
 addAnnexedFile file key mtmp = ifM (addUnlocked <&&> not <$> isDirect)
 	( do
 		mode <- maybe
@@ -363,12 +369,13 @@ addAnnexedFile file key mtmp = ifM (addUnlocked <&&> not <$> isDirect)
 		stagePointerFile file mode =<< hashPointerFile key
 		Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath file)
 		case mtmp of
-			Just tmp -> do
-				moveAnnex key tmp
-				linkunlocked mode
+			Just tmp -> ifM (moveAnnex key tmp)
+				( linkunlocked mode >> return True
+				, writepointer mode >> return False
+				)
 			Nothing -> ifM (inAnnex key)
-				( linkunlocked mode
-				, liftIO $ writePointerFile file key mode
+				( linkunlocked mode >> return True
+				, writepointer mode >> return True
 				)
 	, do
 		addLink file key Nothing
@@ -381,7 +388,7 @@ addAnnexedFile file key mtmp = ifM (addUnlocked <&&> not <$> isDirect)
 				whenM isDirect $
 					Annex.Queue.flush
 				moveAnnex key tmp
-			Nothing -> return ()
+			Nothing -> return True
 	)
   where
 	linkunlocked mode = do
@@ -390,3 +397,4 @@ addAnnexedFile file key mtmp = ifM (addUnlocked <&&> not <$> isDirect)
 			LinkAnnexFailed -> liftIO $
 				writePointerFile file key mode
 			_ -> return ()
+	writepointer mode = liftIO $ writePointerFile file key mode