From d0e99ff6d6fe803ab4026e56f1e324a117d52969 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Wed, 27 Mar 2019 12:26:32 +0200 Subject: [PATCH] Hackage creds are read-only (fixes #2159) --- ChangeLog.md | 2 ++ src/Stack/Upload.hs | 42 ++++++++++++++++++++++++++++++------ src/test/Stack/UploadSpec.hs | 28 ++++++++++++++++++++++++ 3 files changed, 66 insertions(+), 6 deletions(-) create mode 100644 src/test/Stack/UploadSpec.hs diff --git a/ChangeLog.md b/ChangeLog.md index 71fa876ea4..b5a0096274 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -196,6 +196,8 @@ Bug fixes: - Fix detection of aarch64 platform (this broke when we upgraded to a newer Cabal version). - Docker: fix detecting and pulling missing images with `--docker-auto-pull`, see [#4598](https://github.com/commercialhaskell/stack/issues/4598) +* Hackage credentials are not world-readable. See + [#2159](https://github.com/commercialhaskell/stack/issues/2159). ## v1.9.3 diff --git a/src/Stack/Upload.hs b/src/Stack/Upload.hs index db0e5ca25e..efa3d61f9d 100644 --- a/src/Stack/Upload.hs +++ b/src/Stack/Upload.hs @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} -- | Provide ability to upload tarballs to Hackage. module Stack.Upload ( -- * Upload @@ -12,14 +13,16 @@ module Stack.Upload -- * Credentials , HackageCreds , loadCreds + , writeFilePrivate ) where import Stack.Prelude import Data.Aeson (FromJSON (..), ToJSON (..), - decode', encode, + decode', toEncoding, fromEncoding, object, withObject, (.:), (.=)) +import Data.ByteString.Builder (lazyByteString) import qualified Data.ByteString.Char8 as S import qualified Data.ByteString.Lazy as L import qualified Data.Conduit.Binary as CB @@ -35,9 +38,10 @@ import Network.HTTP.StackClient (Request, RequestBody(Req displayDigestAuthException) import Stack.Types.Config import System.Directory (createDirectoryIfMissing, - removeFile) -import System.FilePath ((), takeFileName) + removeFile, renameFile) +import System.FilePath ((), takeFileName, takeDirectory) import System.IO (stdout, putStrLn, putStr, print) -- TODO remove putStrLn, use logInfo +import System.PosixCompat.Files (setFileMode) -- | Username and password to log into Hackage. -- @@ -67,9 +71,13 @@ loadCreds :: Config -> IO HackageCreds loadCreds config = do fp <- credsFile config elbs <- tryIO $ L.readFile fp - case either (const Nothing) Just elbs >>= decode' of + case either (const Nothing) Just elbs >>= \lbs -> (lbs, ) <$> decode' lbs of Nothing -> fromPrompt fp - Just mkCreds -> do + Just (lbs, mkCreds) -> do + -- Ensure privacy, for cleaning up old versions of Stack that + -- didn't do this + writeFilePrivate fp $ lazyByteString lbs + unless (configSaveHackageCreds config) $ do putStrLn "WARNING: You've set save-hackage-creds to false" putStrLn "However, credentials were found at:" @@ -90,12 +98,34 @@ loadCreds config = do "Save hackage credentials to file at " ++ fp ++ " [y/n]? " putStrLn "NOTE: Avoid this prompt in the future by using: save-hackage-creds: false" when shouldSave $ do - L.writeFile fp (encode hc) + writeFilePrivate fp $ fromEncoding $ toEncoding hc putStrLn "Saved!" hFlush stdout return hc +-- | Write contents to a file which is always private. +-- +-- For history of this function, see: +-- +-- * https://github.com/commercialhaskell/stack/issues/2159#issuecomment-477948928 +-- +-- * https://github.com/commercialhaskell/stack/pull/4665 +writeFilePrivate :: MonadIO m => FilePath -> Builder -> m () +writeFilePrivate fp builder = liftIO $ withTempFile (takeDirectory fp) (takeFileName fp) $ \fpTmp h -> do + -- Temp file is created such that only current user can read and write it. + -- See docs for openTempFile: https://www.stackage.org/haddock/lts-13.14/base-4.12.0.0/System-IO.html#v:openTempFile + + -- Write to the file and close the handle. + hPutBuilder h builder + hClose h + + -- Make sure the destination file, if present, is writeable + void $ tryIO $ setFileMode fp 0o600 + + -- And atomically move + renameFile fpTmp fp + credsFile :: Config -> IO FilePath credsFile config = do let dir = toFilePath (view stackRootL config) "upload" diff --git a/src/test/Stack/UploadSpec.hs b/src/test/Stack/UploadSpec.hs new file mode 100644 index 0000000000..2806a05131 --- /dev/null +++ b/src/test/Stack/UploadSpec.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module Stack.UploadSpec (spec) where + +import RIO +import RIO.Directory +import RIO.FilePath (()) +import Stack.Upload +import Test.Hspec +import System.Permissions (osIsWindows) +import System.PosixCompat.Files (getFileStatus, fileMode) +import Data.Bits ((.&.)) + +spec :: Spec +spec = do + it "writeFilePrivate" $ example $ withSystemTempDirectory "writeFilePrivate" $ \dir -> replicateM_ 2 $ do + let fp = dir "filename" + contents :: IsString s => s + contents = "These are the contents" + writeFilePrivate fp contents + actual <- readFileBinary fp + actual `shouldBe` contents + perms <- getPermissions fp + perms `shouldBe` setOwnerWritable True (setOwnerReadable True emptyPermissions) + + unless osIsWindows $ do + status <- getFileStatus fp + (fileMode status .&. 0o777) `shouldBe` 0o600