[commit: Cabal] master: Support legacy download and upload urls. (2370af1)

[Ian Lynagh]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/2370af158a0cdae8f8ccd168fe8ed0919c2a1d09

>---------------------------------------------------------------

commit 2370af158a0cdae8f8ccd168fe8ed0919c2a1d09
Author: Lemmih <lemmih at gmail.com>
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