Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/b304416fe777c511ea72ab6577a58c445f34d143 >--------------------------------------------------------------- commit b304416fe777c511ea72ab6577a58c445f34d143 Author: Duncan Coutts <[email protected]> Date: Thu May 1 21:44:56 2008 +0000 Don't echo when prompting for the hackage upload password. Fixes ticket #268. And use newtypes for the username and password, just to be more sure we're not mixing them up with other strings. >--------------------------------------------------------------- cabal-install/Hackage/Config.hs | 12 ++++++------ cabal-install/Hackage/Setup.hs | 11 +++++++---- cabal-install/Hackage/Types.hs | 4 ++-- cabal-install/Hackage/Upload.hs | 29 +++++++++++++++++++++-------- 4 files changed, 36 insertions(+), 20 deletions(-) diff --git a/cabal-install/Hackage/Config.hs b/cabal-install/Hackage/Config.hs index 43f72c6..9c10397 100644 --- a/cabal-install/Hackage/Config.hs +++ b/cabal-install/Hackage/Config.hs @@ -46,7 +46,8 @@ import qualified Distribution.Simple.Setup as ConfigFlags import qualified Distribution.Simple.Setup as Cabal import Distribution.Verbosity (Verbosity, normal) -import Hackage.Types (RemoteRepo(..), Repo(..), Username, Password) +import Hackage.Types + ( RemoteRepo(..), Repo(..), Username(..), Password(..) ) import Hackage.ParseUtils import Hackage.Utils (readFileIfExists) import Distribution.Simple.Utils (notice, warn) @@ -73,7 +74,6 @@ data SavedConfig = SavedConfig { configGlobalInstallDirs :: InstallDirs (Flag PathTemplate), configFlags :: ConfigFlags } - deriving (Show) configUserInstall :: SavedConfig -> Flag Bool configUserInstall = ConfigFlags.configUserInstall . configFlags @@ -200,12 +200,12 @@ configCabalInstallFieldDescrs = (fmap emptyToNothing parseFilePathQ) configCacheDir (\d cfg -> cfg { configCacheDir = d }) , simpleField "hackage-username" - (text . show . fromFlagOrDefault "") - (fmap emptyToNothing parseTokenQ) + (text . show . fromFlagOrDefault "" . fmap unUsername) + (fmap (fmap Username . emptyToNothing) parseTokenQ) configUploadUsername (\d cfg -> cfg { configUploadUsername = d }) , simpleField "hackage-password" - (text . show . fromFlagOrDefault "") - (fmap emptyToNothing parseTokenQ) + (text . show . fromFlagOrDefault "" . fmap unPassword) + (fmap (fmap Password . emptyToNothing) parseTokenQ) configUploadPassword (\d cfg -> cfg { configUploadPassword = d }) ] where emptyToNothing "" = mempty diff --git a/cabal-install/Hackage/Setup.hs b/cabal-install/Hackage/Setup.hs index 94e3bf1..4deb5d9 100644 --- a/cabal-install/Hackage/Setup.hs +++ b/cabal-install/Hackage/Setup.hs @@ -51,7 +51,8 @@ import Distribution.ReadE ( readP_to_E ) import Distribution.Verbosity (Verbosity, normal) -import Hackage.Types (UnresolvedDependency(..), Username, Password) +import Hackage.Types + ( UnresolvedDependency(..), Username(..), Password(..) ) import Hackage.ParseUtils (readPToMaybe, parseDependencyOrPackageId) import Data.Monoid (Monoid(..)) @@ -275,7 +276,7 @@ data UploadFlags = UploadFlags { uploadUsername :: Flag Username, uploadPassword :: Flag Password, uploadVerbosity :: Flag Verbosity - } deriving (Show) + } defaultUploadFlags :: UploadFlags defaultUploadFlags = UploadFlags { @@ -307,12 +308,14 @@ uploadCommand = CommandUI { ,option ['u'] ["username"] "Hackage username." uploadUsername (\v flags -> flags { uploadUsername = v }) - (reqArg' "USERNAME" toFlag flagToList) + (reqArg' "USERNAME" (toFlag . Username) + (flagToList . fmap unUsername)) ,option ['p'] ["password"] "Hackage password." uploadPassword (\v flags -> flags { uploadPassword = v }) - (reqArg' "PASSWORD" toFlag flagToList) + (reqArg' "PASSWORD" (toFlag . Password) + (flagToList . fmap unPassword)) ] } diff --git a/cabal-install/Hackage/Types.hs b/cabal-install/Hackage/Types.hs index cb9966b..672b40c 100644 --- a/cabal-install/Hackage/Types.hs +++ b/cabal-install/Hackage/Types.hs @@ -17,8 +17,8 @@ import Distribution.Package import Distribution.PackageDescription ( GenericPackageDescription, FlagAssignment ) -type Username = String -type Password = String +newtype Username = Username { unUsername :: String } +newtype Password = Password { unPassword :: String } -- | We re-use @GenericPackageDescription@ and use the @package-url@ -- field to store the tarball URL. diff --git a/cabal-install/Hackage/Upload.hs b/cabal-install/Hackage/Upload.hs index 0b74850..2649b8e 100644 --- a/cabal-install/Hackage/Upload.hs +++ b/cabal-install/Hackage/Upload.hs @@ -3,7 +3,7 @@ module Hackage.Upload (check, upload) where -import Hackage.Types (Username, Password) +import Hackage.Types (Username(..), Password(..)) import Hackage.HttpUtils (proxy) import Distribution.Simple.Utils (debug, notice, warn) @@ -18,7 +18,9 @@ import Network.URI (URI, parseURI) import Data.Char (intToDigit) import Numeric (showHex) -import System.IO (hFlush, stdout, openBinaryFile, IOMode(ReadMode), hGetContents) +import System.IO (hFlush, stdin, stdout, hGetEcho, hSetEcho + ,openBinaryFile, IOMode(ReadMode), hGetContents) +import Control.Exception (bracket) import System.Random (randomRIO) @@ -35,8 +37,8 @@ Just checkURI = parseURI "http://hackage.haskell.org/cgi-bin/hackage-scripts/che upload :: Verbosity -> Maybe Username -> Maybe Password -> [FilePath] -> IO () upload verbosity mUsername mPassword paths = do - username <- maybe (prompt "username") return mUsername - password <- maybe (prompt "password") return mPassword + Username username <- maybe promptUsername return mUsername + Password password <- maybe promptPassword return mPassword let auth = addAuthority AuthBasic { auRealm = "Hackage", auUsername = username, @@ -48,10 +50,21 @@ upload verbosity mUsername mPassword paths = do notice verbosity $ "Uploading " ++ path ++ "... " handlePackage verbosity uploadURI auth path - where prompt thing = do - putStr ("Hackage " ++ thing ++ ": ") - hFlush stdout - getLine + where + promptUsername :: IO Username + promptUsername = do + putStr "Hackage username: " + hFlush stdout + fmap Username getLine + + promptPassword :: IO Password + promptPassword = do + putStr "Hackage password: " + hFlush stdout + -- save/restore the terminal echoing status + bracket (hGetEcho stdin) (hSetEcho stdin) $ \_ -> do + hSetEcho stdin False -- no echoing for entering the password + fmap Password getLine check :: Verbosity -> [FilePath] -> IO () check verbosity paths = do _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
