diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,10 @@ +0.5.2.2 +------- + +* Fix client in case where server provides MD5 hashes + (ignore them, use only SHA256) +* Fix warnings with GHC 8 + 0.5.2.1 ------- diff --git a/hackage-security.cabal b/hackage-security.cabal --- a/hackage-security.cabal +++ b/hackage-security.cabal @@ -1,5 +1,5 @@ name: hackage-security -version: 0.5.2.1 +version: 0.5.2.2 synopsis: Hackage security library description: The hackage security library provides both server and client utilities for securing the Hackage package server diff --git a/src/Hackage/Security/Client.hs b/src/Hackage/Security/Client.hs --- a/src/Hackage/Security/Client.hs +++ b/src/Hackage/Security/Client.hs @@ -332,7 +332,13 @@ DontCache -> Nothing -- | Get all cached info (if any) -getCachedInfo :: (Applicative m, MonadIO m) => Repository down -> m CachedInfo +getCachedInfo :: +#if __GLASGOW_HASKELL__ < 800 + (Applicative m, MonadIO m) +#else + MonadIO m +#endif + => Repository down -> m CachedInfo getCachedInfo rep = do (cachedRoot, cachedKeyEnv) <- readLocalRoot rep cachedTimestamp <- readLocalFile rep cachedKeyEnv CachedTimestamp @@ -353,8 +359,10 @@ readCachedJSON rep KeyEnv.empty cachedPath return (trustLocalFile signedRoot, rootKeys (signed signedRoot)) -readLocalFile :: ( FromJSON ReadJSON_Keys_Layout (Signed a) - , MonadIO m, Applicative m +readLocalFile :: ( FromJSON ReadJSON_Keys_Layout (Signed a), MonadIO m +#if __GLASGOW_HASKELL__ < 800 + , Applicative m +#endif ) => Repository down -> KeyEnv -> CachedFile -> m (Maybe (Trusted a)) readLocalFile rep cachedKeyEnv file = do diff --git a/src/Hackage/Security/Client/Formats.hs b/src/Hackage/Security/Client/Formats.hs --- a/src/Hackage/Security/Client/Formats.hs +++ b/src/Hackage/Security/Client/Formats.hs @@ -113,4 +113,3 @@ formatsLookup (HFS hf) (FsUn _ ) = hasFormatAbsurd hf formatsLookup (HFS hf) (FsGz _) = hasFormatAbsurd hf formatsLookup (HFS hf) (FsUnGz _ a) = formatsLookup hf (FsGz a) -formatsLookup _ _ = error "inaccessible" diff --git a/src/Hackage/Security/Client/Repository/Local.hs b/src/Hackage/Security/Client/Repository/Local.hs --- a/src/Hackage/Security/Client/Repository/Local.hs +++ b/src/Hackage/Security/Client/Repository/Local.hs @@ -92,8 +92,6 @@ verifyLocalFile (LocalFile fp) trustedInfo = do -- Verify the file size before comparing the entire file info sz <- FileLength <$> getFileSize fp - if sz /= fileInfoLength + if sz /= fileInfoLength (trusted trustedInfo) then return False - else knownFileInfoEqual info <$> computeFileInfo fp - where - info@FileInfo{..} = trusted trustedInfo + else compareTrustedFileInfo (trusted trustedInfo) <$> computeFileInfo fp diff --git a/src/Hackage/Security/Client/Repository/Remote.hs b/src/Hackage/Security/Client/Repository/Remote.hs --- a/src/Hackage/Security/Client/Repository/Remote.hs +++ b/src/Hackage/Security/Client/Repository/Remote.hs @@ -652,9 +652,10 @@ verifyRemoteFile :: RemoteTemp typ -> Trusted FileInfo -> IO Bool verifyRemoteFile remoteTemp trustedInfo = do sz <- FileLength <$> remoteSize remoteTemp - if sz /= fileInfoLength + if sz /= fileInfoLength (trusted trustedInfo) then return False - else withRemoteBS remoteTemp $ knownFileInfoEqual info . fileInfo + else withRemoteBS remoteTemp $ + compareTrustedFileInfo (trusted trustedInfo) . fileInfo where remoteSize :: RemoteTemp typ -> IO Int54 remoteSize DownloadedWhole{..} = getFileSize wholeTemp @@ -678,8 +679,6 @@ BS.L.take (fromIntegral deltaSeek) existing , temp ] - - info@FileInfo{..} = trusted trustedInfo {------------------------------------------------------------------------------- Auxiliary: multiple exit points diff --git a/src/Hackage/Security/TUF/FileInfo.hs b/src/Hackage/Security/TUF/FileInfo.hs --- a/src/Hackage/Security/TUF/FileInfo.hs +++ b/src/Hackage/Security/TUF/FileInfo.hs @@ -6,6 +6,7 @@ -- * Utility , fileInfo , computeFileInfo + , compareTrustedFileInfo , knownFileInfoEqual , fileInfoSHA256 -- ** Re-exports @@ -61,6 +62,9 @@ fileInfo bs = FileInfo { fileInfoLength = FileLength . fromIntegral $ BS.L.length bs , fileInfoHashes = Map.fromList [ + -- Note: if you add or change hash functions here and you want to + -- make them compulsory then you also need to update + -- 'compareTrustedFileInfo' below. (HashFnSHA256, Hash $ BS.C8.unpack $ Base16.encode $ SHA256.hashlazy bs) ] } @@ -69,11 +73,34 @@ computeFileInfo :: FsRoot root => Path root -> IO FileInfo computeFileInfo fp = fileInfo <$> readLazyByteString fp --- | Compare known file info +-- | Compare the expected trusted file info against the actual file info of a +-- target file. -- --- This should be used only when the FileInfo is already known. If we want to --- compare known FileInfo against a file on disk we should delay until we know --- have confirmed that the file lengths don't match (see 'verifyFileInfo'). +-- This should be used only when the 'FileInfo' is already known. If we want +-- to compare known 'FileInfo' against a file on disk we should delay until we +-- have confirmed that the file lengths match (see 'downloadedVerify'). +-- +compareTrustedFileInfo :: FileInfo -- ^ expected (from trusted TUF files) + -> FileInfo -- ^ actual (from 'fileInfo' on target file) + -> Bool +compareTrustedFileInfo expectedInfo actualInfo = + -- The expected trusted file info may have hashes for several hash + -- functions, including ones we do not care about and do not want to + -- check. In particular the file info may have an md5 hash, but this + -- is not one that we want to check. + -- + -- Our current policy is to check sha256 only and ignore md5: + sameLength expectedInfo actualInfo + && sameSHA256 expectedInfo actualInfo + where + sameLength a b = fileInfoLength a + == fileInfoLength b + + sameSHA256 a b = case (fileInfoSHA256 a, + fileInfoSHA256 b) of + (Just ha, Just hb) -> ha == hb + _ -> False + knownFileInfoEqual :: FileInfo -> FileInfo -> Bool knownFileInfoEqual a b = (==) (fileInfoLength a, fileInfoHashes a) (fileInfoLength b, fileInfoHashes b)