Commit 822c4bb1 authored by David Himmelstrup's avatar David Himmelstrup
Browse files

Support legacy download and upload urls.

parent e6c38523
......@@ -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
......
......@@ -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
......@@ -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 ->
......
......@@ -235,7 +235,8 @@ uploadAction flags extraArgs = do
checkTarFiles tarfiles
if fromFlag (uploadCheck flags)
then Upload.check verbosity tarfiles
else upload verbosity
else upload verbosity
(configRepos config)
(flagToMaybe $ configUploadUsername config
`mappend` uploadUsername flags)
(flagToMaybe $ configUploadPassword config
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment