Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/2370af158a0cdae8f8ccd168fe8ed0919c2a1d09 >--------------------------------------------------------------- commit 2370af158a0cdae8f8ccd168fe8ed0919c2a1d09 Author: Lemmih <[email protected]> Date: Sun Aug 10 00:04:46 2008 +0000 Support legacy download and upload urls. >--------------------------------------------------------------- cabal-install/Distribution/Client/Fetch.hs | 12 ++++++++++-- cabal-install/Distribution/Client/HttpUtils.hs | 12 +++++++++++- cabal-install/Distribution/Client/Upload.hs | 22 +++++++++++++--------- cabal-install/Main.hs | 1 + 4 files changed, 35 insertions(+), 12 deletions(-) diff --git a/cabal-install/Distribution/Client/Fetch.hs b/cabal-install/Distribution/Client/Fetch.hs index 1f2f792..1429f3c 100644 --- a/cabal-install/Distribution/Client/Fetch.hs +++ b/cabal-install/Distribution/Client/Fetch.hs @@ -30,7 +30,7 @@ import Distribution.Client.Dependency import Distribution.Client.IndexUtils as IndexUtils ( getAvailablePackages, disambiguateDependencies ) import qualified Distribution.Client.InstallPlan as InstallPlan -import Distribution.Client.HttpUtils (getHTTP) +import Distribution.Client.HttpUtils (getHTTP, isOldHackageURI) import Distribution.Package ( PackageIdentifier(..) ) @@ -59,7 +59,7 @@ import System.FilePath import qualified System.FilePath.Posix as FilePath.Posix ( combine, joinPath ) import Network.URI - ( URI(uriScheme, uriPath) ) + ( URI(uriPath, uriScheme) ) import Network.HTTP ( ConnError(..), Response(..) ) @@ -170,6 +170,14 @@ packageDir repo pkgid = repoLocalDir repo -- | Generate the URI of the tarball for a given package. packageURI :: RemoteRepo -> PackageIdentifier -> URI +packageURI repo pkgid | isOldHackageURI (remoteRepoURI repo) = + (remoteRepoURI repo) { + uriPath = FilePath.Posix.joinPath + [uriPath (remoteRepoURI repo) + ,pkgName pkgid + ,display (pkgVersion pkgid) + ,display pkgid <.> "tar.gz"] + } packageURI repo pkgid = (remoteRepoURI repo) { uriPath = FilePath.Posix.joinPath diff --git a/cabal-install/Distribution/Client/HttpUtils.hs b/cabal-install/Distribution/Client/HttpUtils.hs index 396244d..ac9aafc 100644 --- a/cabal-install/Distribution/Client/HttpUtils.hs +++ b/cabal-install/Distribution/Client/HttpUtils.hs @@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | Separate module for HTTP actions, using a proxy server if one exists ----------------------------------------------------------------------------- -module Distribution.Client.HttpUtils (getHTTP, proxy) where +module Distribution.Client.HttpUtils (getHTTP, proxy, isOldHackageURI) where import Network.HTTP ( Request (..), Response (..), RequestMethod (..) @@ -34,6 +34,8 @@ import Distribution.Verbosity (Verbosity) import Distribution.Simple.Utils (warn, debug) import Distribution.Text ( display ) +import qualified System.FilePath.Posix as FilePath.Posix + ( splitDirectories ) -- FIXME: all this proxy stuff is far too complicated, especially parsing -- the proxy strings. Network.Browser should have a way to pick up the @@ -133,3 +135,11 @@ getHTTP verbosity uri = do setProxy p request req return (Right resp) + +-- Utility function for legacy support. +isOldHackageURI :: URI -> Bool +isOldHackageURI uri + = case uriAuthority uri of + Just (URIAuth {uriRegName = "hackage.haskell.org"}) -> + FilePath.Posix.splitDirectories (uriPath uri) == ["/","packages","archive"] + _ -> False diff --git a/cabal-install/Distribution/Client/Upload.hs b/cabal-install/Distribution/Client/Upload.hs index 8daa119..856998c 100644 --- a/cabal-install/Distribution/Client/Upload.hs +++ b/cabal-install/Distribution/Client/Upload.hs @@ -4,7 +4,7 @@ module Distribution.Client.Upload (check, upload, report) where import Distribution.Client.Types (Username(..), Password(..),Repo(..),RemoteRepo(..)) -import Distribution.Client.HttpUtils (proxy) +import Distribution.Client.HttpUtils (proxy, isOldHackageURI) import Distribution.Simple.Utils (debug, notice, warn, info) import Distribution.Verbosity (Verbosity) @@ -22,7 +22,7 @@ import Network.Browser import Network.HTTP ( Header(..), HeaderName(..) , Request(..), RequestMethod(..), Response(..) ) -import Network.URI (URI, parseURI) +import Network.URI (URI(uriPath), parseURI) import Data.Char (intToDigit) import Numeric (showHex) @@ -31,22 +31,25 @@ import System.IO (hFlush, stdin, stdout, hGetEcho, hSetEcho import Control.Exception (bracket) import System.Random (randomRIO) import System.FilePath +import qualified System.FilePath.Posix as FilePath.Posix import System.Directory import Control.Monad (forM_) --FIXME: how do we find this path for an arbitrary hackage server? -- is it always at some fixed location relative to the server root? -uploadURI :: URI -Just uploadURI = parseURI "http://hackage.haskell.org/cgi-bin/hackage-scripts/protected/upload-pkg"; +legacyUploadURI :: URI +Just legacyUploadURI = parseURI "http://hackage.haskell.org/cgi-bin/hackage-scripts/protected/upload-pkg"; checkURI :: URI Just checkURI = parseURI "http://hackage.haskell.org/cgi-bin/hackage-scripts/check-pkg"; -upload :: Verbosity -> Maybe Username -> Maybe Password -> [FilePath] -> IO () -upload verbosity mUsername mPassword paths = do - +upload :: Verbosity -> [Repo] -> Maybe Username -> Maybe Password -> [FilePath] -> IO () +upload verbosity repos mUsername mPassword paths = do + let uploadURI = if isOldHackageURI targetRepoURI + then legacyUploadURI + else targetRepoURI{uriPath = uriPath targetRepoURI `FilePath.Posix.combine` "upload"} Username username <- maybe promptUsername return mUsername Password password <- maybe promptPassword return mPassword let auth = addAuthority AuthBasic { @@ -55,12 +58,11 @@ upload verbosity mUsername mPassword paths = do auPassword = password, auSite = uploadURI } - flip mapM_ paths $ \path -> do notice verbosity $ "Uploading " ++ path ++ "... " handlePackage verbosity uploadURI auth path - where + targetRepoURI = remoteRepoURI $ selectUploadRepo [ remoteRepo | Left remoteRepo <- map repoKind repos ] promptUsername :: IO Username promptUsername = do putStr "Hackage username: " @@ -76,6 +78,8 @@ upload verbosity mUsername mPassword paths = do hSetEcho stdin False -- no echoing for entering the password fmap Password getLine +selectUploadRepo = last -- Use head? + report :: Verbosity -> [Repo] -> IO () report verbosity repos = forM_ repos $ \repo -> diff --git a/cabal-install/Main.hs b/cabal-install/Main.hs index 4e4134e..e8e2994 100644 --- a/cabal-install/Main.hs +++ b/cabal-install/Main.hs @@ -236,6 +236,7 @@ uploadAction flags extraArgs = do if fromFlag (uploadCheck flags) then Upload.check verbosity tarfiles else upload verbosity + (configRepos config) (flagToMaybe $ configUploadUsername config `mappend` uploadUsername flags) (flagToMaybe $ configUploadPassword config _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
