From b657242f5d946efae4cc77e8aef95dd2a306cd6b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 21 Jun 2018 13:34:11 -0400 Subject: [PATCH] enforce retrievalSecurityPolicy Leveraged the existing verification code by making it also check the retrievalSecurityPolicy. Also, prevented getViaTmp from running the download action at all when the retrievalSecurityPolicy is going to prevent verifying and so storing it. Added annex.security.allow-unverified-downloads. A per-remote version would be nice to have too, but would need more plumbing, so KISS. (Bill the Cat reference not too over the top I hope. The point is to make this something the user reads the documentation for before using.) A few calls to verifyKeyContent and getViaTmp, that don't involve downloads from remotes, have RetrievalAllKeysSecure hard-coded. It was also hard-coded for P2P.Annex and Command.RecvKey, to match the values of the corresponding remotes. A few things use retrieveKeyFile/retrieveKeyFileCheap without going through getViaTmp. * Command.Fsck when downloading content from a remote to verify it. That content does not get into the annex, so this is ok. * Command.AddUrl when using a remote to download an url; this is new content being added, so this is ok. This commit was sponsored by Fernando Jimenez on Patreon. --- Annex/Content.hs | 65 +++++++++++++++++++++++++++++++---------- CHANGELOG | 13 +++++++-- Command/Get.hs | 2 +- Command/Move.hs | 2 +- Command/Multicast.hs | 2 +- Command/ReKey.hs | 2 +- Command/RecvKey.hs | 5 +++- Command/Reinject.hs | 2 +- Command/SetKey.hs | 2 +- Command/TestRemote.hs | 8 ++--- Command/TransferKey.hs | 2 +- Command/TransferKeys.hs | 2 +- NEWS | 6 ++++ P2P/Annex.hs | 6 +++- Remote.hs | 1 + Remote/Git.hs | 3 +- Types/GitConfig.hs | 3 ++ doc/git-annex.mdwn | 39 ++++++++++++++++++++++++- 18 files changed, 131 insertions(+), 34 deletions(-) diff --git a/Annex/Content.hs b/Annex/Content.hs index 9f3722c609..8902114dad 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -1,6 +1,6 @@ {- git-annex file content managing - - - Copyright 2010-2017 Joey Hess + - Copyright 2010-2018 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -15,6 +15,7 @@ module Annex.Content ( lockContentShared, lockContentForRemoval, ContentRemovalLock, + RetrievalSecurityPolicy(..), getViaTmp, getViaTmpFromDisk, checkDiskSpaceToGet, @@ -78,7 +79,7 @@ import qualified Annex.Content.Direct as Direct import Annex.ReplaceFile import Annex.LockPool import Messages.Progress -import Types.Remote (unVerified, Verification(..)) +import Types.Remote (unVerified, Verification(..), RetrievalSecurityPolicy(..)) import qualified Types.Remote import qualified Types.Backend import qualified Backend @@ -293,15 +294,15 @@ lockContentUsing locker key a = do {- Runs an action, passing it the temp file to get, - and if the action succeeds, verifies the file matches - the key and moves the file into the annex as a key's content. -} -getViaTmp :: VerifyConfig -> Key -> (FilePath -> Annex (Bool, Verification)) -> Annex Bool -getViaTmp v key action = checkDiskSpaceToGet key False $ - getViaTmpFromDisk v key action +getViaTmp :: RetrievalSecurityPolicy -> VerifyConfig -> Key -> (FilePath -> Annex (Bool, Verification)) -> Annex Bool +getViaTmp rsp v key action = checkDiskSpaceToGet key False $ + getViaTmpFromDisk rsp v key action {- Like getViaTmp, but does not check that there is enough disk space - for the incoming key. For use when the key content is already on disk - and not being copied into place. -} -getViaTmpFromDisk :: VerifyConfig -> Key -> (FilePath -> Annex (Bool, Verification)) -> Annex Bool -getViaTmpFromDisk v key action = do +getViaTmpFromDisk :: RetrievalSecurityPolicy -> VerifyConfig -> Key -> (FilePath -> Annex (Bool, Verification)) -> Annex Bool +getViaTmpFromDisk rsp v key action = checkallowed $ do tmpfile <- prepTmp key resuming <- liftIO $ doesFileExist tmpfile (ok, verification) <- action tmpfile @@ -315,7 +316,7 @@ getViaTmpFromDisk v key action = do _ -> MustVerify else verification if ok - then ifM (verifyKeyContent v verification' key tmpfile) + then ifM (verifyKeyContent rsp v verification' key tmpfile) ( ifM (pruneTmpWorkDirBefore tmpfile (moveAnnex key)) ( do logStatus key InfoPresent @@ -330,24 +331,46 @@ getViaTmpFromDisk v key action = do -- On transfer failure, the tmp file is left behind, in case -- caller wants to resume its transfer else return False + where + -- Avoid running the action to get the content when the + -- RetrievalSecurityPolicy would cause verification to always fail. + checkallowed a = case rsp of + RetrievalAllKeysSecure -> a + RetrievalVerifiableKeysSecure + | isVerifiable (keyVariety key) -> a + | otherwise -> ifM (annexAllowUnverifiedDownloads <$> Annex.getGitConfig) + ( a + , warnUnverifiableInsecure key >> return False + ) {- Verifies that a file is the expected content of a key. + - - Configuration can prevent verification, for either a - - particular remote or always. + - particular remote or always, unless the RetrievalSecurityPolicy + - requires verification. - - Most keys have a known size, and if so, the file size is checked. - - - When the key's backend allows verifying the content (eg via checksum), + - When the key's backend allows verifying the content (via checksum), - it is checked. + - + - If the RetrievalSecurityPolicy requires verification and the key's + - backend doesn't support it, the verification will fail. -} -verifyKeyContent :: VerifyConfig -> Verification -> Key -> FilePath -> Annex Bool -verifyKeyContent v verification k f = case verification of - Verified -> return True - UnVerified -> ifM (shouldVerify v) +verifyKeyContent :: RetrievalSecurityPolicy -> VerifyConfig -> Verification -> Key -> FilePath -> Annex Bool +verifyKeyContent rsp v verification k f = case (rsp, verification) of + (_, Verified) -> return True + (RetrievalVerifiableKeysSecure, _) + | isVerifiable (keyVariety k) -> verify + | otherwise -> ifM (annexAllowUnverifiedDownloads <$> Annex.getGitConfig) + ( verify + , warnUnverifiableInsecure k >> return False + ) + (_, UnVerified) -> ifM (shouldVerify v) ( verify , return True ) - MustVerify -> verify + (_, MustVerify) -> verify where verify = verifysize <&&> verifycontent verifysize = case keySize k of @@ -359,6 +382,16 @@ verifyKeyContent v verification k f = case verification of Nothing -> return True Just verifier -> verifier k f +warnUnverifiableInsecure :: Key -> Annex () +warnUnverifiableInsecure k = warning $ unwords + [ "Getting " ++ kv ++ " keys with this remote is not secure;" + , "the content cannot be verified to be correct." + , "(Use annex.security.allow-unverified-downloads to bypass" + , "this safety check.)" + ] + where + kv = formatKeyVariety (keyVariety k) + data VerifyConfig = AlwaysVerify | NoVerify | RemoteVerify Remote | DefaultVerify shouldVerify :: VerifyConfig -> Annex Bool @@ -827,7 +860,7 @@ isUnmodified key f = go =<< geti go (Just fc) = cheapcheck fc <||> expensivecheck fc cheapcheck fc = anyM (compareInodeCaches fc) =<< Database.Keys.getInodeCaches key - expensivecheck fc = ifM (verifyKeyContent AlwaysVerify UnVerified key f) + expensivecheck fc = ifM (verifyKeyContent RetrievalAllKeysSecure AlwaysVerify UnVerified key f) -- The file could have been modified while it was -- being verified. Detect that. ( geti >>= maybe (return False) (compareInodeCaches fc) diff --git a/CHANGELOG b/CHANGELOG index b80205f9af..6f82a31b76 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -1,10 +1,19 @@ git-annex (6.20180622) upstream; urgency=high - Security fix release for CVE-2018-10857 + Security fix release for CVE-2018-10857 and CVE-2018-10859 + * Refuse to download content, that cannot be verified with a hash, + from encrypted special remotes (for CVE-2018-10859), + and from all external special remotes (for CVE-2018-10857). + In particular, URL and WORM keys stored on such remotes won't + be downloaded. If this affects your files, you can run + `git-annex migrate` on the affected files, to convert them + to use a hash. + * Added annex.security.allow-unverified-downloads, which can override + the above. * Added annex.security.allowed-url-schemes setting, which defaults to only allowing http, https, and ftp URLs. Note especially that file:/ - is no longer enabled by default. This is a security fix. + is no longer enabled by default. * Removed annex.web-download-command, since its interface does not allow supporting annex.security.allowed-url-schemes across redirects. If you used this setting, you may want to instead use annex.web-options diff --git a/Command/Get.hs b/Command/Get.hs index f4e3d47b58..eac8e88a44 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -109,7 +109,7 @@ getKey' key afile = dispatch | Remote.hasKeyCheap r = either (const False) id <$> Remote.hasKey r key | otherwise = return True - docopy r witness = getViaTmp (RemoteVerify r) key $ \dest -> + docopy r witness = getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) key $ \dest -> download (Remote.uuid r) key afile stdRetry (\p -> do showAction $ "from " ++ Remote.name r diff --git a/Command/Move.hs b/Command/Move.hs index 2f3079207e..b50c877bcc 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -207,7 +207,7 @@ fromPerform src removewhen key afile = do where go = notifyTransfer Download afile $ download (Remote.uuid src) key afile stdRetry $ \p -> - getViaTmp (RemoteVerify src) key $ \t -> + getViaTmp (Remote.retrievalSecurityPolicy src) (RemoteVerify src) key $ \t -> Remote.retrieveKeyFile src key afile t p dispatch _ _ False = stop -- failed dispatch RemoveNever _ True = next $ return True -- copy complete diff --git a/Command/Multicast.hs b/Command/Multicast.hs index e2f6870c6b..5c853ddd92 100644 --- a/Command/Multicast.hs +++ b/Command/Multicast.hs @@ -213,7 +213,7 @@ storeReceived f = do warning $ "Received a file " ++ f ++ " that is not a git-annex key. Deleting this file." liftIO $ nukeFile f Just k -> void $ - getViaTmpFromDisk AlwaysVerify k $ \dest -> unVerified $ + getViaTmpFromDisk RetrievalVerifiableKeysSecure AlwaysVerify k $ \dest -> unVerified $ liftIO $ catchBoolIO $ do rename f dest return True diff --git a/Command/ReKey.hs b/Command/ReKey.hs index be67a25ab3..4de6e966d1 100644 --- a/Command/ReKey.hs +++ b/Command/ReKey.hs @@ -83,7 +83,7 @@ linkKey file oldkey newkey = ifM (isJust <$> isAnnexLink file) - This avoids hard linking to content linked to an - unlocked file, which would leave the new key unlocked - and vulnerable to corruption. -} - ( getViaTmpFromDisk DefaultVerify newkey $ \tmp -> unVerified $ do + ( getViaTmpFromDisk RetrievalAllKeysSecure DefaultVerify newkey $ \tmp -> unVerified $ do oldobj <- calcRepo (gitAnnexLocation oldkey) linkOrCopy' (return True) newkey oldobj tmp Nothing , do diff --git a/Command/RecvKey.hs b/Command/RecvKey.hs index 103db559b8..84f71f8835 100644 --- a/Command/RecvKey.hs +++ b/Command/RecvKey.hs @@ -13,6 +13,7 @@ import Annex.Action import Annex import Utility.Rsync import Types.Transfer +import Types.Remote (RetrievalSecurityPolicy(..)) import Command.SendKey (fieldTransfer) import qualified CmdLine.GitAnnexShell.Fields as Fields @@ -31,7 +32,9 @@ start key = fieldTransfer Download key $ \_p -> do fromunlocked <- (isJust <$> Fields.getField Fields.unlocked) <||> (isJust <$> Fields.getField Fields.direct) let verify = if fromunlocked then AlwaysVerify else DefaultVerify - ifM (getViaTmp verify key go) + -- This matches the retrievalSecurityPolicy of Remote.Git + let rsp = RetrievalAllKeysSecure + ifM (getViaTmp rsp verify key go) ( do -- forcibly quit after receiving one key, -- and shutdown cleanly diff --git a/Command/Reinject.hs b/Command/Reinject.hs index 48f50d3241..bde4c81ea1 100644 --- a/Command/Reinject.hs +++ b/Command/Reinject.hs @@ -45,7 +45,7 @@ startSrcDest (src:dest:[]) showStart "reinject" dest next $ ifAnnexed dest go stop where - go key = ifM (verifyKeyContent DefaultVerify UnVerified key src) + go key = ifM (verifyKeyContent RetrievalAllKeysSecure DefaultVerify UnVerified key src) ( perform src key , error "failed" ) diff --git a/Command/SetKey.hs b/Command/SetKey.hs index 090edee0ba..5d6a6ca26d 100644 --- a/Command/SetKey.hs +++ b/Command/SetKey.hs @@ -33,7 +33,7 @@ perform file key = do -- the file might be on a different filesystem, so moveFile is used -- rather than simply calling moveAnnex; disk space is also -- checked this way. - ok <- getViaTmp DefaultVerify key $ \dest -> unVerified $ + ok <- getViaTmp RetrievalAllKeysSecure DefaultVerify key $ \dest -> unVerified $ if dest /= file then liftIO $ catchBoolIO $ do moveFile file dest diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs index 8eeb2b5a69..baffbe131c 100644 --- a/Command/TestRemote.hs +++ b/Command/TestRemote.hs @@ -179,7 +179,7 @@ test st r k = Just b -> case Backend.verifyKeyContent b of Nothing -> return True Just verifier -> verifier k (key2file k) - get = getViaTmp (RemoteVerify r) k $ \dest -> + get = getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k $ \dest -> Remote.retrieveKeyFile r k (AssociatedFile Nothing) dest nullMeterUpdate store = Remote.storeKey r k (AssociatedFile Nothing) nullMeterUpdate @@ -220,7 +220,7 @@ testExportTree st (Just _) ea k1 k2 = retrieveexport k = withTmpFile "exported" $ \tmp h -> do liftIO $ hClose h ifM (Remote.retrieveExport ea k testexportlocation tmp nullMeterUpdate) - ( verifyKeyContent AlwaysVerify UnVerified k tmp + ( verifyKeyContent RetrievalAllKeysSecure AlwaysVerify UnVerified k tmp , return False ) checkpresentexport k = Remote.checkPresentExport ea k testexportlocation @@ -238,10 +238,10 @@ testUnavailable st r k = , check (`notElem` [Right True, Right False]) "checkPresent" $ Remote.checkPresent r k , check (== Right False) "retrieveKeyFile" $ - getViaTmp (RemoteVerify r) k $ \dest -> + getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k $ \dest -> Remote.retrieveKeyFile r k (AssociatedFile Nothing) dest nullMeterUpdate , check (== Right False) "retrieveKeyFileCheap" $ - getViaTmp (RemoteVerify r) k $ \dest -> unVerified $ + getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k $ \dest -> unVerified $ Remote.retrieveKeyFileCheap r k (AssociatedFile Nothing) dest ] where diff --git a/Command/TransferKey.hs b/Command/TransferKey.hs index 1aa0a72771..b1f9515a8d 100644 --- a/Command/TransferKey.hs +++ b/Command/TransferKey.hs @@ -60,7 +60,7 @@ toPerform key file remote = go Upload file $ fromPerform :: Key -> AssociatedFile -> Remote -> CommandPerform fromPerform key file remote = go Upload file $ download (uuid remote) key file stdRetry $ \p -> - getViaTmp (RemoteVerify remote) key $ + getViaTmp (retrievalSecurityPolicy remote) (RemoteVerify remote) key $ \t -> Remote.retrieveKeyFile remote key file t p go :: Direction -> AssociatedFile -> (NotifyWitness -> Annex Bool) -> CommandPerform diff --git a/Command/TransferKeys.hs b/Command/TransferKeys.hs index 94582b2e07..b986a32714 100644 --- a/Command/TransferKeys.hs +++ b/Command/TransferKeys.hs @@ -42,7 +42,7 @@ start = do return ok | otherwise = notifyTransfer direction file $ download (Remote.uuid remote) key file stdRetry $ \p -> - getViaTmp (RemoteVerify remote) key $ \t -> do + getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key $ \t -> do r <- Remote.retrieveKeyFile remote key file t p -- Make sure we get the current -- associated files data for the key, diff --git a/NEWS b/NEWS index 2dcc72e52b..445239fd23 100644 --- a/NEWS +++ b/NEWS @@ -1,5 +1,11 @@ git-annex (6.20180622) upstream; urgency=high + A security fix has changed git-annex to refuse to download content from + some special remotes when the content cannot be verified with a hash check. + In particular URL and WORM keys stored on such remotes won't be downloaded. + See the documentation of the annex.security.allow-unverified-downloads + configuration for how to deal with this if it affects your files. + A security fix has changed git-annex to only support http, https, and ftp URL schemes by default. You can enable other URL schemes, at your own risk, using annex.security.allowed-url-schemes. diff --git a/P2P/Annex.hs b/P2P/Annex.hs index 05fa9e9ac0..008de23a50 100644 --- a/P2P/Annex.hs +++ b/P2P/Annex.hs @@ -22,6 +22,7 @@ import P2P.Protocol import P2P.IO import Logs.Location import Types.NumCopies +import Types.Remote (RetrievalSecurityPolicy(..)) import Utility.Metered import Control.Monad.Free @@ -63,9 +64,12 @@ runLocal runst runner a = case a of Right Nothing -> runner (next False) Left e -> return (Left (show e)) StoreContent k af o l getb validitycheck next -> do + -- This is the same as the retrievalSecurityPolicy of + -- Remote.P2P and Remote.Git. + let rsp = RetrievalAllKeysSecure ok <- flip catchNonAsync (const $ return False) $ transfer download k af $ \p -> - getViaTmp DefaultVerify k $ \tmp -> do + getViaTmp rsp DefaultVerify k $ \tmp -> do storefile tmp o l getb validitycheck p runner (next ok) StoreContentTo dest o l getb validitycheck next -> do diff --git a/Remote.hs b/Remote.hs index 4df907629b..ff891962a1 100644 --- a/Remote.hs +++ b/Remote.hs @@ -12,6 +12,7 @@ module Remote ( storeKey, retrieveKeyFile, retrieveKeyFileCheap, + retrievalSecurityPolicy, removeKey, hasKey, hasKeyCheap, diff --git a/Remote/Git.hs b/Remote/Git.hs index 3f85365acf..8a2ee9acaa 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -626,10 +626,11 @@ copyToRemote' repo r (State connpool duc _) key file meterupdate ensureInitialized copier <- mkCopier hardlink params let verify = Annex.Content.RemoteVerify r + let rsp = RetrievalAllKeysSecure runTransfer (Transfer Download u key) file stdRetry $ \p -> let p' = combineMeterUpdate meterupdate p in Annex.Content.saveState True `after` - Annex.Content.getViaTmp verify key + Annex.Content.getViaTmp rsp verify key (\dest -> copier object dest p' (liftIO checksuccessio)) ) copyremotefallback p = Annex.Content.sendAnnex key noop $ \object -> do diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs index 7d9ccbff1f..26ad354c8d 100644 --- a/Types/GitConfig.hs +++ b/Types/GitConfig.hs @@ -96,6 +96,7 @@ data GitConfig = GitConfig , annexRetryDelay :: Maybe Seconds , annexAllowedUrlSchemes :: S.Set Scheme , annexAllowedHttpAddresses :: String + , annexAllowUnverifiedDownloads :: Bool , coreSymlinks :: Bool , coreSharedRepository :: SharedRepository , receiveDenyCurrentBranch :: DenyCurrentBranch @@ -166,6 +167,8 @@ extractGitConfig r = GitConfig getmaybe (annex "security.allowed-url-schemes") , annexAllowedHttpAddresses = fromMaybe "" $ getmaybe (annex "security.allowed-http-addresses") + , annexAllowUnverifiedDownloads = (== Just "ACKTHPPT") $ + getmaybe (annex "security.allow-unverified-downloads") , coreSymlinks = getbool "core.symlinks" True , coreSharedRepository = getSharedRepository r , receiveDenyCurrentBranch = getDenyCurrentBranch r diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 5c84249763..163a628c15 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -1228,7 +1228,7 @@ Here are all the supported configuration settings. Note that even when this is set to `false`, git-annex does verification in some edge cases, where it's likely the case than an - object was downloaded incorrectly. + object was downloaded incorrectly, or when needed for security. * `remote..annex-export-tracking` @@ -1425,6 +1425,43 @@ Here are all the supported configuration settings. these IP address restrictions to be enforced, curl and youtube-dl will never be used unless annex.security.allowed-http-addresses=all. +* `annex.security.allow-unverified-downloads`, + + For security reasons, git-annex refuses to download content from + most special remotes when it cannot check a hash to verify + that the correct content was downloaded. This particularly impacts + downloading the content of URL or WORM keys, which lack hashes. + + The best way to avoid problems due to this is to migrate files + away from such keys, before their content reaches a special remote. + See [[git-annex-migrate]](1). + + When the content is only available from a special remote, you can + use this configuration to force git-annex to download it. + But you do so at your own risk, and it's very important you read and + understand the information below first! + + Downloading unverified content from encrypted special remotes is + prevented, because the special remote could send some other encrypted + content than what you expect, causing git-annex to decrypt data that you + never checked into git-annex, and risking exposing the decrypted + data to any non-encrypted remotes you send content to. + + Downloading unverified content from (non-encrypted) + external special remotes is prevented, because they could follow + http redirects to web servers on localhost or on a private network, + or in some cases to a file:/// url. + + If you decide to bypass this security check, the best thing to do is + to only set it temporarily while running the command that gets the file. + The value to set the config to is "ACKTHPPT". + For example: + + git -c annex.security.allow-unverified-downloads=ACKTHPPT annex get myfile + + It would be a good idea to check that it downloaded the file you expected, + too. + * `annex.secure-erase-command` This can be set to a command that should be run whenever git-annex