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.

3 files changed, 13 insertions, 11 deletions

diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs
index 169875f4b..a89a25e83 100644
--- a/Command/AddUrl.hs
+++ b/Command/AddUrl.hs
@@ -356,10 +356,13 @@ cleanup u url file key mtmp = case mtmp of
   where
 	go = do
 		maybeShowJSON $ JSONChunk [("key", key2file key)]
-		when (isJust mtmp) $
-			logStatus key InfoPresent
 		setUrlPresent u key url
-		addAnnexedFile file key mtmp
+		ifM (addAnnexedFile file key mtmp)
+			( do
+				when (isJust mtmp) $
+					logStatus key InfoPresent
+			, liftIO $ maybe noop nukeFile mtmp
+			)
 
 nodownload :: URLString -> Url.UrlInfo -> FilePath -> Annex (Maybe Key)
 nodownload url urlinfo file
diff --git a/Command/Indirect.hs b/Command/Indirect.hs
index f12f9e59e..862c6e00e 100644
--- a/Command/Indirect.hs
+++ b/Command/Indirect.hs
@@ -86,16 +86,16 @@ perform = do
 		whenM (liftIO $ not . isSymbolicLink <$> getSymbolicLinkStatus f) $ do
 			v <- tryNonAsync (moveAnnex k f)
 			case v of
-				Right _ -> do 
+				Right True -> do 
 					l <- calcRepo $ gitAnnexLink f k
 					liftIO $ createSymbolicLink l f
-				Left e -> catchNonAsync (restoreFile f k e)
-					warnlocked
+				Right False -> warnlocked "Failed to move file to annex"
+				Left e -> catchNonAsync (restoreFile f k e) $
+					warnlocked . show
 		showEndOk
 
-	warnlocked :: SomeException -> Annex ()
-	warnlocked e = do
-		warning $ show e
+	warnlocked msg = do
+		warning msg
 		warning "leaving this file as-is; correct this problem and run git annex add on it"
 	
 cleanup :: CommandCleanup
diff --git a/Command/Reinject.hs b/Command/Reinject.hs
index 8fe7587fa..48f50d324 100644
--- a/Command/Reinject.hs
+++ b/Command/Reinject.hs
@@ -74,9 +74,8 @@ perform src key = ifM move
 	, error "failed"
 	)
   where
-	move = checkDiskSpaceToGet key False $ do
+	move = checkDiskSpaceToGet key False $
 		moveAnnex key src
-		return True
 
 cleanup :: Key -> CommandCleanup
 cleanup key = do