stackage-install 0.1.0.2 → 0.1.0.3
raw patch · 4 files changed
+163/−19 lines, 4 filesdep +aesondep +containersdep +cryptohash
Dependencies added: aeson, containers, cryptohash, tar, text
Files
- ChangeLog.md +4/−0
- README.md +18/−2
- Stackage/Install.hs +135/−16
- stackage-install.cabal +6/−1
ChangeLog.md view
@@ -1,3 +1,7 @@+# 0.1.0.3++* When available, use the [all-cabal-hashes](https://github.com/commercialhaskell/all-cabal-hashes) repository for package hash and size verification.+ # 0.1.0.2 * Revert back to `cabal install --dry-run` [#2](https://github.com/fpco/stackage-install/issues/2)
README.md view
@@ -17,6 +17,22 @@ 2. Download the relevant packages from S3, and place them in the locations that `cabal-install` expects 3. Run `cabal install ...` +## Security++In addition to using HTTPS for download, `stackage-install` can use features of+the [all-cabal-hashes](https://github.com/commercialhaskell/all-cabal-hashes)+repository for extra guarantees. In particular, if you have appropriate data in+your package index (see next paragraph), `stackage-install` will automatically+verify both the hash of the package contents and the download size. If the+server attempts to send more data than expected, the download will be+terminated.++The easiest way to get this extra data into your package index is to use+[stackage-update](https://github.com/fpco/stackage-update) with the `--hashes`+option. See [hash+downloads](https://github.com/fpco/stackage-update#hash-downloads) for more+information.+ ## Caveats If you have a modified `remote-repo` in your ~/.cabal/config file, this tool@@ -37,8 +53,8 @@ The output from `cabal install --dry-run` doesn't actually give us information on which packages need to be downloaded, only the packages to be installed. This will be different in the case of local packages. Unfortunately, `cabal-fetch` won't work for us either, since it accepts different arguments [see-#2](https://github.com/fpco/stackage-install/issues/2). The compromise we have+fetch` won't work for us either, since it accepts different arguments [see #2](https://github.com/fpco/stackage-install/issues/2).+The compromise we have now is to just continue working in the presence of errors during download, though a more robust solution would be to check if one of the arguments refers to a local package.
Stackage/Install.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-} -- | Functionality for downloading packages securely for cabal's usage. module Stackage.Install ( install@@ -7,16 +9,35 @@ , defaultSettings ) where -import Control.Applicative ((*>))+import qualified Codec.Archive.Tar as Tar+import Control.Applicative ((*>), (<$>), (<*>))+import Control.Concurrent.Async (wait, withAsync) import Control.Concurrent.Async (Concurrently (..)) import Control.Concurrent.STM (atomically, newTVarIO, readTVar, writeTVar)-import Control.Monad (join, unless)+import Control.Exception (Exception, throwIO)+import Control.Monad (join, unless, when)+import Crypto.Hash (Context, Digest, SHA512,+ digestToHexByteString, hashFinalize,+ hashInit, hashUpdate)+import Data.Aeson (FromJSON (..), decode, withObject,+ (.!=), (.:?))+import Data.ByteString (ByteString) import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8+import qualified Data.ByteString.Lazy as L import qualified Data.Foldable as F import Data.Function (fix) import Data.List (isPrefixOf)+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Set (Set)+import qualified Data.Set as Set+import Data.Text (Text)+import qualified Data.Text as T+import Data.Text.Encoding (encodeUtf8)+import Data.Typeable (Typeable)+import Data.Word (Word64) import Network.HTTP.Client (Manager, brRead, checkStatus, managerResponseTimeout, newManager, parseUrl, responseBody,@@ -28,7 +49,7 @@ getAppUserDataDirectory, renameFile) import System.Exit (ExitCode) import System.FilePath (takeDirectory, (<.>), (</>))-import System.IO (IOMode (WriteMode), stdout,+import System.IO (IOMode (ReadMode, WriteMode), stdout, withBinaryFile) import System.Process (rawSystem, readProcess) @@ -90,22 +111,88 @@ , _connections = 8 } +data Package = Package+ { packageHashes :: Map Text Text+ , packageLocations :: [Text]+ , packageSize :: Maybe Word64+ }+ deriving Show+instance FromJSON Package where+ parseJSON = withObject "Package" $ \o -> Package+ <$> o .:? "package-hashes" .!= Map.empty+ <*> o .:? "package-locations" .!= []+ <*> o .:? "package-size"++getPackageInfo :: FilePath -> Set (String, String) -> IO (Map (String, String) Package)+getPackageInfo packageDir pkgs0 = withBinaryFile indexTar ReadMode $ \h -> do+ lbs <- L.hGetContents h+ loop pkgs0 Map.empty $ Tar.read lbs+ where+ indexTar = packageDir </> "00-index.tar"++ loop pkgs m Tar.Done = do+ when (not $ Set.null pkgs) $+ putStrLn $ "Warning: packages not found in index: " ++ show (Set.toList pkgs)+ return m+ loop _ m (Tar.Fail e) = throwIO $ Couldn'tReadIndexTarball indexTar e+ loop pkgs m (Tar.Next e es) =+ case (getName $ Tar.entryPath e, Tar.entryContent e) of+ (Just pair, Tar.NormalFile lbs _)+ | pair `Set.member` pkgs+ , Just p <- decode lbs ->+ loop (Set.delete pair pkgs) (Map.insert pair p m) es+ _ -> loop pkgs m es++ getName name =+ case T.splitOn "/" $ T.pack name of+ [pkg, ver, fp] | T.stripSuffix ".json" fp == Just pkg+ -> Just (T.unpack pkg, T.unpack ver)+ _ -> Nothing++data StackageInstallException+ = Couldn'tReadIndexTarball FilePath Tar.FormatError+ | InvalidDownloadSize+ { _idsUrl :: String+ , _idsExpected :: Word64+ , _idsTotalDownloaded :: Word64+ }+ | InvalidHash+ { _ihUrl :: String+ , _ihExpected :: Text+ , _ihActual :: Digest SHA512+ }+ deriving (Show, Typeable)+instance Exception StackageInstallException+ -- | Download the given name,version pairs into the directory expected by cabal. -- -- Since 0.1.0.0 download :: F.Foldable f => Settings -> f (String, String) -> IO () download s pkgs = do- man <- _getManager s cabalDir <- getAppUserDataDirectory "cabal"- parMapM_ (_connections s) (go cabalDir man) pkgs+ let packageDir = cabalDir </> "packages" </> "hackage.haskell.org"+ withAsync (getPackageInfo packageDir $ Set.fromList $ F.toList pkgs) $ \a -> do+ man <- _getManager s+ parMapM_ (_connections s) (go packageDir man (wait a)) pkgs where unlessM p f = do p' <- p unless p' f - go cabalDir man (name, version) = do+ go packageDir man getPackageInfo pair@(name, version) = do unlessM (doesFileExist fp) $ do _onDownload s pkg+ packageInfo <- getPackageInfo+ let (msha512, url, msize) =+ case Map.lookup pair packageInfo of+ Nothing -> (Nothing, defUrl, Nothing)+ Just p ->+ ( Map.lookup "SHA512" $ packageHashes p+ , case reverse $ packageLocations p of+ [] -> defUrl+ x:_ -> T.unpack x+ , packageSize p+ ) createDirectoryIfMissing True $ takeDirectory fp req <- parseUrl url let req' = req@@ -118,23 +205,55 @@ withResponse req' man $ \res -> if statusCode (responseStatus res) == 200 then do let tmp = fp <.> "tmp"- withBinaryFile tmp WriteMode $ \h -> fix $ \loop -> do- bs <- brRead $ responseBody res- unless (S.null bs) $ do- S.hPut h bs- loop+ withBinaryFile tmp WriteMode $ \h -> do+ let loop total ctx = do+ bs <- brRead $ responseBody res+ if S.null bs+ then+ case msize of+ Nothing -> return ()+ Just expected+ | expected /= total ->+ throwIO InvalidDownloadSize+ { _idsUrl = url+ , _idsExpected = expected+ , _idsTotalDownloaded = total+ }+ | otherwise -> validHash url msha512 ctx+ else do+ S.hPut h bs+ let total' = total + fromIntegral (S.length bs)+ case msize of+ Just expected | expected < total' ->+ throwIO InvalidDownloadSize+ { _idsUrl = url+ , _idsExpected = expected+ , _idsTotalDownloaded = total'+ }+ _ -> loop total' $! hashUpdate ctx bs+ loop 0 hashInit renameFile tmp fp else _onDownloadErr s pkg where pkg = concat [name, "-", version] targz = pkg ++ ".tar.gz"- url = _downloadPrefix s ++ targz- fp = cabalDir </>- "packages" </>- "hackage.haskell.org" </>+ defUrl = _downloadPrefix s ++ targz+ fp = packageDir </> name </> version </> targz++validHash :: String -> Maybe Text -> Context SHA512 -> IO ()+validHash _ Nothing _ = return ()+validHash url (Just sha512) ctx+ | encodeUtf8 sha512 == digestToHexByteString dig = return ()+ | otherwise = throwIO InvalidHash+ { _ihUrl = url+ , _ihExpected = sha512+ , _ihActual = dig+ }+ where+ dig = hashFinalize ctx parMapM_ :: F.Foldable f => Int
stackage-install.cabal view
@@ -1,5 +1,5 @@ name: stackage-install-version: 0.1.0.2+version: 0.1.0.3 synopsis: Secure download of packages for cabal-install description: For more information, see <https://www.stackage.org/package/stackage-install> homepage: https://github.com/fpco/stackage-install@@ -24,6 +24,11 @@ , async , stm , http-types+ , tar+ , containers+ , aeson+ , cryptohash+ , text default-language: Haskell2010 executable stackage-install