diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,3 @@ +## 0.1.0.0 + +* Initial release diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,22 @@ +The MIT License (MIT) + +Copyright (c) 2015 FP Complete + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. + diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,58 @@ +# stackage-upload + +A more secure version of cabal upload which uses HTTPS. When uploading a +package to Hackage, `cabal-install` will perform the upload in plain-text, +unencrypted HTTP, which is vulnerable to man in the middle (MITM) attacks. This +package instead uses secure HTTPS upload to avoid both MITM attacks, and +possibly eavesdropping attacks (though the latter are yet unproven). In the +future, additionally functionality may be added. + +To install, simply run `cabal update && cabal install stackage-upload`. Usage +is quite similar `cabal upload`: just call `stackage-upload` and pass in a list +of tarballs to upload. (If you have +[stackage-cli](https://github.com/fpco/stackage-cli) installed, you can call +`stk upload` instead.) `stackage-upload --help` will provide full options. + +## Why not fix cabal? + +A legitimate question is why not add HTTPS support to cabal-install? The answer +is that I tried. At least as of April 2015, there was no proposal I was able to +make that allowed TLS support to be added to cabal-install, due to policies +regarding dependencies in the Cabal project. I would be much happier to add +this support there (and, at the same time, add secure *download* support, which +is also severely lacking). I made an open offer in April 2015, and the offer +stands: if the Cabal project gives me the green light to add http-client as a +dependency to cabal-install, I'll send the pull request myself. + +To give some more background: Cabal currently requires that all dependencies +be part of the Haskell Platform. I disagree with this decision, since +distributing a binary does not require that the libraries be available as well. +The last time TLS support in the Platform was raised, the best option for this +support (Vincent's wonderful [tls +package](https://www.stackage.org/package/tls) was vetoed because [it didn't +follow the Package Versioning Policy's strict upper bounds +approach](https://mail.haskell.org/pipermail/libraries/2014-April/022554.html). +(Ironically, the alternative package mentioned there, http-streams, *also* +doesn't have upper bounds on all dependencies.) + +## Why Stackage? + +See [the same question and its answer on stackage-update](https://github.com/fpco/stackage-update#why-stackage). + +## Future enhancements + +* Store passwords securely via GPG encryption +* Upload documentation to Hackage (work around the sometimes-broken doc builder) +* Perform pre-upload checks, such as running the test suite from the tarball to check for missing files + +## History + +This tool was something that I (Michael Snoyman) wrote for myself a while back, +and decided to rebrand as `stackage-upload` when the severity of the insecure +upload situation became apparent to me, and it became obvious that there was no +path forward for getting `cabal-install` fixed. + +I actually consider this situation to be so dangerous, I would like to ask the +Hackage Server team to consider turning off insecure uploads to Hackage. The +current possibility for corrupted uploads to infect all users of a package is +alarmingly high. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Stackage/Upload.hs b/Stackage/Upload.hs new file mode 100644 --- /dev/null +++ b/Stackage/Upload.hs @@ -0,0 +1,302 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +-- | Provide ability to upload tarballs to Hackage. +module Stackage.Upload + ( -- * Upload + mkUploader + , Uploader + , upload + , UploadSettings + , defaultUploadSettings + , setUploadUrl + , setGetManager + , setCredsSource + , setSaveCreds + -- * Credentials + , HackageCreds + , loadCreds + , saveCreds + , FromFile + -- ** Credentials source + , HackageCredsSource + , fromAnywhere + , fromPrompt + , fromFile + , fromMemory + ) where + +import Control.Applicative ((<$>), (<*>)) +import Control.Exception (bracket) +import qualified Control.Exception as E +import Control.Monad (when) +import Data.Aeson (FromJSON (..), + ToJSON (..), + eitherDecode', encode, + object, withObject, + (.:), (.=)) +import qualified Data.ByteString.Char8 as S +import qualified Data.ByteString.Lazy as L +import Data.Text (Text) +import qualified Data.Text as T +import Data.Text.Encoding (encodeUtf8) +import qualified Data.Text.IO as TIO +import Data.Typeable (Typeable) +import Network.HTTP.Client (BodyReader, Manager, + Response, + applyBasicAuth, brRead, + checkStatus, newManager, + parseUrl, + requestHeaders, + responseBody, + responseStatus, + withResponse) +import Network.HTTP.Client.MultipartFormData (formDataBody, partFile) +import Network.HTTP.Client.TLS (tlsManagerSettings) +import Network.HTTP.Types (statusCode) +import System.Directory (createDirectoryIfMissing, + getAppUserDataDirectory, + removeFile) +import System.FilePath (()) +import System.IO (hFlush, hGetEcho, + hSetEcho, stdin, stdout) + +-- | Username and password to log into Hackage. +-- +-- Since 0.1.0.0 +data HackageCreds = HackageCreds + { hcUsername :: !Text + , hcPassword :: !Text + } + deriving Show + +instance ToJSON HackageCreds where + toJSON (HackageCreds u p) = object + [ "username" .= u + , "password" .= p + ] +instance FromJSON HackageCreds where + parseJSON = withObject "HackageCreds" $ \o -> HackageCreds + <$> o .: "username" + <*> o .: "password" + +-- | A source for getting Hackage credentials. +-- +-- Since 0.1.0.0 +newtype HackageCredsSource = HackageCredsSource + { getCreds :: IO (HackageCreds, FromFile) + } + +-- | Whether the Hackage credentials were loaded from a file. +-- +-- This information is useful since, typically, you only want to save the +-- credentials to a file if it wasn't already loaded from there. +-- +-- Since 0.1.0.0 +type FromFile = Bool + +-- | Load Hackage credentials from the given source. +-- +-- Since 0.1.0.0 +loadCreds :: HackageCredsSource -> IO (HackageCreds, FromFile) +loadCreds = getCreds + +-- | Save the given credentials to the credentials file. +-- +-- Since 0.1.0.0 +saveCreds :: HackageCreds -> IO () +saveCreds creds = do + fp <- credsFile + L.writeFile fp $ encode creds + +-- | Load the Hackage credentials from the prompt, asking the user to type them +-- in. +-- +-- Since 0.1.0.0 +fromPrompt :: HackageCredsSource +fromPrompt = HackageCredsSource $ do + putStr "Hackage username: " + hFlush stdout + username <- TIO.getLine + password <- promptPassword + return (HackageCreds + { hcUsername = username + , hcPassword = password + }, False) + +credsFile :: IO FilePath +credsFile = do + dir <- getAppUserDataDirectory "stackage-upload" + createDirectoryIfMissing True dir + return $ dir "credentials.json" + +-- | Load the Hackage credentials from the JSON config file. +-- +-- Since 0.1.0.0 +fromFile :: HackageCredsSource +fromFile = HackageCredsSource $ do + fp <- credsFile + lbs <- L.readFile fp + case eitherDecode' lbs of + Left e -> E.throwIO $ Couldn'tParseJSON fp e + Right creds -> return (creds, True) + +-- | Load the Hackage credentials from the given arguments. +-- +-- Since 0.1.0.0 +fromMemory :: Text -> Text -> HackageCredsSource +fromMemory u p = HackageCredsSource $ return (HackageCreds + { hcUsername = u + , hcPassword = p + }, False) + +data HackageCredsExceptions = Couldn'tParseJSON FilePath String + deriving (Show, Typeable) +instance E.Exception HackageCredsExceptions + +-- | Try to load the credentials from the config file. If that fails, ask the +-- user to enter them. +-- +-- Since 0.1.0.0 +fromAnywhere = HackageCredsSource $ + getCreds fromFile `E.catches` + [ E.Handler $ \(_ :: E.IOException) -> getCreds fromPrompt + , E.Handler $ \(_ :: HackageCredsExceptions) -> getCreds fromPrompt + ] + +-- | Lifted from cabal-install, Distribution.Client.Upload +promptPassword :: IO Text +promptPassword = do + putStr "Hackage password: " + hFlush stdout + -- save/restore the terminal echoing status + passwd <- bracket (hGetEcho stdin) (hSetEcho stdin) $ \_ -> do + hSetEcho stdin False -- no echoing for entering the password + fmap T.pack getLine + putStrLn "" + return passwd + +-- | Turn the given settings into an @Uploader@. +-- +-- Since 0.1.0.0 +mkUploader :: UploadSettings -> IO Uploader +mkUploader us = do + manager <- usGetManager us + (creds, fromFile) <- loadCreds $ usCredsSource us + when (not fromFile && usSaveCreds us) $ saveCreds creds + req0 <- parseUrl $ usUploadUrl us + let req1 = req0 + { requestHeaders = [("Accept", "text/plain")] + , checkStatus = \_ _ _ -> Nothing + } + return Uploader + { upload_ = \fp -> do + let formData = [partFile "package" fp] + req2 <- formDataBody formData req1 + let req3 = applyBasicAuth + (encodeUtf8 $ hcUsername creds) + (encodeUtf8 $ hcPassword creds) + req2 + putStr $ "Uploading " ++ fp ++ "... " + hFlush stdout + withResponse req3 manager $ \res -> + case statusCode $ responseStatus res of + 200 -> putStrLn "done!" + 401 -> do + putStrLn "authentication failure" + cfp <- credsFile + handleIO (const $ return ()) (removeFile cfp) + error $ "Authentication failure uploading to server" + 403 -> do + putStrLn "forbidden upload" + putStrLn "Usually means: you've already uploaded this package/version combination" + putStrLn "Ignoring error and continuing, full message from Hackage below:\n" + printBody res + code -> do + putStrLn $ "unhandled status code: " ++ show code + printBody res + error $ "Upload failed on " ++ fp + } + +printBody :: Response BodyReader -> IO () +printBody res = + loop + where + loop = do + bs <- brRead $ responseBody res + when (not $ S.null bs) $ do + S.hPut stdout bs + loop + +-- | The computed value from a @UploadSettings@. +-- +-- Typically, you want to use this with 'upload'. +-- +-- Since 0.1.0.0 +data Uploader = Uploader + { upload_ :: !(FilePath -> IO ()) + } + +-- | Upload a single tarball with the given @Uploader@. +-- +-- Since 0.1.0.0 +upload :: Uploader -> FilePath -> IO () +upload = upload_ + +-- | Settings for creating an @Uploader@. +-- +-- Since 0.1.0.0 +data UploadSettings = UploadSettings + { usUploadUrl :: !String + , usGetManager :: !(IO Manager) + , usCredsSource :: !HackageCredsSource + , usSaveCreds :: !Bool + } + +-- | Default value for @UploadSettings@. +-- +-- Use setter functions to change defaults. +-- +-- Since 0.1.0.0 +defaultUploadSettings :: UploadSettings +defaultUploadSettings = UploadSettings + { usUploadUrl = "https://hackage.haskell.org/packages/" + , usGetManager = newManager tlsManagerSettings + , usCredsSource = fromAnywhere + , usSaveCreds = True + } + +-- | Change the upload URL. +-- +-- Default: "https://hackage.haskell.org/packages/" +-- +-- Since 0.1.0.0 +setUploadUrl :: String -> UploadSettings -> UploadSettings +setUploadUrl x us = us { usUploadUrl = x } + +-- | How to get an HTTP connection manager. +-- +-- Default: @newManager tlsManagerSettings@ +-- +-- Since 0.1.0.0 +setGetManager :: IO Manager -> UploadSettings -> UploadSettings +setGetManager x us = us { usGetManager = x } + +-- | How to get the Hackage credentials. +-- +-- Default: @fromAnywhere@ +-- +-- Since 0.1.0.0 +setCredsSource :: HackageCredsSource -> UploadSettings -> UploadSettings +setCredsSource x us = us { usCredsSource = x } + +-- | Save new credentials to the config file. +-- +-- Default: @True@ +-- +-- Since 0.1.0.0 +setSaveCreds :: Bool -> UploadSettings -> UploadSettings +setSaveCreds x us = us { usSaveCreds = x } + +handleIO :: (E.IOException -> IO a) -> IO a -> IO a +handleIO = E.handle diff --git a/app/stackage-upload.hs b/app/stackage-upload.hs new file mode 100644 --- /dev/null +++ b/app/stackage-upload.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE TemplateHaskell #-} +import Options.Applicative (argument, empty, metavar, some, str) +import Paths_stackage_upload (version) +import Stackage.CLI (simpleOptions, simpleVersion) +import Stackage.Upload + +main :: IO () +main = do + (files, ()) <- simpleOptions + $(simpleVersion version) + "Secure upload of packages to Hackage" + "Secure upload of packages to Hackage" + options + empty + uploader <- mkUploader defaultUploadSettings + mapM_ (upload uploader) files + where + options = some (argument str (metavar "TARBALLS...")) diff --git a/stackage-upload.cabal b/stackage-upload.cabal new file mode 100644 --- /dev/null +++ b/stackage-upload.cabal @@ -0,0 +1,44 @@ +-- Initial stackage-upload.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: stackage-upload +version: 0.1.0.0 +synopsis: A more secure version of cabal upload which uses HTTPS +description: For more information, see +homepage: https://github.com/fpco/stackage-upload +license: MIT +license-file: LICENSE +author: Michael Snoyman +maintainer: michael@snoyman.com +category: Distribution +build-type: Simple +extra-source-files: ChangeLog.md, README.md +cabal-version: >=1.10 + +library + exposed-modules: Stackage.Upload + build-depends: base >= 4.5 && < 5 + , aeson + , bytestring >= 0.9 + , text >= 0.11 + , http-client >= 0.4 + , http-client-tls >= 0.2 + , http-types + , directory >= 1.1 + , filepath >= 1.2 + default-language: Haskell2010 + +executable stackage-upload + main-is: stackage-upload.hs + other-modules: Paths_stackage_upload + hs-source-dirs: app + build-depends: base + , stackage-upload + , stackage-cli + , optparse-applicative + default-language: Haskell2010 + other-extensions: TemplateHaskell + +source-repository head + type: git + location: git://github.com/fpco/stackage-upload.git