From 48119806dd24214e88f3f3c62f4dcb14b60dc207 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 27 Feb 2017 13:01:32 -0400 Subject: 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. --- Annex/Content.hs | 45 +++++++++++++++++++++++++++++++++++---------- Annex/Direct.hs | 8 ++++---- Annex/Ingest.hs | 32 ++++++++++++++++++++------------ CHANGELOG | 5 +++++ Command/AddUrl.hs | 9 ++++++--- Command/Indirect.hs | 12 ++++++------ Command/Reinject.hs | 3 +-- Types/GitConfig.hs | 2 ++ 8 files changed, 79 insertions(+), 37 deletions(-) diff --git a/Annex/Content.hs b/Annex/Content.hs index 8e225548f..0001e8ac9 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -1,6 +1,6 @@ {- git-annex file content managing - - - Copyright 2010-2015 Joey Hess + - Copyright 2010-2017 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -80,6 +80,7 @@ import qualified Types.Backend import qualified Backend import qualified Database.Keys import Types.NumCopies +import Types.Key import Annex.UUID import Annex.InodeSentinal import Utility.InodeCache @@ -307,10 +308,12 @@ getViaTmp' v key action = do (ok, verification) <- action tmpfile if ok then ifM (verifyKeyContent v verification key tmpfile) - ( do - moveAnnex key tmpfile - logStatus key InfoPresent - return True + ( ifM (moveAnnex key tmpfile) + ( do + logStatus key InfoPresent + return True + , return False + ) , do warning "verification of content failed" liftIO $ nukeFile tmpfile @@ -465,9 +468,18 @@ checkDiskSpace' need destdir key alreadythere samefilesystem = ifM (Annex.getSta - key, and one of them will probably get deleted later. So, adding the - check here would only raise expectations that git-annex cannot truely - meet. + - + - May return false, when a particular variety of key is not being + - accepted into the repository. Will display a warning message in this + - case. May also throw exceptions in some cases. -} -moveAnnex :: Key -> FilePath -> Annex () -moveAnnex key src = withObjectLoc key storeobject storedirect +moveAnnex :: Key -> FilePath -> Annex Bool +moveAnnex key src = ifM (checkSecureHashes key) + ( do + withObjectLoc key storeobject storedirect + return True + , return False + ) where storeobject dest = ifM (liftIO $ doesFileExist dest) ( alreadyhave @@ -509,6 +521,16 @@ moveAnnex key src = withObjectLoc key storeobject storedirect alreadyhave = liftIO $ removeFile src +checkSecureHashes :: Key -> Annex Bool +checkSecureHashes key + | cryptographicallySecure (keyVariety key) = return True + | otherwise = ifM (annexSecureHashesOnly <$> Annex.getGitConfig) + ( do + warning $ "annex.securehashesonly blocked adding " ++ formatKeyVariety (keyVariety key) ++ " key to annex objects" + return False + , return True + ) + populatePointerFile :: Key -> FilePath -> FilePath -> Annex () populatePointerFile k obj f = go =<< liftIO (isPointerFile f) where @@ -526,9 +548,12 @@ data LinkAnnexResult = LinkAnnexOk | LinkAnnexFailed | LinkAnnexNoop {- Populates the annex object file by hard linking or copying a source - file to it. -} linkToAnnex :: Key -> FilePath -> Maybe InodeCache -> Annex LinkAnnexResult -linkToAnnex key src srcic = do - dest <- calcRepo (gitAnnexLocation key) - modifyContent dest $ linkAnnex To key src srcic dest Nothing +linkToAnnex key src srcic = ifM (checkSecureHashes key) + ( do + dest <- calcRepo (gitAnnexLocation key) + modifyContent dest $ linkAnnex To key src srcic dest Nothing + , return LinkAnnexFailed + ) {- Makes a destination file be a link or copy from the annex object. -} linkFromAnnex :: Key -> FilePath -> Maybe FileMode -> Annex LinkAnnexResult diff --git a/Annex/Direct.hs b/Annex/Direct.hs index e5c1c47c8..08a15e180 100644 --- a/Annex/Direct.hs +++ b/Annex/Direct.hs @@ -383,10 +383,10 @@ removeDirect :: Key -> FilePath -> Annex () removeDirect k f = do void $ removeAssociatedFileUnchecked k f unlessM (inAnnex k) $ - ifM (goodContent k f) - ( moveAnnex k f - , logStatus k InfoMissing - ) + -- If moveAnnex rejects the content of the key, + -- treat that the same as its content having changed. + whenM (goodContent k f <&&> moveAnnex k f) $ + logStatus k InfoMissing liftIO $ do nukeFile f void $ tryIO $ removeDirectory $ parentDir f 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 diff --git a/CHANGELOG b/CHANGELOG index 7b7ee03a0..92fc5b41b 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -1,5 +1,10 @@ git-annex (6.20170215) UNRELEASED; urgency=medium + * 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 added to .git/annex/objects. * sync, merge: Fail when the current branch has no commits yet, instead of not merging in anything from remotes and appearing to succeed. * Run ssh with -n whenever input is not being piped into it, 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 diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs index af901fcf1..af699a7b9 100644 --- a/Types/GitConfig.hs +++ b/Types/GitConfig.hs @@ -82,6 +82,7 @@ data GitConfig = GitConfig , annexPidLock :: Bool , annexPidLockTimeout :: Seconds , annexAddUnlocked :: Bool + , annexSecureHashesOnly :: Bool , coreSymlinks :: Bool , coreSharedRepository :: SharedRepository , receiveDenyCurrentBranch :: DenyCurrentBranch @@ -136,6 +137,7 @@ extractGitConfig r = GitConfig , annexPidLockTimeout = Seconds $ fromMaybe 300 $ getmayberead (annex "pidlocktimeout") , annexAddUnlocked = getbool (annex "addunlocked") False + , annexSecureHashesOnly = getbool (annex "securehashesonly") False , coreSymlinks = getbool "core.symlinks" True , coreSharedRepository = getSharedRepository r , receiveDenyCurrentBranch = getDenyCurrentBranch r -- cgit v1.2.3